Comprendre un fichier perl

Bonjour,

Je suis débutante en langage de script perl et je veux comprendre un fichier de configuration écrit en perl (le code ci-dessous). Si vous pouvez m'aider à le faire ?
Meci bien et bonne journée.

#!/usr/bin/env perl
#
# New Perl changelog:
# 27/01/09 : HH - meilleure utilisation de $stvers,
#                 ajout de la targetpack (STMCROOT) pour ST 2.3
# 21/11/08 : CM - suppression de variables d'environnement inutiles
# 12/12/07 : CC - ajout d'un argument optionnel pour choisir entre ST 2.0 et 2.2
# 03/12/07 : CC - fin du portage en Perl
# 29/11/07 : SC - creation en Perl
#
# Previous changelog in tcsh:
# 25/10/07 : SDM - TMPDIR redirige vers compte perso /users/<name>/tmp
# 12/07/07 : SDM - nouveaux HOME_PATH sur le nouveau serveur
# 06/07/07 : SDM - suppression de la vérification sur positionnement initial des variables
# 06/07/07 : SDM - changement de localisation des targets dans le serveur NFS
# 18/06/07 : SDM - suppression de la gestion d'argument car problématique
# 15/06/07 : SDM - non lancement du script si le shell est déjà à jour
# 14/06/07 : SDM - ajout du mode verbose "-v"
# 11/06/07 : SDM - recherche de TARGET_IP, NFS_SERVER_IP, etc... dans les variables d'env
#                  avant de poser les questions
# 11/06/07 : SDM - ajout du path pour sh4-linux-gcc
#

#######################################################################
# This script is designed so that its output is 'eval'ed by a shell
# like this:
#
# eval '~/set-env.pl'
#
# This is why user messages are printed on STDERR instead of STDOUT.
#
# This script is designed so that only one perl script has to be
# maintained for people using both bash and tcsh compatible shells.
#######################################################################

use strict;
use warnings;

#------------------------------
# variables
#------------------------------
my $version = "2.0.3";
my $echo_level = 1; # set to 1 for debug

# Check that we are running in a terminal.
# If this is not the case, we abort because we don't want to create
# problem when using "scp" or tools like that.
# Note that we have to test STDERR, not STDOUT,
# because the script should be 'eval'ed by the parent shell.
exit 0 unless (-t STDERR);

# Check arguments to this script.
my $usage = "Usage: eval \'$0 [VERSION]\'\n" ;
die $usage if (@ARGV > 1);

my $stvers = $ARGV[0] || '2.2';

my %valid = ('20' => '2.0', '2.0' => '2.0',
	     '22' => '2.2', '2.2' => '2.2',
	     '23' => '2.3', '2.3' => '2.3');

die "$usage\tVERSION should be any of: " . join(", ", sort keys %valid) . "\n"
	unless ($valid{$stvers});

$stvers=$valid{$stvers};

#------------------------------
# set-env info
#------------------------------
print STDERR "set-env.pl (environment variables util) $version\n";

#------------------------------
# User info
#------------------------------
my $name = 'echo ~ | cut -d/ -f3';
chomp $name;
my $matricule = $ENV{LOGNAME};

print STDERR "Welcome: $matricule ($name)\n" if ($echo_level == 1);

#------------------------------
# Shell
#------------------------------
my $shell = parent_shell();

#------------------------------
# Tmp files redirection
# to avoid using /tmp that is limited on the compilation server...
#------------------------------
my $TMPDIR = "$ENV{HOME}/tmp";
'mkdir -p $TMPDIR' unless (-d $TMPDIR);
set_env_parent('TMPDIR', $TMPDIR);
print STDERR "temp directory = $TMPDIR...\t\t\t-->[ok]\n";

#------------------------------
# Network configuration
#------------------------------
my $config = "$ENV{HOME}/stprobe.env";
my @ip_var = qw(TARGET NFS_SERVER GATEWAY NETMASK);

# Check values from environnement.
check_env_variables(@ip_var);

# Put environnement variables values in a hash.
my %address;
@address{@ip_var} = @ENV{@ip_var};

