Perl

perldoc –f <fonction>	# Affiche la doc de la fonction
man perlfunc		# Liste des fonctions disponibles
man CGI			# Liste les fonctions du module CGI
man perl		# Liste les aides disponibles

Il s'agit de directives pour le compilateur que l'on active par le mot clef use et que l'on désactive par le mot clef no.

use strict ;	# Impose la déclaration des variables.
		# De plus rend la portée de la variable locale au bloc où elle est déclarée (entre { et }).
no strict ;	# Déclaration facultative.
use integer ;	# Division entière : 10/3 = 3
no integer ;	# Division normale : 10/3 = 3.3333

open (…) or die ("….\n");	# en cas d’erreur, affiche le message sur STDERR et sort.
open (…) or die ("$ ! ");	# en cas d’erreur affiche le n°. En l’absence de \n affiche aussi le numéro de la ligne courante.
warn("…");			# affiche le message sans terminer l’exécution.

Pour balayer l'entrée standard utiliser les options -lne :

cat <fichier>|perl –lne ‘if (/^expression régulière$/) { print "$1 $2 …" }’

my $var;    # déclaration pour un bloc de code
our $var;   # déclaration globale
local $var; # déclaration pour un bloc de code ainsi que les sous routines appelées à partir de ce bloc de code
state $var; # la variable n'est initialisé qu'une seule fois

our $global_var = 42;  # Variable globale
 
sub exemple_local {
    local $global_var = 10;             # Modifie temporairement $global_var
    print "Dans local: $global_var\n";  # Affiche 10
    sous_fonction();                    # Appel d'une autre fonction
}
 
sub sous_fonction {
    print "Dans sous_fonction: $global_var\n";  # Affiche 10
}
 
exemple_local();
print "Après local: $global_var\n";  # Affiche 42

use feature 'state';
 
sub compteur {
    state $count = 0;  # $count est initialisé une seule fois
    $count++;
    return $count;
}
 
print compteur();  # Affiche 1
print compteur();  # Affiche 2
print compteur();  # Affiche 3

defined  # pour savoir si une variable est initialisée.
undef    # pour désinitialiser une variable.

Il n'existe pas de type booléen en perl. Une variable dont la valeur est 0 est considéré comme false dans le cadre d'un test alors que toute autre valeur, caractère ou valeur non nulle, sera considérée comme vrai.

$var="30 km" # $dist=4*$var ;	120 (prend le début numérique)
$var="20"    # $d=2x$var ;		2020 (duplication)
$var="20"    # $d=2x$var-12 ;	2008

Un tableau est un ensemble ordonné de valeurs. Les indices du tableau vont de 0 à $#tab (indice du dernier élément).

@var=(4,"truc",$var,10..20) # ( ) contexte de liste, tableau de 14 valeurs

$v1=(4, "truc",$var,10..20);		# 20 (on récupère la dernière valeur de la liste)
($v1)=(4, "truc",$var,10..20);		# 4 (on récupère la première valeur de la liste)
($v1,$v2)=(4,"truc",$var,10..20);	# 4, "truc" (on récupère les 2 premières valeurs de la liste).
$nb=@var;				# 14 (on récupère le cardinal de la liste.
($var,@tab)=@tab			# récupère la première valeur et le reste de la liste.
@tab=(@tab1,@tab2) ;			# concatène les 2 tableaux.
(@tab,$nb)=(@tab1,@tab2) ;		# @tab prend toute la concaténation, $nb reste vide.
@liste=qw/a b c d/;			# qw=quoted word, équivalent à @liste=("a","b","c","d");