print STDERR "Checking configuration file...\t\t\t\t";
my $write_config = 0;
if (-f $config) {
	# Read config file.
	open(INPUT,"< $config") or die "Cannot open '$config' for reading: $!";
	my @data = <INPUT>;
	chomp @data;
	close(INPUT);

	# Parse config file.
	foreach my $d (@data) {
		next unless ($d);
		my ($key, $val) = split('=', $d);
		# Remove spaces from keys and vals.
		$key =~ s/\s//g;
		$val =~ s/\s//g;
		# Check we have good keys and vals.
		if(exists $address{$key}) {
			die "Bad value '$val' in $config." unless (check_ip_address($val));
			$address{$key} = $val unless ($address{$key});
		}
	}
	print STDERR "-->[ok]\n";
} else {
	print STDERR "-->None found, we will write it.\n";
	$write_config = 1;
}

# Ask for ip addresses that are still missing.
foreach my $n (@ip_var) {
	next if ($address{$n});
	$address{$n} = ask_for_ip($n);
	save_config($n,$address{$n});
}

if ($write_config) {
	print STDERR "Saving configuration to $config ...\t\t\t\t";

	open(OUTPUT,">> $config") or die "Cannot open '$config' for writing: $!";

	foreach my $n (@ip_var) {
		my $a = $address{$n};
		print OUTPUT "$n=$a\n";
		set_env_parent($n, $a);
	}

	close(OUTPUT);

	print STDERR "-->[ok]\n";
}

# JTAG info
my $SONDE_IP = 'cat $config | grep PROBE | cut -d= -f2';
set_env_parent('SONDE_IP', $SONDE_IP);

# Board info
my $BOARD_NAME = "stb_$name";
set_env_parent('BOARD_NAME', $BOARD_NAME);


#------------------------------
# PATH environment variable
#------------------------------
my $compil_server = ('hostname' =~ m/osn08002/);
my $HOME_PATH = $compil_server ? "/data/$matricule" : "/home/$name";
set_env_parent('HOME_PATH', $HOME_PATH);

# Adding sh4 tools to path
print STDERR "Checking ST toolkit...\t\t\t\t\t";
my $ST_toolkit_path = $compil_server ? "/apps/ST" : "/opt/STM";
if (! -d $ST_toolkit_path) {
	print STDERR "-->[failed]\n";
	print STDERR "Can't find ST toolkit on '$ST_toolkit_path'.";
	print STDERR "Exiting  on critical error.";
	exit 1;
}
print STDERR  "-->[ok]\n";
# my $ST40BIN_PATH = "$ST_toolkit_path/ST40R4.1.1/bin";
# set_env_parent('ST40BIN_PATH', $ST40BIN_PATH);

# For mkcramfs and mkfs.jffs2
my $stlinux = "STLinux-$stvers";
print STDERR "Checking $stlinux toolkit...\t\t\t\t";
my $STLinux_toolkit_path = "$ST_toolkit_path/$stlinux";
if (! -d $STLinux_toolkit_path) {
	print STDERR "-->[failed]\n";
	print STDERR "Yickjes ! Can't find '$stlinux' toolkit on '$STLinux_toolkit_path'.\n";
	exit 1;
}
print STDERR  "-->[ok]\n";
# my $ST_SBIN_PATH = "$STLinux_toolkit_path/host/bin";
# set_env_parent('ST_SBIN_PATH', $ST_SBIN_PATH);

if ($stvers == "2.3" )
{
	print STDERR "Using STLinux 2.3, checking for targetpack...\t\t";
	my $STMCROOT = "STMCR1.3.1" if ($stvers == "2.3");
	$STMCROOT = "$ST_toolkit_path/$STMCROOT";
	if ( ! -d $STMCROOT ) {
			print STDERR "-->[failed]\n";
			print STDERR "Can't find targetpack '$STMCROOT' under $ST_toolkit_path'.\n";
			exit 1;
	}
	print STDERR "-->[ok]\n";
	set_env_parent('STMCROOT', $STMCROOT);
}

# For sh4-linux-gcc
print STDERR "Checking $stlinux devkit for sh4 architecture...\t";
my $STLinux_devkit_path = "$ST_toolkit_path/$stlinux/devkit/sh4";
if (! -d $STLinux_toolkit_path) {
	print STDERR "-->[failed]\n";
	print STDERR "Can't find '$stlinux' devkit for sh4 architecture ";
	print STDERR "on '$STLinux_devkit_path'.";
	print STDERR "Exiting  on critical error.";
	exit 1;
}
print STDERR  "-->[ok]\n";
# my $SH4BIN_PATH = "$STLinux_devkit_path/bin";
# set_env_parent('SH4BIN_PATH', $SH4BIN_PATH);

#print STDERR "Updating path...\t\t\t\t\t-->[ok]\n";
#my $PATH = "$ST_SBIN_PATH:$ST40BIN_PATH:$SH4BIN_PATH:$ENV{PATH}";
#set_env_parent('PATH', $PATH);

print STDERR "Updating environment variables...\t\t\t";

# Setting targets.
my $TARGET_PATH = "$HOME_PATH/target";
set_env_parent('TARGET_PATH', $TARGET_PATH);

# Compilation
my $COMP = "ARCH=sh CROSS_COMPILE=sh4-linux-";
set_env_parent('COMP', $COMP);
my $MAKEFLAGS = "--no-print-directory --no-builtin-rules --no-builtin-variables";
set_env_parent('MAKEFLAGS', $MAKEFLAGS);

#kernel
my $KERNEL_PATH = "$HOME_PATH/kernel";
set_env_parent('KERNEL_PATH', $KERNEL_PATH);
my $KERNEL_PATH_BASE = "$HOME_PATH/kernel_";
set_env_parent('KERNEL_PATH_BASE', $KERNEL_PATH_BASE);
my $SET_ENV_TAG = "set-env.pl($version)";
set_env_parent('SET_ENV_TAG', $SET_ENV_TAG);

print STDERR "-->[ok]\n";

# print info
if ($echo_level == 1) {
	print STDERR "SONDE_IP               = $SONDE_IP\n";
	print STDERR "TARGET                 = $address{TARGET}\n";
	print STDERR "NFS_SERVER             = $address{NFS_SERVER}\n";
	print STDERR "GATEWAY                = $address{GATEWAY}\n";
	print STDERR "NETMASK                = $address{NETMASK}\n";
# 	print STDERR "ST_SBIN_PATH           = $ST_SBIN_PATH\n";
# 	print STDERR "ST40BIN_PATH           = $ST40BIN_PATH\n";
# 	print STDERR "SH4BIN_PATH            = $SH4BIN_PATH\n";
	print STDERR "TARGET_PATH            = $TARGET_PATH\n";
	print STDERR "KERNEL_PATH            = $KERNEL_PATH\n";
	print STDERR "KERNEL_PATH_BASE       = $KERNEL_PATH_BASE\n";
}

#------------------------------
# FONCTIONS used above
#------------------------------

sub check_env_variables {
	foreach my $n (@_) {
		die "Bad value '$ENV{$n}' for environnement variable '$n'."
			if ($ENV{$n} and not check_ip_address($ENV{$n}));
	}
}

sub parent_shell {
	my $p = getppid();

	# We search for the ppid at the beginning of the ps results.
	my ($cmd) = grep { m/^\s*$p / } 'ps -eo pid,cmd';
	chomp $cmd;
	$cmd =~ s/^\s//g;

	# We must get rid of the ppid to get the basename.
	my ($ppid, $name) = split(' ', $cmd);
	$name = 'basename -- $name';
	chomp $name;

	return $name;
}

sub set_env_parent {
	my ($var, $val) = @_;

	# print STDERR "Using shell: $shell\n";

	if ($shell =~ m/csh/) {
		print "setenv $var '$val' ; \n";
	} else {
		print "export $var='$val' ; \n";
	}
}

sub check_ip_address {
	my ($address) = @_;

	# Check general format.
	if ($address !~ m/^\s*(\d+)\.(\d+)\.(\d+)\.(\d+)\s*$/) {
		print STDERR "IP address should contain 4 numbers ";
		print STDERR "separated by spaces.\n";
		return;
	}

	my @ip = ($1, $2, $3, $4);

	# Check each number.
	foreach my $elem (@ip) {
		if ($elem < 0 or $elem > 255) {
			print STDERR "IP address element '$elem' ";
			print STDERR "should be between 0 and 255.\n";
			return;
		}
	}

	return join('.', @ip);
}

sub ask_for_ip {
	my ($name) = @_;

	my $ip;
	do {
		print STDERR "Please enter $name:\n";
		$ip = <STDIN>;
		$ip = check_ip_address($ip);
	} until ($ip);

	return $ip;
}

sub save_config {
        my($var, $val) = @_;

	print STDERR "Saving configuration to $config ...\t\t\t\t";
	open(OUTPUT,">> $config") or die "Cannot open '$config' for writing: $!";
	print OUTPUT "$var=$val\n";
	close(OUTPUT);
	print STDERR "-->[ok]\n";
}