$tab[0]			# premier élément
$tab[$#tab]		# dernier élément. Equivalent à $tab[-1] (on lit le tableau à l’envers).
@var=@tab[10..15]	# on prend les élément de 10 à 15
@var=@tab[10,15,20]	# on prend les éléments 10,15 et 20.
(fonction())[…]		# pour récupérer des éléments d’une liste rendue par une fonction.

for my $element (@tableau) { print "$element\n" }
for (my $i=0; $i <= $#tableau ; $i++) { print "$tableau[$i]\n"} 

shift	$var=shift(@tab);		# extraction du 1er élément et décalage de la liste
unshift	unshift(@tab,…);		# on insère au début de la liste les éléments indiqués.
pop	pop(@tab);			# extraction du dernier élément de la liste.
push	push(@tab,…);			# on insère les éléments à la fin de la liste.
reverse	@tab=reverse(@tab);		# inverse les éléments du tableau.
sort	@tab=sort(@tab);		# tri ASCII croissant.
	@tab=sort{$a cmp $b}@tab	# tri ASCII croissant
	@tab=sort{$b cmp $a}@tab	# tri ASCII décroissant
	@tab=sort{$a <=> $b}@tab	# tri numérique croissant
	@tab=sort{$b <=> $b}@tab	# tri numérique décroissant
split	@tab=split(/:/,$ligne);		# récupère la liste des éléments séparés par :
        @tab=split(/;/,$ligne,-1);      # retourne un tableau avec tous les éléments même si les derniers sont vides
        @tab=split(/,/,$ligne,2);       # retourne un tableau avec maximum 2 éléments. Le dernier aura peut-être des chaînes contenant des virgules
join	$var=join(‘-‘,(1,2,3,4));	# concatène en une seule chaîne 1-2-3-4
splice	splice(@tab,$deb,$n);		# enlève n éléments de tab en commençant à deb retourne les éléments supprimés
grep	@tab=grep(/regexp/,@tab);	# recherche l’expression régulière dans le tableau, retourne liste correspondances
if      ("@tab" =~ /$val/)              # teste l'appartenance de la valeur au tableau 
if      (@tab)                          # teste si le tableau est vide

$Array[0][0] = "0 0";
$Array[0][1] = "0 1";
$Array[0][2] = "0 2";
$Array[0][3] = "0 3";
$Array[1][0] = "1 0";
$Array[1][1] = "1 1";
$Array[1][2] = "1 2";
 
print "$#Array\n";                # dernier élément pour la première dimension = 1 donc 2 éléments
print scalar @{$Array[0]}."\n";   # nombre d'éléments pour la deuxième dimension = 4
 
push(@{$Array[3]},"0");           # Ajout d'un élément avec push

%table=(‘monday’,’lundi’, ….’sunday’,’dimanche’) ;
%table=(monday => ‘lundi’, …, sunday => ‘dimanche’);

$table{$cle}=$valeur;

keys(%tab)		# liste des clés
values(%tab)		# liste des valeurs
each(%tab)		# parcourt la liste et donne clé-valeur
delete $table{$cle};	# supprime la clé et sa valeur associée.
exists $table{$cle}	# test l’existence de la clé dans la table (même s’il n’y a pas de valeur associée).

@cle=keys %table;					# retourne la liste des clefs
@valeur=values %table;					# retourne la liste des valeurs.
for $cle (keys (%table)) { traitement }			# retourne les clefs dans un ordre aléatoire
for $cle (sort keys (%table)) { traitement }		# retourne les clefs trié en ordre alphabétique
for $valeur (values (%table)) { traitement }		# retourne les valeurs dans un ordre aléatoire
@cle=sort {$table{$a} <=> $table{$b}} keys(%table);	# retourne la liste des clefs dans ordre des valeurs associées

On obtient le résultat en comptant les clefs :

$nombre = keys (%table);

my %hash;
 
$hash{"cle1"}{"cle2"}="toto";
 
for my $cle1 (sort keys %hash) {
    print "$cle1 : \n";
    for my $cle2 (sort keys %{$hash{$cle1}}) {
        print "\t$cle2 : $hash{$cle1}{$cle2}\n";
    }
}

https://perl.mines-albi.fr/DocFr/perlvar.html

while (($cle,$valeur) = each %ENV) {
    print “$cle=$valeur\n”;           # Affiche les variables d’environnement.
}

if ($<) {
   print "on n'est pas root";
} else {
   print "on est root\n";
}

{
  local $/;   # on défini la variable $/ à undef
  my $contenu = <FICHIER>;  # la variable contient tout le contenu du fichier
}
# $/ revient à la valeur par défaut \n

• Opérateurs
• Opérateurs et priorités

Les références peuvent être créées en utilisant l'opérateur « \ » sur une variable, une fonction ou une valeur

$refscalaire = \$scalaire;
$reftableau  = \@tableau;
$rehashage   = \%hashage;
$reffonction = \&fonction;  # référence sur une fonction

Il est possible de créer une référence sur un tableau anonyme

$reftableau = [1,2,['a','b','c']];  # le 3° élément du tableau est lui-même une référence sur un tableau anonyme de 3 éléments

Il est possible de créer une référence sur une table de hashage anonyme

$refhash = { 'monday' => 'lundi', 'tuesday' => 'mardi' };

Opérateur de référencement historique du C.

print ${$refscalaire};               # peut s'écrire $$refscalaire
print @{$reftableau};                # peut s'écrire @$reftableau
for my $key (%($refhashage) { };     # peut s'écrire %$refhashage
&{$refonction}(); 

print $reftableau->[0];  # affiche le premier élément du tableau
print $refhashage->{cle} # affiche la valeur associé à cle dans la table de hashage

Lorsqu'une valeur utilisée comme référence est déjà définie mais n'est pas une référence dure, la valeur du scalaire est considérée comme le nom d'une variable.

$name        = "variable";
$$name       = 1;   # affecte $variable
${$name}     = 2;   # affecte $variable
${$name x 2} = 3;   # affecte $variablevariable
$name->[0]   = 4;   # affecte $variable[0]
@$name       = ();  # efface @variable
&$name();           # Appelle &$variable()

abs(x)	   # valeur absolue
cos(x)	   # cosinus
exp(x)	   # exponentielle
int(x)	   # partie entière
log(x)	   # logarithme
sin(x)	   # sinus
sqrt(x)	   # racine carrée
rand	   # entier pseudo aléatoire
srand	   # nouvelle séquence de nb aléatoires
atan2(x,y) # arc tangente de y/x

my $arrondi=int($valeur * 10 ** $n + 0.5) / 10 ** $n;

chop(chaine);               # suppression du dernier caractère
chomp(chaine);              # suppression du retour chariot 
$ligne=~s/\r\n/\n/;         # pour faire un dos2unix quand le chomp ne fonctionne pas
index(chaine,sschaine);     # indice de la 1ière occurrence de chaine dans sschaine
rindex(chaine,sschaine);    # indice de la dernière occurrence de chaine dans sschaine
index(chaine,sschaine,pos); # indice de la 1ière occurrence de chaine dans sschaine à partir de la position pos
length(chaine);             # taille de la chaîne 
lc(chaine);                 # retourne la chaîne en minuscule (perl 5)
lcfirst(chaine);            # retourne la chaîne avec le 1er caractère en minuscule
split(sep,chaine);	    # sépare la chaîne en éléments en fonction du séparateur
substr(chaine,début,lng);   # extraction d’une sous chaîne 
uc(chaine);                 # retourne la chaîne en majuscules (perl5)
ucfirst(chaine);            # met le 1er caractère de la chaîne en majuscule
chr(code);                  # retourne le caractère qui correspond au code ASCII
ord('x');                   # retourne le code ASCII d'un caractère
$toto=~s/toto/titi/g;       # substitution de toto par titi dans la chaîne de caractères (autant de fois que nécessaire)
$toto=quotemeta(chaine);    # ajoute des \ à tous les caractères autre que [A-Za-z_0-9]
$toto=sprintf("%04d",$i);   # retourne le numérique formaté sur 4 digit (0003 pour 3) 

printf "fmt1 fmt2 ... fmtx",val1,val2,...,valx

Même convention que la fonction printf du langage C.

exec(« cmd »)   # exécute la commande, pas de valeur de retour et pas de retour au programme perl (sauf erreur)
system(« cmd ») # sortie console, attend la fin d’exécution. Valeur retournée code de retour de la commande.
qx(cmd)         # idem permet de récupérer la sortie de la commande. Pas de sortie console.
                # Code de retour dans variable $?
                # Peut s’écrire qx(cmd), qx/cmd/ ou qx`cmd`
`cmd`           # idem qx, écriture simplifiée.

time      # retourne le nombre de secondes depuis le 01/01/1970
mktime    # convertit une date en nombre de secondes depuis le 01/01/1970   (use POSIX 'mktime';)
gmtime    # retourne heure Greenwitch
localtime # retourne heure locale
strftime  # formatage date/heure      (use POSIX 'strftime';)

my ($sec, $min, $hour, $day, $month, $year, $wday)=localtime(time()); 

Le mois retourné est une valeur entre 0 et 11, il faut donc ajouter 1.

L'année retournée est par rapport à l'année 1900, il faut donc ajouter 1900.

strftime("%d%m%Y",0,0,0,$day,$month,$year);

use POSIX 'mktime';
 
mktime(sec,min,heure,jour,mois-1,année-1900)

getlogin # donne le nom du login
exit     # interruption du script avec code retour
sleep(x) # suspend l’exécution pendant x secondes
die      # interruption avec message
alarm(x) # Met en place un SIGALARM à délivrer au processus après x secondes. Une seule horloge à la fois. alarm(0) pour annuler.
caller   # retourne le contexte de l'appel de la routine en cours (voir exemple)
crypt    # crypte une chaîne de caractères

sub debug {
    my ($package, $filename, $line, $subroutine) = caller();
    print "Appel depuis sous routine $subroutine du package $package du fichier $filename ligne $line\n";
}
 
sub fonction {
    debug();
}
 
fonction();

for (my $i=$n; $i > 0 ; $i--) { ... }  # Boucle de $n à 1
for $var (liste) { ... }               # Parcourt la liste
foreach $var (liste) { ... }           # Cette forme préserve la variable $var si utilisée avant
for (@tab) { ... }                     # Équivalent à for $_ (@tab) { ... }
while (...) { ... }
until (...) { ... }
do { ... } while (...)

last   # équivalent du break, sort de la boucle
next   # équivalent du continue, passe à l'itération suivante
redo   # rejoue l'itération

if (...) {
} elsif (...) {
} else {
}

<instruction> if (...);        # Attention une seule instruction pas de bloc de commande !
<instruction> unless ( ...);   # Test inversé équivalent à if (! ... )

sub toto {
  les paramètres se retrouvent dans @_ : $_[0], $_[1], ...
  return $retour ou bien return @retour pour retourner des paramètres
}

print @_."\n";          # affiche le nombre d'arguments car le . s'applique à des scalaires.
print scalar(@_)."\n";  # idem
print "@_\n";           # affiche la liste des éléments

sub toto {
  my $ref_tab1=$_[0] ; my $ref_tab2=$_[1] ;
  my @tab1=@$ref_tab1 ; my %tab2=%$ref_tab2 ;
}
 
&toto(\@tab1,\%tab2);

sub Ma_Fonction {
    my ($hash1, $hash2, $hash3) = @_;
 
    print "Cle 1 de hash toto = $hash1->{1}\n";
    print "Cle 1 de hash pouet = $hash2->{3}\n";
    print "Cle 1 de hash truc = $hash3->{5}\n";
 
    $hash1->{1} = 'POUETTTT';
} 
 
Ma_Fonction(\%toto, \%pouet, \%truc);

sub toto {
  my $ref_tab1=$_[0];
 
  $ref_tab1->[$#{ref_tab1}]="modification du dernier élément du tableau";
}
 
&toto(\@tab1);

sub toto {
    my %resultat;
    ...
    return (\%resultat);
}
 
my $ref=&toto;
my %resultat=%$ref;

use experimental 'try';
 
try {
    appel_fonction();
}
catch ($e) {
    warn "Erreur appel fonction : $e";
}
finally {
    print "Fin\n";
}

autodie

eval {
    use autodie;
 
    open(my $fh, '<', $some_file);
    my @records = <$fh>;
    ...
    close($fh);
};
 
if ($@ and $@->isa('autodie::exception')) {
    if ($@->matches('open')) { print "Error from open\n";   }
    if ($@->matches(':io' )) { print "Non-open, IO error."; }
} elsif ($@) {
    # A non-autodie exception.
}

STDIN    # entrée standard (clavier)
STDOUT   # sortie standard (écran)
STDERR   # sortie erreurs

$var = <STDIN>;            # affecte à partir de l’entrée standard (clavier ou redirection)
@tab = <STDIN>;            # affecte à partir de l’entrée standard plusieurs lignes dans une liste.
print STDERR "erreur\n"	   # affiche sur la sortie d’erreur (comme warn ou die)
 
# saisie d'un mot de passe sans affichage à l'écran
do {
    system("stty -echo");
    printf "Saisie mot de passe : "
    $pw=<STDIN>; chomp $pw;
    system("stty echo");
    printf "\n";
} while ($pw eq "");

open(IN,"/tmp/fichier");               # Ouverture d'un fichier pour lecture
open(OUT,"| commande");                # Redirection dans une commande
open(OUT,">/tmp/fichier");             # Ecrase le fichier
open(OUT,">>/tmp/fichier");            # Ajoute au fichier
open(IN,"ls –l /etc |");               # On pipe la commande pour récupérer le résultat dans notre entrée fichier.
print OUT "…\n";                       # Ecriture simple dans le fichier
close(OUT);                            # Ferme le fichier.
while (defined($ligne=<IN>)) {   }     # Pour être sûr, au cas où une ligne contiendrait undef
foreach my $ligne (reverse(<IN>)) { }  # Pour parcourir le fichier à l’envers

open(IN,"< $fichier") || die "Impossible d'ouvrir le fichier $fichier : $!";
while (defined($ligne=<IN>)) {   
    chomp $ligne;
}
close IN;

open(IN,"< $fichier") || die "Impossible d'ouvrir le fichier $fichier : $!";
my @lignes=<IN>;
close IN;

open(OUT,">$fichier") || die "Impossible d'écrire dans le fichier $fichier : $!";
for my $ligne (@lignes) {
    print OUT "$ligne\n";
}
close OUT;

sub maproc {
    my $filehandle=$_[0];
    my $nom_fichier=$_[1];
 
    open($filehandle,">$nom_fichier");
}
 
&maproc(*OUT,"nom_du_fichier");

• En cas de problème d'encodage, avec l'UTF8 notamment, il est possible de le préciser :

open(OUT,">:utf8","/tmp/fichier");

• Ajout un BOM (Byte Order Mark) en début de fichier

open(OUT,">:utf8","/tmp/fichier");
print OUT "\x{FEFF}";  # BOM pour UTF-8

• Pour vérifier l'encodage d'un fichier :

file -i /tmp/fichier.txt 
fichier.txt: text/plain; charset=utf-8

• Possibilité d'utiliser la commande iconv pour convertir des fichiers.

chomp $ligne;   # vire le \n de la fin
chomp @tab;     # vire le \n sur chaque élément

A l'aide de l'unité Tie::File on peut manipuler le fichier au travers d'un tableau qui contient toutes les lignes du fichier.

use Tie::File;
 
tie(my @fichier,'Tie::File',"/chemin/vers/fichier") || die("Impossible d'ouvrir le fichier : $!");
 
for (@fichier) {
  s/<expression régulière>/chaine de remplacement/g;        # remplace l'expression régulière dans tout le fichier
}
 
untie @fichier;

Toutes les fonctions habituelles sur les tableaux sont utilisables (push, pop, unshift, shift, splice) sauf qu'elles s'appliquent directement au fichier.

Source

@liste_fichiers = glob("/tmp/*.txt");     # renvoi la liste des fichiers .txt dans le répertoire /tmp 
symlink($fichier,$lien);                  # création lien sur fichier (attention le nom du nouveau lien doit être complet)
readlink($toto);                          # retourne le fichier pointé par un lien
unlink(@liste_de_fichier);                # efface la liste de fichiers, retourne le nombre de fichier(s) effacé(s).
rename($file1,$file2);                    # renomme file1 en file2 (retourne 0 en cas d'échec et 1 en cas de succès)
move($file1, $file2);                     # déplace fichier file1 en file2 (use File::Copy)
copy($file1, $file2);                     # copy file1 en file 2 (use File::Copy)
cp($file1, $file2);                       # copy file1 en file 2 en conservant les droits du fichier (use File::Copy)
$rep=getcwd();                            # récupère répertoire courant (use Cwd)
$rep=abs_path($chemin);                   # retourne le chemin absolue (use Cwd 'abs_path')
$rep=File::Spec->abs2rel($chemin, $base); # retourne le chemin relatif (use File::Spec)
chdir($chemin);                           # changer le répertoire courant
dirname($fichier);                        # retourne le chemin du fichier (use File::Basename)
basename($fichier,@suffixlist);           # retourne le nom du fichier (use File::Basename)
($nom,$path,ext)=fileparse($fic,@suffix); # retourne le nom, le chemin et l'extension du fichier (use File::Basename)
mkpath                                    # création arborescence (use File::Path)
rmtree                                    # suppression arborescence (use File::Path)
utime($a_time,$mtime,$fichier);           # modifie la date d'accès et de modification d'un fichier

my @file_status=stat("/tmp/fichier.txt");

Retourne un tableau avec les informations du fichier :

 0 dev      device number of filesystem
 1 ino      inode number
 2 mode     file mode  (type and permissions)
 3 nlink    number of (hard) links to the file
 4 uid      numeric user ID of file's owner
 5 gid      numeric group ID of file's owner
 6 rdev     the device identifier (special files only)
 7 size     total size of file, in bytes
 8 atime    last access time in seconds since the epoch
 9 mtime    last modify time in seconds since the epoch
10 ctime    inode change time in seconds since the epoch (*)
11 blksize  preferred I/O size in bytes for interacting with the file (may vary from file to file)
12 blocks   actual number of system-specific blocks allocated on disk (often, but not always, 512 bytes each)

chmod(0700,$FILE);                                                                     # toujours commencer par 0 en l’absence de sticky bit
my $uid = getpwnam "utilisateur";                                                      # récupération user id
my $gid = getgrnam "groupe";                                                           # récupération group id
my $name = getpwuid($num);                                                             # récupération username à partir du uid
($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) = getpwuid($uid);  # récupération des infos du fichier /etc/passwd
($group, $passwd, $gid, $members) = getgrgid($num);                                    # à partir du gid récupération groupe, et des membres du groupe
chown($uid,$gid,$fichier);                                                             # modification propriétaire fichier
chroot("chemin"); chdir("/");                                                          # chroot (suivre par un chdir pour s'assurer que l'on n'est pas en dehors de l'arborescence)
umask                                                                                  # retourne la valeur courante de umask
umask 0666                                                                             # retourne la valeur de umask et la position à la valeur 0666

mkdir filename,mode  # crée le répertoire avec les droits spécifiés. Retourne vrai en cas de succès.
rmdir filename       # efface le répertoire si vide. Retourne vrai en cas de succès. En l’absence de filename, utilise $_.

opendir(DIR, « répertoire ») or die(« Erreur ouverture répertoire ») ;
@liste_fichier=readdir(DIR) ;
closedir(DIR) ;

ou plus simplement avec la fonction glob :

@liste_fichier=glob("/tmp/*.txt");

use strict;
use warnings;
 
my $pid = fork();
 
if (defined $pid) {
    if ($pid == 0) {
        # Processus enfant
        print "Je suis le processus enfant, mon PID est $$\n";
        sleep(2); # on attend un peu
        print "Processus enfant terminé\n";
    } else {
        # Processus parent
        print "Je suis le processus parent, mon PID est $$, et le PID de mon enfant est $pid\n";
        waitpid($pid, 0); # Attendre la fin du processus enfant
        print "Processus enfant terminé, continuons\n";
    }
} else {
    die "Impossible de créer un processus enfant : $!";
}

Nécessite l'installation du module CPAN threads

cpan install threads

use strict;
use warnings;
use threads;
use threads::shared;
 
# Variable partagée
my $shared_var :shared = 0;
 
# Fonction à exécuter dans un thread
sub worker {
    my $thread_id = threads->tid();
    {
        lock $shared_var;
        $shared_var++;
        print "Thread $thread_id a incrémenté la variable partagée à $shared_var\n";
    }
    sleep(1); # Simuler un travail
}
 
# Créer plusieurs threads
my @threads;
for my $i (1..3) {
    push @threads, threads->create(\&worker);
}
 
# Attendre la fin de tous les threads
foreach my $thr (@threads) {
    $thr->join();
}
 
print "Valeur finale de la variable partagée : $shared_var\n";

sub Is_interactive {
        return -t STDIN && -t STDOUT;
}

perl -i -pe 's/\r\n/\n/g' fichier        Transforme le fichier du format dos au format unix  
perl -i.bak -pe 's/\r\n/\n/g' fichier    Transforme le fichier du format dos au format unix et le sauvegarde avant en .bak

perl -i -lne 'if (/^(19\/08\/2019.+)$/) { } else {print "$_"}' *.csv      Supprime les lignes concernées dans les fichiers *.csv
perl -i.bak -lne 'if (/^(19\/08\/2019.+)$/) { } else {print "$_"}' *.csv  Renomme les fichiers origines en .bak avant transformation 

Compte le nombre de ; par ligne d'un fichier

perl -lne 'my $count=tr/;/;/; print "ligne $. : $count";' fichier

Des modules supplémentaires sont disponibles sur le site https://www.cpan.org/.

• Lancer la commande :

sudo perl -MCPAN -e shell

• Recherche des modules parlant de JSON :

cpan[1]> i /json/

sudo apt install cpanminus

sudo cpan  App::cpanminus

sudo cpanm <Nom_du_Module>
sudo cpanm JSON

sudo cpanm --uninstall <Nom_du_Module>

wget module.tar.gz
tar -xzf module.tar.gz
cd module

perl Makefile.PL
make
make test
make install

#!/usr/bin/perl
use strict;
use JSON;
 
my %hash=(
    'toto' => 'toto',
    'titi' => 'titi'
);
# création objet JSON
my $json = JSON->new->utf8->pretty(1);
# conversion hash en JSON
my $json_text = $json->encode(\%hash);
# sauvegarde dans un fichier
open(OUT,">fichier.json")||&erreur("Impossible d'écrire dans le fichier fichier.json : $!");
print OUT "$json_text";
close OUT;

#!/usr/bin/perl
use strict;
use JSON;
 
# Lire le fichier JSON
open(IN,"<fichier.json")||&erreur("Impossible d'ouvrir le fichier fichier.json : $!");
my $json_text = do { local $/; <IN> };
close IN;
 
# Convertir le JSON en hash Perl
my $hash_ref = JSON->new->utf8->decode($json_text);

#!/usr/bin/perl
use strict;
use warnings;
use JSON;
use Data::Dumper;
 
# Initialisation du parser JSON
my $json = JSON->new->utf8;
 
# Noms des fichiers
my $file1 = 'file1.json';
my $file2 = 'file2.json';
 
sub readJSONfromfile {
        my $file=$_[0];
 
        local $/;
        open(IN,"<$file") || die "Impossible d'ouvrir le fichier $file : $!";
        my $content = <IN>;
        close IN;
        return $json->decode($content);
}
 
# Fonction récursive pour fusionner deux hashes
sub merge_hashes {
    my ($hash1, $hash2) = @_;
    my %result = %{$hash1};  # Copie du premier hash
 
    for my $key (keys %{$hash2}) {
        if (exists $result{$key}) {
            if (ref($result{$key}) eq 'HASH' && ref($hash2->{$key}) eq 'HASH') {  # Fusion récursive si les deux valeurs sont des hashes
                $result{$key} = merge_hashes($result{$key}, $hash2->{$key});
            } elsif (ref($result{$key}) eq 'ARRAY' && ref($hash2->{$key}) eq 'ARRAY') { # Fusion des tableaux
                push @{$result{$key}}, @{$hash2->{$key}};
            } else { # Pour les autres cas, on garde la valeur du second fichier
                $result{$key} = $hash2->{$key};
            }
        } else { # Si la clé n'existe pas dans le premier hash, on l'ajoute
            $result{$key} = $hash2->{$key};
        }
    }
    return \%result;
}
 
# Lecture et décodage du premier fichier JSON
my $data1=&readJSONfromfile($file1);
print "Données du fichier 1:\n";
print Dumper($data1);
 
# Lecture et décodage du second fichier JSON
my $data2=&readJSONfromfile($file2);
print "\nDonnées du fichier 2:\n";
print Dumper($data2);
 
# Fusion des données selon leur type
my $merged_data;
 
if (ref($data1) eq 'ARRAY' && ref($data2) eq 'ARRAY') { # Fusion de tableaux
    $merged_data = [@$data1, @$data2];
} elsif (ref($data1) eq 'HASH' && ref($data2) eq 'HASH') { # Fusion d'objets de manière récursive
    $merged_data = merge_hashes($data1, $data2);
} else {
    die "Les fichiers doivent contenir soit deux objets, soit deux tableaux JSON";
}
 
print "\nDonnées fusionnées:\n";
print Dumper($merged_data);
 
# Encodage du résultat en JSON avec indentation
my $result = $json->pretty->encode($merged_data);
 
# Écriture dans un nouveau fichier
my $output_file = 'merged.json';
open(my $out, '>', $output_file) or die "Impossible de créer $output_file: $!";
print $out $result;
close($out);
 
print "\nFusion terminée. Résultat écrit dans $output_file\n";

Utilisation du module JSON::Validator

use JSON;
use JSON::Validator;
 
        if (-s "$FILE_CONF") {
                open(IN,"$FILE_CONF")||erreur("Impossible d'ouvrir le fichier $FILE_CONF : $!");
                my $json_text = do { local $/; <IN> };
                close IN;
                $cfg = JSON->new->utf8->decode($json_text);
 
        } else {
                erreur("Fichier de configuration introuvable : $CYAN$FILE_CONF");
        }
        my $schema = {
                type => 'object',
                required => ['ports', 'services', 'serveurs'],
                properties => {
                        url => { type => 'string', format => 'uri' },
                        ports => {
                                type => 'object'
                        },
                        services => {
                                type => 'array',
                                items => { type => 'string' }
                        },
                        serveurs => {
                                type => 'array',
                                items => {
                                        type => 'object',
                                        required => ['nom' ],
                                        properties => {
                                                nom => { type => 'string' },
                                                IP => { type => 'string', format => 'ipv4' },
                                                tcp => {
                                                        type => 'array',
                                                        items => {
                                                                type => 'integer',
                                                                minimum => 1,
                                                                maximum => 65535
                                                        }
                                                },
                                                udp => {
                                                        type => 'array',
                                                        items => {
                                                                type => 'integer',
                                                                minimum => 1,
                                                                maximum => 65535
                                                        }
                                                },
                                                url => {
                                                        type => 'array',
                                                        items => { type => 'string', format => 'uri' }
                                                }
                                        }
                                }
                        }
                }
        };
        my $validator = JSON::Validator->new;
        $validator->schema($schema);
        my @errors = $validator->validate($cfg);
        if (@errors) {
                for my $err (@errors) {
                        print "$ROUGE\t- $err\n";
                }
                erreur("Erreur fichier de configuration $FILE_CONF");
        }

Formats disponibles

Validation JSON en ligne

Il est possible de gérer des requêtes http au travers du module CGI.

• Activer l'exécution CGI au niveau apache :

sudo a2enmod cgid

• Préciser la localisation des scripts CGI dans la conf du site :

       ScriptAlias "/cgi-bin/" "/var/www/html/..../cgi-bin/"

• Copier le script dans le répertoire sans oublier de le rendre exécutable

#!/usr/bin/perl
 
use strict;
use warnings;
use CGI;
 
# Créer un nouvel objet CGI
my $cgi = CGI->new;
 
# Récupérer les paramètres de la requête POST
my $param1 = $cgi->param('param1');
my $param2 = $cgi->param('param2');
 
# Imprimer l'en-tête HTTP
print $cgi->header('text/html');
 
# Afficher les valeurs reçues
print "<html><body>";
print "<h1>Paramètres reçus</h1>";
print "<p>param1: $param1</p>";
print "<p>param2: $param2</p>";
print "</body></html>";

#!/usr/bin/perl
 
use strict;
use warnings;
use CGI;
use JSON;
 
# Créer un nouvel objet CGI
my $cgi = CGI->new;
 
# Récupérer les données de la requête POST
my $json_text = $cgi->param('POSTDATA');
 
# Vérifier si des données ont été reçues
if (defined $json_text) {
    # Convertir le JSON en structure de données Perl
    my $data;
    eval {
        $data = decode_json($json_text);
    };
    if ($@) {
        print $cgi->header('application/json', '400 Bad Request');
        print encode_json({ error => "Invalid JSON format" });
        exit;
    }
 
    # Imprimer l'en-tête HTTP
    print $cgi->header('application/json');
 
    # Faire quelque chose avec les données reçues (par exemple, les afficher)
    print encode_json({ received => $data });
} else {
    print $cgi->header('application/json', '400 Bad Request');
    print encode_json({ error => "No data received" });
}

#!/usr/bin/perl
 
use strict;
use warnings;
use CGI;
use JSON;
 
# pretty pour identation
# canonical pour trier en fonction des clefs
my $JSON = JSON->new->utf8->pretty(1)->canonical(1);
 
my $filename = "data.json";
 
# Créer un nouvel objet CGI
my $cgi = CGI->new;
 
# Récupérer les données de la requête POST
my $json_text = $cgi->param('POSTDATA');
 
# Vérifier si des données ont été reçues
if (defined $json_text) {
        # Convertir le JSON en structure de données Perl
        my $data;
        eval {
                $data = decode_json($json_text);
        };
        if ($@) {
                print $cgi->header('text/html', '400 Bad Request');
                print "<html><body>";
                print "<p>KO</p>";
                print "</body></html>";
        } else {
                if (open(OUT,">$filename")) {
                        my $json=$JSON->encode($data);
                        print OUT "$json\n";
                        close OUT;
                        print $cgi->header('text/html');
                        print "<html><body>";
                        print "<p>OK</p>";
                        print "</body></html>";
                } else {
                        print $cgi->header('text/html', '500 Internal Server Error');
                        print "<html><body>";
                        print "<p>Unable to write file</p>";
                        print "</body></html>";
                }
        }
} else {
        print $cgi->header('text/html', '400 Bad Request');
        print "<html><body>";
        print "<p>No data received</p>";
        print "</body></html>";
}

cpanm PAR
cpanM PAR::Packer

pp -o fichier.exe fichier.pl

https://djibril.developpez.com/tutoriels/perl/poo/

Ajouter les lignes suivantes en début de script :

use utf8;
use open qw(:std :utf8);
binmode(STDOUT, ":utf8");

• Avant l'exécution taper

chcp 65001

• Avant l'exécution taper

$OutputEncoding = [System.Text.Encoding]::UTF8
[Console]::OutputEncoding = [System.Text.Encoding]::UTF8

• Vérification

[Console]::OutputEncoding

• exécuter

if (!(Test-Path $PROFILE)) {
    New-Item -Type File -Path $PROFILE -Force
}
echo $PROFILE

• puis éditer le fichier Microsoft.PowerShell_profile.ps1 pour y ajouter

# Configuration pour UTF-8
$OutputEncoding = [System.Text.Encoding]::UTF8
[Console]::OutputEncoding = [System.Text.Encoding]::UTF8

perl –d fichier.pl	# lancement en mode debug
# !/usr/bin/perl –w	# le –w permet d’afficher les warning.

Par défaut le répertoire courant n'est pas dans la variable @INC, il faut donc éventuellement l'ajouter avant l'appel du package à inclure :

#!/usr/bin/perl
use warnings;
use strict;
use Cwd;
use File::Basename;
 
my $BINDIR;
my $PRGNAME;
my $EXT;
 
BEGIN {
        ($PRGNAME,$BINDIR,$EXT)=fileparse($0,qr/\.[^.]*/);
        unshift(@INC,$BINDIR);
}
 
use common;

Lors de l'installation obtention de l'erreur suivante :

Couldn't untar local-lib-2.000024.tar: 'Cannot allocate memory'

Tenter l'installation de la façon suivante :

sudo curl -L http://cpanmin.us | perl - --sudo App::cpanminus