#REPLACE_1

#!/usr/bin/perl
#print "Content-type:text/html\n\n"; 

open(FICHIER, "<z1.txt") or die "Le fichier n'existe pas !";
while ($ligne = <FICHIER>)
 {
  $ligne =~ s/[.]/ /g;
  print $ligne;
 }
close FICHIER;

#---------------------------------------------------


#REPLACE_2

#!usr/bin/perl
#print "Content-type:text.html\n\n";

open(FICHIER, "<z1.txt") or die "error";
while (<FICHIER>)
{
 
#supprimer les caractères entre les crochets:
s/[\;><.]+/ /g;  
print $_;

}
close FICHIER;

#----------------------------------------------

#REPLACE_3

#!/usr/bin/perl
print "Content-type:text.html\n\n";

$ft="Lindon";

#s/i/o/g   :  à toutes les occurrences
#s/i/o/gi  :  i pour "ignore" casse (maj ou min)
$ft =~ s/i/o/;

print "$ft ";

#$ft now equals London.

exit;

#-----------------------------------------------

#REPLACE_4

#!/usr/bin/perl
print "Content-type:text.html\n\n";

$mystring = "hello, perl";
print $mystring."<br />";
substr($mystring, 7) = "world";
print $mystring."<br />";

#résultat:
#hello, perl
#hello, world

$mystring = "hello, perl, titi, toto";
print $mystring."<br />";
substr($mystring, 9, 11) = "";
print $mystring."<br />";

#résultat:
#hello, perl, titi, toto
#hello, peoto

#--------------------------------------------------------------

#SEARCH

#!/usr/bin/perl
print "Content-type:text/html\n\n";

open(FILE, "<pgredirect.txt") || die "Fichier non trouvé";
@lignes = <FILE>;
close(FILE);
#print @lignes;

$nom = translator;
for ($i=0; $i<@lignes; $i++)
   {
	if($lignes[$i] =~ /$nom/)
        {
          print "$nom est à la ligne $i\n";
	}
   }

#---------------------------------------------------------

#OPEN AND WRITE_1

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open(FICHIER, "<z1.txt") or die "Le fichier n'existe pas !";
open(WRITER, ">decode.txt") or die "Le fichier ne peut être édité !\n";
$i=0;
while ($ligne = <FICHIER>)
{
#écrire 10 lignes:
      if($i<10)
      {
         print WRITER $ligne;
      }
 $i++;
}
close FICHIER;
close WRITER;

#lire les 10 lignes dans "decode.txt":
open(FICHIER, "<decode.txt") or die "Le fichier n'existe pas !";
while ($ligne = <FICHIER>)
{
   print $ligne;
}
close FICHIER;

#--------------------------------------------------------------------

#OPEN AND WRITE_2

#!/usr/bin/perl
print "Content-type:text/html\n\n";

open(DA, ">places.txt");

#you can print anything you want to a file handle : text, variables, lists, you name it !
#print FILEHANDLE "I see London";
#print FILEHANDLE "$name";
#print FILEHANDLE @list;
#print FILEHANDLE %hash;

print DA "I see London\n";
close(DA);

open(DA, "<places.txt");
@da=<DA>;
close(DA);

print @da;

exit;

#--------------------------------------------------------------

#OPEN AND WRITE_3

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open(TEXT, ">text");
print TEXT "Bonjour le monde.\n";
close(TEXT);

#------------------------------------------------------------

#OPEN AND READ_1

#!/usr/bin/perl

open(FICHIER, "<z1.txt") or die "Le fichier n'existe pas !";
while ($ligne = <FICHIER>)
{
   print $ligne;
}
close FICHIER;

#------------------------------------------------

#OPEN AND READ_2

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open (READ, "data.txt") || die "can't open";
while (<READ>) 
{
print "$_";
}
close READ;

#-----------------------------------------------------

#OPEN AND READ_3

#!/usr/bin/perl -w
print "Content-type:text.html\n\n";

open(FILE, "<data.txt") || die "Fichier non trouvé";
@lignes = <FILE>;
close(FILE);

print @lignes;

#--------------------------------------------------------

#OPEN AND READ_4

#!/usr/bin/perl
print "Content-type:text/html\n\n";

#contenu de : cities.txt :
#London
#Paris
#Tokyo

open(DA, "<cities.txt");
@huhu=<DA>;
close(DA);

print $huhu[2];

exit;

#----------------------------------------------------

#OPEN AND READ_5  (ligne par ligne):

#!/usr/bin/perl
print "Content-type:text.html\n\n";

@lignes = ("");
open(FILE, "<toto.txt") || die "fichier non trouvé\n";
while(<FILE>)
 {
  push(@lignes,$_);
 }
close(FILE);
for(@lignes)
 {
   print $_;   
 }

#-----------------------------------------------------

#OPEN AND READ_6

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open (F, "my_file.txt");
undef $/;
$contenu_fichier = <F>;

close(F);
print $contenu_fichier;
exit;

#------------------------------------------------------

#OPEN AND READ_7

open( MON_FICHIER, "<data.txt" );
my $ligne;
foreach $ligne ( <MON_FICHIER> )
{
chomp( $ligne );
print STDOUT "$ligne\n";
}
close( MON_FICHIER );

#----------------------------------------------------

#FOREACH

#!/bin/perl

open(FLUX, "fichier");

@LIGNES = <FLUX>;

close(FLUX);

print("accès en liste : \n");

$i = 0;

foreach $ligne (@LIGNES)

{

print("LIGNE[$i] : $ligne");

$i++;

}

#résultat:
accès en liste :

LIGNE[0] : première ligne

LIGNE[1] : deuxième ligne

LIGNE[2] : troisième ligne

#------------------------------------
# foreach avec grep

open(DA, "<toto.txt");
@LIGNES = <DA>;
close(DA);

@resultat = grep(/pattern/, @LIGNES);

$i = 0;
foreach $ligne (@resultat)
{
print("LIGNE[$i] : $ligne");
$i++;
}

#------------------------------------------------------------

#push - pop : travaillent sur la fin d'un tableau

open(F, "<data.txt");
@liste = <F>;
close(F);

push(@liste, "ligne rajoutée");  #"ligne rajoutée" est ecrit dans 'data.txt
print @liste;

pop(@liste);   #"ligne rajoutée" est supprimée de 'data.txt

#-------------------------------------------------------

#unshift() : ajoute au début d'un tableau

#shift() : supprime le début d'un tableau

#------------------------------------------------------

$file = "hello.txt";
open(GREETING, $file);

#is the same that:

$file = "hello";
open(GREETING, "$file.txt");

#--------------------------------------------------

#IF AVEC PLUSIEURS CONDITIONS:

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open (FILE, "<ztest.txt") or die "error";
while ($line = <FILE>) 
 { 
  $pattern1 = "<!-- Rosae:: ";
  $pattern2 = "html"; 
 
    if (($line =~ /$pattern1/) &&  ($line !~ /$pattern2/))

   { 
     print $line;
   }
        
 }
close(FILE);  

#------------------------------------------------------------

Substituer une partie d'une chaîne à une autre : s/// 

Rappel : la syntaxe est s/regex décrivant l'élément à remplacer/élément remplaçant/options 

Exemples : 
$variable =~ s/a/b/;
Cette commande va remplacer le premier 'a' de la ligne par 'b'. Pour remplacer tous les 'a' faire : 
$variable =~ s/a/b/g;
Si en plus nous voulons que cela ne fasse pas la différence entre les majuscules 
et les minuscules (case sensitive), faire 
$variable =~ s/a/b/gi;
Pour remplacer tous les ensembles de caractères commençant par 'a', 
finissant par 'e' et avec au moins un caractère au milieu sans être sensitif par 'toto', faire : 
$variable =~ s/a.*e/toto/gi;

#--------------------------------------------------

La traduction : tr/// 

Cette construction "à la regex" permet de remplacer des caractères par d'autres dans une chaîne, 
à la manière de la commande unix 'tr'. 
La syntaxe est tr/éléments à traduire/éléments traduits/
Ou y/éléments à traduire/éléments traduits/ 

Exemple : 
$variable =~ tr/a-b/A-B/;
Cela va transformer tous les 'a' et 'b' minuscules en majuscules. 

Plus d'info sur : 
man perlre
man perlretut (le tutoriel sur les regex, une bonne lecture !)

#---------------------------------------------------

Tableaux et tables de hachage multidimensionnels 

On a vu plus haut que les tableaux Perl ne possèdent qu'une seule dimension 
(il ne peuvent contenir que des éléments de type scalaire). On a aussi vu plus haut 
l'existence de références, type scalaire particulier qui permet de se référer à une variable, 
donc en l'occurence à un tableau. 
Ainsi pour représenter la matrice 
0 1 2
3 4 5
6 7 8
Nous allons pouvoir faire : 
@ligne1 = (0, 1, 2);
@ligne2 = (3, 4, 5);
@ligne3 = (6, 7, 8);
@matrice = (\@ligne1, \@ligne2, \@ligne3);
Perl introduit une nouvelle notation pour ce faire : au lieu d'entourer la liste 
avec des parenthèses, nous allons le faire avec des crochets, ce qui aura pour effet de retourner une référence : 
$ligne1_ref = [0, 1, 2];
etc...
ou plus simplement : 
@matrice = (
[0, 1, 2],
[3, 4, 5],
[6, 7, 8],
);
Dans tous ces cas, @matrice est un tableau de trois éléments, qui sont chacun une référence 
vers un autre tableau. $matrice[1] est une référence sur la 2ème ligne de la matrice.

#-------------------------------------------------------

open(FILE, "< nom du fichier"); # ouvre en lecture 
open(FILE, "  nom du fichier"); # idem 
open(FILE, "> nom du fichier'); # ouvre en écriture 
open(FILE, ">>nom du fichier'); # ouvre en ajout

#-----------------------------------------------------------

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open (F, "my_file.txt");
undef $/;
$contenu_fichier = <F>;

close(F);
print $contenu_fichier;

exit;

#--------------------------------------------------------------

#Ce script se lisant lui-meme, un signe '#' a été rajouté en début de ligne pour desactiver son exécution


#   Le [perl_script.pl script] va se lire lui-même et sortir à l'écran son contenu modifié : 
#   #!/usr/bin/perl -W
#   # Fichier script.pl
#   use strict qw(subs vars refs); 

#   my $file = "$0"; 

#   open(FILE, "<$file"); 

#   #Lecture du fichier ligne par ligne jusqu'à la fin du fichier.
#   while (<FILE>) {
#   #Remplace tous les mots 'file' par 'fichier'.
#   $_ =~ s/file/fichier/ig;
#   #Transforme les lettres minuscules de 'a' à 'e' en majuscules.
#   $_ =~ tr/a-e/A-E/;
#   #Affiche le résultat des transformations à l'écran.
#   print $_;
#   } 

#   close(FILE);
#   #Fin script.pl

#--------------------------------------------------------------

open(FILE, "test") 	Lecture seule 
open(FILE, "<test") 	Lecture seule 
open(FILE, ">test") 	Ecriture avec troncature 
open(FILE, ">>test") 	Ecriture en fin de fichier 
open(FILE, "+<test") 	Lecture/écriture (fichier existant, sans troncature) 
open(FILE, "+>test") 	Lecture/écriture (troncature, création de fichier si nécessaire) 
open(FILE, "+>>test") 	Lecture/écriture (sans troncature, écriture depuis al fin, 
                           création de fichier si nécessaire)

#-------------------------------------------------------------------------

#!/usr/bin/perl

print "Content-type:text.html\n\n";
$i = 1;
print "d'abord la racine carrée de  1 à 10...\n\n";
while($i <= 10)
 {
  print "La racine carrée de ", $i, " est ", sqrt($i), "\n";
  $i++;
 }
$i = 1;
print "et maintenant le carré des nombres de  1 à 10...\n\n";
until($i > 10)
 {
  print "Le carré de  ", $i, " est ", $i * $i, "\n";
  $i++;
 }

#---------------------------------------------------------------------------

#!/usr/bin/perl

print "Table de multiplication de 2\n";
$i = 0;
while($i<=10){
	print "$i*2 = ".($i*2)."\n";
	$i++;
}

#------------------------------------------------------------------------

#!/usr/bin/perl

print "Table de multiplication de 2\n";
$i = 0;
until($i>10){
	print "$i*2 = ".($i*2)."\n";
	$i++;
}

#------------------------------------------------------------------------

#!/usr/bin/perl

#Utilisation d'une liste: 
@hello = ("Hello", "world", "!\n");
print "$hello[0] $hello[1] $hello[2]";
print $hello[0]." ".$hello[1]." ".$hello[2];
print join(" ", @hello);

$a = "Hello"; $a = $a . " world"; $a .= " !\n";

#-------------------------------------------------------

#Parcourir les éléments d'une liste: 
foreach $mot (@hello) { print "$mot"; }
foreach (@hello) { print $_; }
foreach (@hello) { print; }
print foreach @hello;

#Ajouter un élément à une liste: 
push @liste, 'bonjou';

#Retirer le premier élément de la liste: 
$element = shift @liste;

#Trier une liste: 
@triee = sort @liste;
@triee = sort { ! $a <=> $b } @liste;

#Filtrer une liste: 
@selection = grep { $_ > 10 } @liste;

#--------------------------------------------------

#Boucle numérique classique (à la "C"): 
for ($i = 0; $i < 10; $i++) { print "$i\n"; }

#Boucle do/while/until: 
$i = 0;
while ($i < 10) { print "$i\n"; $i++; }
do { print "$i\n"; $i++; } until ($i == 10);

#----------------------------------------------------

#Ouvrir un fichier explicitement (en lecture): 
open(SOURCE, "<source.txt");
while (<SOURCE>) { ... }
close(SOURCE);

#Ouvrir un fichier explicitement (en écriture): 
open(SORTIE, ">sortie.txt");
print SORTIE "Contenu du fichier ...";
close(SORTIE);

#----------------------------------------------------

#Recherche d'un mot dans la chaîne: 
$a = "Hello world";
print "Trouvé" if $a =~ m/hello/;

#Recherche d'un mot dans la chaîne (insensible à la casse): 
print "Trouvé" if $a =~ m/hello/i;

#Egalité simple sur toute la chaîne: 
print "Egal" if $a =~ m/^Hello world!$/;

#Extraction d'un nombre: 
print "Premier nombre lu: $1" if /([0-9]+)/;
print "Premier nombre lu: $1" if /(\d+)/;

#Remplacer un mot par un autre (plusieurs fois si nécessaire): 
$a =~ s/un mot/par un autre/g;

#---------------------------------------------------------

#Push

#permet d’ajouter à la fin d’un tableau l’élément ou la liste d’éléments spécifiés.

#Exemple : 
Push(@voitures,"Audi");

#Le nombre d’éléments d’un tableau s’obtient en faisant $nbel = @tableau;
#On peut obtenir tous les éléments d’un tableau les uns à la suite des autres 
#avec un espace entre les différents éléments en faisant :

$liste = "@tableau";

#L’index du dernier élément d’un tableau peut être obtenu en faisant : 

$last = $#tableau;

#----------------------------------------------------------

#While

$i = 0 

Do while ($i < 10)

{ print $i++; 

}

#va afficher les nombres de 1 à 9 à l’écran.

#-----------------------------

#While

$I = 1

Do

{ print $I++;

}while ($I < 10);

#va afficher les nombres de 1 à 9 à l’écran.

#---------------------------------------------------------------

Parcourir une liste:

La boucle foreach fait parcourir la variable $element 
dans la liste @liste, dans l'ordre de ses éléments. 

foreach $element (@liste) 
{
 print "$element\n";
}

# façon classique avec une boucle for:

for ($i =0 ; $i < @liste ; $i++ ) {
  print "élément $i = $liste[$i]\n";
}


--------------------------------------------------------
#foreach

#Cette instruction permet de parcourir tous les éléments 
d’un tableau ou d’une structure quelconque. 
Elle se présente comme suit :

foreach $ligne(@lignes) 
{ 
#pour chaque élément du tableau
    if ($ligne =~ / /) 
    { 
    #si l'expresion régulière est match avec la ligne alors
    Print FIC "............\n"; 
    #la ligne est modifié par quelquechose ce que tu veux
    }
    elsif ($ligne =~ / /) 
    {  "une autre expression reguliere
     Print FIC "............\n"; #quelquechose
    }
    else 
    { 
    # et si aucune des expressions régulières
    print "la ligne:\n$ligne\n n'a pas été modifiée\n" ; 
    # renvoi dans le terminal :[saut de ligne]la ligne:....
    [saut de ligne]n'a pas été modifiée
    }
}close FIC


#Cet exemple va afficher tous les éléments du tableau @ensdelignes 
#car chaque élément du tableau est copié dans $ligne afin de pouvoir être traité. 
#Si le tableau est vide, on ne passera pas dans la boucle.

#--------------------------------------------------------------------

Commande	
Description

open(nom_symbolique," nom_fichier")	
Ouvre le fichier en lecture

open (nom_symbolique, "<nom_fichier")	
L'ouvre aussi en lecture

open (nom_symbolique, ">nom_fichier")	
Ouvre le fichier en écriture. S'il n'existe pas il est créé.

open (nom_symbolique,"

>>nom_fichier")	
Ouvre le fichier en ajout, tout ce qui est écrit dans le fichier sera placé à la fin de celui-ci.

open(nom_symbolique, "+>nom_fichier")	
Ouvre le fichier en lecture et en écriture 

open(nom_symbolique, | PROGRAM)	
Envoie les données imprimées dans le fichier nom_symbolique vers le programme PROGRAM

open(nom_symbolique,PROGRAM |)	
Utilise les données envoyées par PROGRAM comme source de données.

#----------------------------------------------------------

#afficher le code source d'une page html du web:

#!/usr/bin/perl

use LWP::Simple;
$doc = get 'http://www.corporesano.org';
print $doc;

#-------------------------------------------------------

#afficher la page web :

#!/usr/bin/perl
print "Content-type:text.html\n\n"
use LWP::Simple;
$doc = get 'http://www.lemonde.fr/web/meteo/0,31-0,42-355,0.html';

print $doc;

#----------------------------------------------------------

#getc (avec entete html non écrit ici)

#!/usr/bin/perl -w

open(FICHIER, "<data.txt");
my $octets = 0;
while(! eof(FICHIER)) 
{
 my $signe = getc(FICHIER);
 print "$signe";
 $octets++;
}
close(FICHIER);

print "$octets caractères lus!\n";

#------------------------------------------------------------

#getc sans entete html

#!/usr/bin/perl -w

print "Content-type:text.html\n\n";

open(FICHIER, "<data.txt");
my $octets = 0;
while(! eof(FICHIER)) 
{
 my $signe = getc(FICHIER);
 print "$signe";
 $octets++;
}
close(FICHIER);
print "\n\n";
print "$octets caractères lus!\n";

#------------------------------------------------------------

#ARGV

#!/usr/bin/perl
print "Content-type:text.html\n\n";

#les fins de fichiers doivent avoir un retour à la ligne
@ARGV = ("data.txt","cities.txt");
while ($ligne = <>)
{
print("$ligne");
}

#équivalent à :

@ARGV = ("data.txt");
while (<>)
{
print;
}

#-------------------------------------------------------------

#EOF

#!/usr/bin/perl
print "Content-type:text.html\n\n";

@ARGV = ("data.txt");
while ($ligne = <>)
{
print ("$ligne");
if (eof)
  {
    print ("\n __ fin du fichier __\n");
  }
} 

#si ARGV a 2 fichiers:
#eof   ajoutera à la fin de tous les 2 fichiers.
#eof() ajoutera qu'une fois à la fin des 2 fichiers.

#-------------------------------------------------------------

#SEEK
#contenu du fichier isbn.txt : ISBN 3-7723-7514-6

#!/usr/bin/perl
print "Content-type:text.html\n\n";

my $fichier = "isbn.txt";
my $numero_ISBN;
open(FICHIER, "<$fichier");
seek(FICHIER, 5, 0);
read(FICHIER, $numero_ISBN, 13);
close(FICHIER);
print "nb ISBN: $numero_ISBN";

#---------------------------------------------------------------

#FOREACH WITHIN AN ARRAY  (TABLE HTML)

#!/usr/bin/perl
print "Content-type:text.html\n\n";

#set up the html table
print "<table border='1'>";

#create an array
@names = qw(steve bill connor bradley);

#set a count variable
$count = 1;

#begin the loop
foreach $names(@names)
{
print "<tr><td>$count</td><td>$names</td></tr>";
$count++;
}
print "</table>";

#resultat:
# ____________
# |1 |steave  |
# |2 |bill    |
# |3 |connor  |
# |4 |bradley |
# |__|________|

#-----------------------------------------------------------------

#WHILE WITHIN AN ARRAY  (TABLE HTML)

#!/usr/bin/perl
print "Content-type:text.html\n\n";

#set up the html table
print "<table border='1'>";

#create an array
@names = qw(steve bill connor bradley);

#counter - count each row
$count = 1;

#counts each element of the array
$n = 0;

#use the scalar form of array
while ($names[$n]) 
{
   print "<tr><td>$count</td><td>$names[$n]</td></tr>";
   $n++;
   $count++;
}
print "</table>"; 

#resultat:
# ____________
# |1 |steave  |
# |2 |bill    |
# |3 |connor  |
# |4 |bradley |
# |__|________|

#------------------------------------------------------------

#FOR  (TABLE HTML)

#!/usr/bin/perl
print "Content-type:text.html\n\n";

#set up the html table
print "<table border='1'>";

#start the loop
for($start=1; $start<=5; $start++)
{
#print a new row each time through w/ increment
print "<tr><td>$start</td><td>this is row $start</td></tr>";
}
#finish the table
print "</table>";

#------------------------------------------------------------------

#AFFICHER CONTENU D'UNE TABLE DANS NAVIGATEUR

#!/usr/bin/perl
print "Content-type:text.html\n\n";
use Mysql;

$host = "..............";
$database = ".........";
$tablename = "........";
$user = ".........";
$pw = ".........";

#perl mysql connect()
$connect = Mysql->connect($host,$database,$user,$pw);

#select DB
$connect->selectdb($database);

#define a mysql query
$myquery = "SELECT * FROM $tablename";

#execute the query
$execute = $connect->query($myquery);

#html table
print "<table border='1'><tr>
<th>jour</th>
<th>mois</th>
<th>pression</th>
<th>temperature</th>
<th>humidite</th>
<th>precipitation</th></tr>";

#fetchrow array
while (@results = $execute->fetchrow())
{
print "<tr><td>"
.$results[0]."</td><td>"
.$results[1]."</td><td>"
.$results[2]."</td><td>"
.$results[3]."</td></tr>";

}
print "</table>";

#--------------------------------------------------

#OCCURRENCE

#!/usr/bin/perl
print "Content-type:text.html\n\n";

my $phrase = "toto titi";
my $mot_cherche = "i";
while($phrase =~ /$mot_cherche/g)
{
my $occurrence = pos($phrase);
print "$mot_cherche trouvé à position $occurrence\n";
}

close(FICHIER);

#------------------------------------------------------

#RECHERCHER POSITION D'UN MOT DANS FICHIER TEXTE:

#!/usr/bin/perl
#desactiver la ligne suivante pour avoir le code source de la page web
#print "Content-type:text.html\n\n";

open(FILE, "<z1.txt") || die "Fichier non trouvé";
@lignes = <FILE>;
close(FILE);
print @lignes;

#rechercher "Pression" :
$nom = "Pression";

for ($i=0; $i<@lignes; $i++)
{
    if($lignes[$i] =~ /$nom/)
      {
        print "$nom est en position $i\n";
      }
}

#-------------------------------------------------------

#CHAINE AVANT ET APRES

#!/usr/bin/perl
print "Content-type:text.html\n\n";

$cible = "AA-aaa-BB-bbb-C-C-ccc-DD";
$cible =~ /(b+)/;
print ("Chaine reperee :  $&\n");
print ("Chaine qui precede : $`\n");
print ("Chaine qui suit : $'\n");

#resultat:
#Chaine reperee : bbb
#Chaine qui precede : AA-aaa-BB-
#Chaine qui suit : -C-C-ccc-DD

#-----------------------------------------------------

#CAPTURE D'UN PATTERN

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open (FILE, "<z1.txt") or die "error";
while ($line = <FILE>) 
 { 
    chomp($pattern = "Pression");
    if ($line =~ /$pattern/) 
   { 
    print $line;
   }
 }
close FILE;

#-----------------------------------------------------

#SOUS PROGRAMME

#!/usr/bin/perl
print "Content-type:text.html\n\n";
 
sub ls
 {
  while(<*>)
      {
	print("$_\n");
      }
 }

&ls;

#-------------------------------------------------------
deleter - supprimer fichier d'un répertoire

unlink("fichier_a_deleter.txt")
#------------------------------------
#Commande Perl 	fonction 

rename() 	renomme ou déplace un fichier 
unlink() 	efface un fichier 
symlink(,) 	crée un lien symbolique (ln -s) 
chdir() 	change de répertoire 
mkdir() 	crée un nouveau répertoire 
rmdir() 	efface un répertoire 

#-------------------------------------------------------

#SPLIT

#!/usr/bin/perl 
print "Content-type:text.html\n\n";

open(FICHIER, "<data.txt");
while ($ligne = <FICHIER>)
{
   
  @Adresse = split(/,/,$ligne);
  #si on veut 1 caractère par ligne:
  #@Adresse = split(//,$ligne);
  $i = 0;
  for(@Adresse)
   {
     print $Adresse[$i],"\n";
     $i++;
   }
}
close FICHIER;

#-----------------------------------------------------

Pour parcourir chaque élément d'un tableau : 
foreach $variable (@tableau) {bloc}
A chaque itération, $variable prendra la valeur suivante de @tableau. 
Si on omet $variable, alors la valeur de l'élément sera stocké dans la variable $_ : 
foreach (@tableau) {bloc}

#----------------------------------------------------------

^	indique le début du modèle
$	indique la fin du modèle
.	caractère quelconque
*	répétition 0 fois ou plus du caractère qui précède
?	répétition 0 ou 1 fois du caractère qui précède
+	répétition 1 fois ou plus du caractère qui précède
\	empêche l'interprétation du caractère qui suit lorsque celui-là à
une spécification prédéfinie ( ex : ^, $, ., ?, etc..)
[..]	classe de caractères admissibles
(..|..)	alternative
\s	le caractère espace
\w	un caractère alphanumérique
\d	un caractère numérique

#------------------------------------------------------

initialisation des tableaux
classique : @tab = ( liste des éléments );
associatif : %tab = ( cle1,élément1,clé2,élément2, etc.. ); 

exemple : 
@mois = ("jan","fev","mars",...);
%num = ("jan",1,"fev",2,......); 

extraction d'un élément d'un tableau
classique :$tab[$i]=i-ième élément de tab;
associatif :$tab{$i}=valeur de la i-ième clé de tab; 

keys %tab=liste des clés de tab; 

parcours des éléments d'un tableau
classique :foreach $var (@tab) {on traite $var;}
associatif :foreach $cle (keys %tab) {on traite $cle ou la valeur de la clé dans le tableau associatif : $tab{$clé};} 

transformation d'un tableau en une chaine de caractères
syntaxe : $chaine = join($separateur,@tableau) 

$separateur est la chaine de caractères qui séparera les éléments du tableau. 

transformation d'une chaine de caractères en un tableau
syntaxe : @tableau = split($separateur,$chaine) 

$separateur est le modèle qui sépare les éléments de la chaine de caractères.

#----------------------------------------------------

#!/usr/bin/perl 

system "clear" ; 
print "De quel nombre voulez-vous la table de multiplication ? \n"; 
chop ($nb = <STDIN>); 
while ($nb<=0) 
{ 
print "erreur! Redonnez un nombre strictement positif.\n"; 
chop ($nb = <STDIN>); 
} 
print \n ; 
print "Table de multiplication de ",$nb,"\n"; 
for ($i = 0; $i < 11 ; $i++) 
{ 
$prod = $i * $nb; 
print "$i fois $nb = $prod \n"; 
}

#---------------------------------------------------------

MOYENNE DES NOTES ET TRIS.
#!/usr/bin/perl/ 

system "clear"; 

#on recupère le fichier contenant la liste des noms et des notes passé en argument 

if ($ARGV[0] eq "") {print "La syntaxe est triclasse nomdefichier.\n";} 
$fiche=$ARGV[0]; 
open(fic,"$fiche")||die "impossible d'ouvrir le fichier $fiche!"; 

#on crée un tableau associatif dont les clés sont les noms associ&eactes a la moyenne 

while ($ligne=) 
{#si on est à la fin du fichier on arrète 
if ((@champs=split(/\*/,$ligne))!=2) {last;} 
#on supprime le retour chariot de la fin de la ligne dans champs[1] 
chomp ($champs[1]); 
#on sépare les 3 notes 
@notes=split(/\s+/,$champs[1]); 
#on supprime la 1ère valeur de champs qui est un espace 
shift @notes; 
$som=$notes[0]+$notes[1]+$notes[2]; 
$moy=$som/3; 
$classe{$champs[0]}=$moy; 
#on incrémente le compteur d'élèves 
$i++; 
} 
print "Il y a ",$i," élèves.\n"; 

#on trie la liste des élèves par ordre alphabetique 
print "Voici la liste des élèves par ordre alphabetique:\n"; 
foreach $name (sort keys %classe) { 
printf "%s %10.2f\n",$name,$classe{$name}; 
} 

#on trie la liste des eleves par ordre de merite 
print "Voici la liste des eleves par ordre de merite:\n"; 
foreach $nom (reverse (sort by_value keys %classe)) { 
printf "%s %10.2f\n",$nom,$classe{$nom}; 
} 
sub by_value { 
local($test_num)=$classe{$a} <=> $classe{$b}; 
#si $classe{$a}=$classe{$b} les deux moyennes sont identiques, donc il faut trier par ordre alphabétique les noms 
# si les deux sont égaux, $test_num vaut 0, donc on trie selon la clé. Sinon on ne fait rien. 
if ($test_num) {return $test_num;} 
return $b cmp $a; 
}

#---------------------------------------------------------------

#!/usr/bin/perl 

# Procédure renversant l'ordre des lettres d'un mot donné 

sub reversmot 
{ 
local($word)=@_; 
local $i,$lg,$rword; 
$rword=""; 
$lg = length ($word); 
for ($i=$lg;$i>=0;$i--)
{
$rword .= substr ($word,$i,1); 
} 
return $rword; 
}

#------------------------------------------------------------

# Procédure créant une chaîne d'espaces à mettre entre deux mots 

sub metesd 
{ 
local($indd,$indf,@tab)=@_; 
local $i,$j,$esp; 
$esp = ""; 
for ($i=$indd;$i<$indf;$i++) 
{ for ($j=0;$j { $esp .= " "; 
} 
} 
return $esp; 
}

#---------------------------------------------------------

# Découpe la phrase en mots et les mets dans un tableau 

@phr=split(/\s+/,$frase); 
# Renverse l'ordre des lettres des mots de la phrase 
#voir plus haut : sub reversmot

for ($i=0;$i<= $#phr;$i++) 
{ 
$rphr[$i] = &reversmot ($phr[$i]); 
} 

# Calcule le nombre de mots de la phrase

$nbmots = $#rphr +1;

#--------------------------------------------------------

do {
    $line = <STDIN>;
} while ($line ne "");
# Lit l'entrée standard tant que $line n'est pas vide. 

do {
    $line = <STDIN>;
} until ($line eq "");
# Lit l'entrée standard jusqu'à ce que $line soit vide.

#---------------------------------------------------------

#grep

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open(DA, "<z2.txt");
@da=<DA>;
close(DA);

 @resultat = grep(/Pression/, @da);
print "@resultat\n";

#affiche la ligne contenant 'Pression'

#--------------------------------------------------------

#commandes 'system' - `entre cotes`  et 'require'

#!/usr/bin/perl
print "Content-type:text.html\n\n";

system ("pwd");

system ("ls -al");

$sortie = `ls`;
print $sortie;

#executer un fichier perl extérieur au présent fichier
require "mon_fichier.pl";

#---------------------------------------------------

#voici un petit exemple de la concision de Perl et de sa puissance : 

my @r = qw(Un programme Perl est 5 fois plus rapide a ecrire);
map { tr/A-Z/a-z/; s/\d//g; } @r;
foreach (sort grep !/^$/, @r) { print "$_\n"; }


Ce programme créé une liste de mots (la phrase de la première ligne), 
transforme les majuscules de ces mots en minuscules, supprime les chiffres 
appartenant aux mots, supprime les mots vides et 
affiche la liste des mots ainsi transformés dans l'ordre lexical.

#------------------------------------------------------

#compter le nombre de lignes d'un fichier

#!/usr/bin/perl
print "Content-type:text/html\n\n"; 

open (F, "<mon_fichier.txt");
$i=0;            #initialisation du compteur
while (<F>)      #pour chaque ligne lue
{
$i++;            #incrémentation du compteur
}
close(F);
print "nombre de lignes: $i";

#----------------------------------------------------------

#Changer les Guillemets en double-Guillemets 	

Cette opération peut s'avérer indispensable dans le cas d'utilisation 
d'une base de donnée, entre autre. 
Il s'agit en fait de remplacer le '"' par '""'  :

$maVariable =~ s/"/$& x 2/eg;

#Enlever les espaces superflux en fin de ligne 	

Cette commande permet de supprimer tous les espaces se trouvant 
en fin de chaine de caractère :

$maVariable =~ s/\s+$//;

#------------------------------------------------------------

#format

La dernière ligne contenant le point ne doit pas être oubliée, 
c'est elle qui indique la fin de spécification du format. 
Lorsque l'on veut afficher un résultat en utilisant un format, 
il faut au préalable affecter le nom du format à la variable système $~, 
puis appeler la fonction write :

#!/bin/perl 
$a = 2; 
$b = 3; 
$~ = "form"; 
write; 
format form = 
======== 
Nous avons mangé @ bananes et @ pommes. 
$a, $b 
======== 
. 

#permet d'afficher : 

======== 
Nous avons mangé 2 bananes et 3 pommes. 
========

#---------------------------------------------------------

#index

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open(F, "<mon_fichier.txt");
while ($ligne = <F>)
{
#donne la position de la 1ère occurrence de la lettre 'm' :
#retourne '-1' si la lettre n'est pas trouvée
$x = index ($ligne,"m");
print "Valeur de x : $x\n";
}

#--------------------------------------------------------

#La variable $_

Elle a un sens chargé: 
  -la dernière ligne lue 
  -ce que l'on imprime par défaut 
  -le paramètre implicite de split, de chop, etc. 

#------------------------------------------------------

#substr_1

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open(F, "<data.txt");
while ($ligne = <F>)
{
# print les 3 premiers caractères de chaque ligne:
$ligne = substr($ligne, 0, 3); 
print "$ligne\n";
}

#-----------------------------------------------------

substr_2

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open(F, "<pgredirect.txt");
while ($ligne = <F>)
{
  $pattern1 = "http";  
    if ($ligne =~ /$pattern1/) 
  { 
       
#supprimer les blancs en début de ligne:
$ligne =~ s/\s*/ /;

#chercher la position d'un signe:
$x1 = index ($ligne,")");

#garder du début à la position trouvée, éliminer le reste:
$x2 = substr($ligne, 0, $x1);

#remplacer un signe par un blanc:
substr($x2, -2, 1) = " ";
print "$x2\n";

  }
}

#------------------------------------------------------

$a = $b;        # Assigne $b à $a
$a += $b;       # ajoute $b à $a, met le résultat dans $a
$a -= $b;       # soustrait $b de $a, met le résultat dans $a
$a .= $b;       # ajoute la chaine $b à la fin de $a

#----------------------------------------------------------

#INCREMENTER UN COMPTEUR

#!/usr/bin/perl
print "Content-type:text/html\n\n";

# Ce programme doit incrémenter un compteur

# initialisation des variables
$file = 'compteur.txt';               # Le nom du fichier compteur
$cpt  = '0';                      # le compteur lui-même

if (open (FH, $file))             # Lecture du fichier compteur
{
  $cpt = <FH>; 
  close FH;
}

$cpt += 1;                        # augmente le compteur de 1

open (FH, ">$file");              # Ecriture du fichier compteur
  print FH "$cpt";
close FH;
      
print "Valeur du compteur: $cpt"; # affiche le compteur

#----------------------------------------------------------

#SPLIT (très bonne syntaxe)

#!/usr/bin/perl 
print "Content-type:text.html\n\n";

open(FILE, "<pgredirect.txt") or die"open: $!";
my($line,@words,$word,%total); 
while( defined( $line = <FILE> ) )
{
   @words = split( /\W+/, $line );
   foreach $word (@words)
   {
      $mot =~ tr/A-Z/a-z/;
      $total{$word}++;
   }
}
close(FILE);
foreach $word (sort keys %total)
{
   print "$word a été rencontré $total{$word} fois.\n";
}

#--------------------------------------------------------

#SPLIT AVEC UNE BOUCLE POUR LINUX (simplifié)

#!/usr/bin/perl 
#POUR LINUX : ligne suivante désactivée:
#print "Content-type:text.html\n\n";

@mot = ("");

open(SORTIE, ">out.txt");
open(DATA, "<in.txt") || die "fichier non trouvé\n";
while (<DATA>)
{

#choisir le délimiteur: ici c'est l'espace entre les mots:
@mot = split(/ /,$_);
$i = 0;
for(@mot)
   {
  # print $mot[$i];
   $i++;
   }

#imprimer à l'écran le 'i' qui convient:
print "$mot[2]"." "."$mot[3]\n";
#print "$mot[0]\n";
#print "$mot[1]\n";
#print "$mot[2]\n";
#print "$mot[3]\n";
#print "$mot[4]\n";

#ecrire dans le fichier out.txt:
print SORTIE "$mot[2]"." "."$mot[3]\n";
close(DATA);
close(SORTIE);

}

#--------------------------------------------------------

#SPLIT AVEC DEUX BOUCLES POUR WINDOWS (pour lire toutes les lignes)

#!/usr/bin/perl 
print "Content-type:text.html\n\n";

@data = ("");
@mot = ("");

$i = 0;
open(DATA, "<in.txt") || die "fichier non trouvé\n";
while(<DATA>)
{
    
#mettre dans le tableau 'data'la variable par défaut $_:
$data[$i] = $_;     
    $i++;
    #print $_;
}
close(DATA);

open(DATADAT, ">out.txt");

for(@data)
{

#séparer chaque mot avec 'split':
@mot = split(/ /,$_);
$i = 0;
for(@mot)
   {
    # print DATADAT "$mot[$i]\n";
     $i++;
   }

print "$mot[2]"." "."$mot[3]\n";
#print "$mot[0]\n";
#print "$mot[1]\n";
#print "$mot[2]\n";
#print "$mot[3]\n";
#print "$mot[4]\n";
#print "$mot[5]\n";

}
close(DATADAT);

#-------------------------------------------------------

#!/bin/perl
open (F, '< monfichier') || die "Problème d'ouverture : $!" ;
my $i=0;
while (my $ligne = <F>) 
{
$i++;
}
close F;
print "Nombre de lignes : $i";

--------------------------------------------------------

2. Chaînes de caractères
. concaténation
$c = 'ce' . 'rise'; (=> $c devient 'cerise')
$c .= 's'; (=> $c devient 'cerises')
x réplique
$b = 'a' x 5; => 'aaaaa'
$b = 'jacqu' . 'adi' x 3; => 'jacquadiadiadi'
$b = 'assez ! '; $b x= 5; => 'assez ! assez ! assez ! assez ! assez ! assez !'
3. Parenthèses
Comme dans tous les langages de programmation, les parenthèses peuvent être utilisées dans les
expressions :
$x = 2 * (56 - 78);

------------------------------------------------------------

if (($fruit eq 'cerise')or($fruit eq 'fraise'))
{
print 'rouge';
} elsif ($fruit eq 'banane') {
print 'jaune';
} elsif ($fruit eq 'kiwi') {
print 'vert';
} else {
print 'je ne sais pas...';
}

--------------------------------------------------------------

# Recherche du premier fruit <= 10 F
my $i = 0; my $f;
do {
$f = $fruits[$i];
$i++;
} while ($prix{$f} > 10);
print "Je prend : $f";

---------------------------------------------------------

my $i = 10;
do 
{
print $i;
$i--;
} 
until ($i == 0);

---------------------------------------------------------

les instructions suivantes sont équivalentes 

while ($_ = <STDIN>) { print; } 
while (<STDIN>) { print; } 
for (;<STDIN>;) { print; } 
print while $_ = <STDIN>; 
print while <STDIN>;

--------------------------------------------------------

 perl -ane 'print pop(@F), "\n";'

est équivalent à:

    while (<>) {
        @F = split(' ');
        print pop(@F), "\n";
    }

---------------------------------------------------

 pour limiter les lignes à 80 colonnes : 
    perl -lpe 'substr($_, 80) = ""'

-------------------------------------------------------

Hello word :

perl -e 'print "Hello, world\n";'

Remplacer la chaine toto par titi dans un fichier :

perl -i -pe 's/\btoto/\titi/g' <file>

Remplacer la chaine DEPTH par DEPH dans les fichiers du repertoire courant et faire une copie de sauvegarde :

perl -i.bak -pe 's/\bDEPTH/\DEPH/g' *

----------------------------------------------------------

substitution de mots contenus dans une liste

   cat motsvides.txt :
liste
je
vous
plein
texte

   cat substitution.pl :

#!/usr/bin/perl

open F_MOTS, "motsvides.txt" or die "E/S : $!\n";

my @listemotsvides;

push @listemotsvides,$_ while (<F_MOTS>);
map { chomp } @listemotsvides;

my $corps =
q{bonjour à tous,
   je suis en plein projet pour l'école et je programme en perl
   j'ai un soucis au niveau d'une substitution
   je vous explique
   je récupère un texte dans une variable $corps
   j'ai une liste de mots dans @listemotsvides
   et je dois supprimer les mots de la liste dans le texte
   j'ai donc fait ca};

print "AVANT\n-----\n$corps";
$corps =~ s/$_//g for @listemotsvides;
print "\n\n-----APRES-----\nLes mots supprimés sont : @{[ sort @listemotsvides ]}\n";
print "-" x 15 . "\n$corps\n";
__END__

Le résultat :

    perl substitution.pl :

AVANT
-----
bonjour à tous,
   je suis en plein projet pour l'école et je programme en perl
   j'ai un soucis au niveau d'une substitution
   je vous explique
   je récupère un texte dans une variable $corps
   j'ai une liste de mots dans @listemotsvides
   et je dois supprimer les mots de la liste dans le texte
   j'ai donc fait ca

-----APRES-----
Les mots supprimés sont : je liste plein texte vous
---------------
bonjour à tous,
    suis en  prot pour l'école et  programme en perl
   j'ai un soucis au niveau d'une substitution
     explique
    récupère un  dans une variable $corps
   j'ai une  de mots dans @motsvides
   et  dois supprimer les mots de la  dans le
   j'ai donc fait ca

------------------------------------------------------------

#!/usr/bin/perl

my $corps = q{bonjour à tous,
   je suis en plein projet pour l'école et je programme en perl
   j'ai un soucis au niveau d'une substitution
   je vous explique
   je récupère un texte dans une variable $corps
   j'ai une liste de mots dans @listemotsvides
   et je dois supprimer les mots de la liste dans le texte
   j'ai donc fait ca};



sub vide{
  my $res=shift;
  open F_MOTS, "motsvides.txt" or die "E/S : $!\n";

  my @listemotsvides;

  push @listemotsvides,$_ while(<F_MOTS>);
  map { chomp } @listemotsvides;
  $res =~ s/\b$_\b//g for @listemotsvides;
  print "$res\n";
  close (F_MOTS);
}

vide($corps);
__END__

-----------------------------------------------------------

 @lettres = qw( a z e r t y );
    @out = sort @lettres;
    # @out vaut maintenant (a,e,r,t,y,z)

---------------------------------------------------

Cet exemple enlève les lignes de code 
commençant par un commentaire :

@liste2 = grep !/^#/, @liste1;

------------------------------------------------

map  (=un foreach simplifié)

Exemple : séparer une liste de lignes en une liste de mots:

open(FILE, "<entree.txt");
@lignes = (<FILE>);
@mots = map { split ' ' } @lignes;

#en supposant que le nombre de mots soit inferieur a 30:
for($i=0; $i<30; $i++)
{
print "$mots[$i]\n";
}

---------------------------------------------------

sub numerique { $a <=> $b }; }
@tri_par_numero = sort numerique 53,29,11,32,7;
#ou : reverse sort
print "@tri_par_numero\n";

-----------------------------------------------

#supprimer des lignes et réecrire le nouveau texte
#dans un nouveau fichier

#!/usr/bin/perl 

open(FILE, "<entree.txt" ) or die ("error" );
@save = <FILE>;
close(FILE);
foreach (@save)
{
    #supprimer lignes contenant 'toto' et 'titi':
    $_ = "" if ($_ =~ m/toto/);
    $_ = "" if ($_ =~ m/titi/);
chomp $_;
}
open(FILE, ">out.txt" ) or die ("error" );
foreach (@save)
{
    print FILE $_."\n" if ($_);
}
close(FILE);

-------------------------------------------------

#afficher le nombre de directories et files:

#!/usr/bin/perl

$nbrep = 0;
$nbfic = 0;
$dossier = "/chemin_de_mon_sous_directory";
opendir DIR, $dossier or die "$dossier n'existe pas !";
@files = readdir DIR;
foreach $fichier (@files) 
{
if (-f $fichier) 
          { $nbfic++; }
elsif (-d $fichier) 
          { $nbrep++; }
}
close DIR;
print "Il y a $nbfic fichier(s) et $nbrep répertoire(s) dans $dossier.\n";

-------------------------------------------------------

#compte le nombre de lignes d'un fichier:

#!/usr/bin/perl

sub nbLignes;
print nbLignes "entree.txt";

sub nbLignes 
{
 my ($file)=@_;
 my ($res)=0;

 open(FIC,"$file") or die("can't open $file : $!");
 while (<FIC>) 
    { 
      $res++; 
    }
 close(FIC);
 $res;
}

--------------------------------------------------------

#copier fichier en passant par un buffer:

#!/usr/bin/perl

open(SOURCE, "<fichier.txt") || die "Error: $!\n";
open(DEST, ">fichier-copie.txt") || die "Error: $!\n";
while ($len = sysread(SOURCE, $buffer, 512))
{
  syswrite(DEST, $buffer, $len);
}
close(DEST);
close(SOURCE);

---------------------------------------------------------

#copier fichier en utilisant le module File::Copy

#!/usr/bin/perl

use File::Copy;
copy("file.in", "file.out" );

--------------------------------------------------------

#copier avec interrogation si non executée

use File::Copy;
#copy("file.in", "C:/Users/jean/dir2/file.out");

if (! copy("file.in", "C:/Users/jean/dir2/file.out" )) 
{
    print LOG "erreur de copie de toto en titi : $!\n";
    print "erreur, recopie ne marche pas\n";
    do {
        print "abandon traitement ? (o/n) ";
        chomp($_ = <STDIN> );
        if ($_ =~ /[Oo]/) 
           {
            die();
           } 
             elsif ($_ !~ /[Nn]/) 
               {
                $_ = "";
               } 
         else 
          { 
        # rien ici, on continue le truc + loin 
          }
      } while(! $_);
}

---------------------------------------------------------

#rename : renommer un fichier

#!/usr/bin/perl

$old = "entree.txt";
$new = "entree-new.txt";

rename($old, $new);

---------------------------------------------------------

#shift

  @array = qw# dino fred barney #;
    $m = shift(@array);      # $m gets "dino", @array now has ("fred", "barney")
    $n = shift @array;       # $n gets "fred", @array now has ("barney")
    shift @array;            # @array is now empty
    $o = shift @array;       # $o gets undef, @array is still empty
    unshift(@array, 5);      # @array now has the one-element list (5)
    unshift @array, 4;       # @array now has (4, 5)
    @others = 1..3;
    unshift @array, @others; # @array now has (1, 2, 3, 4, 5)

---------------------------------------------------------

L'opérateur chomp :

L'opérateur chop() supprime le dernier caractère d'une chaîne de 
caractères, quel que soit ce caractère. 
Ceci peut présenter un certain danger.
On dispose d'une variable. Nous ignorons si la chaîne de caractère 
qu'elle contient a été lue ou générée d'une manière quelconque. 
Nous ne désirons en retirer le dernier caractère 
que si ce caractère est un \n.
C'est cette fonction qui est assurée par l'opération chomp(). 

exemple:

#!/usr/bin/perl

open(DATA, "<entree.txt");
 
# on place le contenu dans un tableau de lignes
@lignes = <DATA>;
 print @lignes;

close(DATA);
 
# on modifie la 3e ligne (retrait de "\n" s'il existe)
chomp( $lignes[2] );
$lignes[2] .= ", et Bob était là.\n";
#ce rajout se cumulera à chaque execution du script.
 
# on rouvre le fichier en écriture en écrasant le contenu

open(DATA, ">entree.txt");
# et on réécrit le contenu modifié
print DATA @lignes;
 
close(DATA);

#---------------------------------------------------------

Les contrôleurs de format les plus utiles sont :

Contrôleur de format                   Application Exemple
  ---------------                         ------------
         d                     nombre entier printf "%10d", 50;
         e                     notation scientifique printf "%e", 5003;
         f                     décimales fixes printf "%8.2", 32.987;
         s                     chaîne de caractères printf "%10s", "Allo";

#----------------------------------------------------

#imprimer 2 listes cote à cote:

my @noms = qw( Marie Pierre Jean );
my @salaires = ( 23500.00, 30000.00, 18900.00 );
my $i;
for( $i = 0; $i < @noms; $i++ )
{
printf "%6s%10.2f\n", $noms[ $i ], $salaires[ $i ];
}

#La sortie à l’écran sera la suivante :
Marie 23500.00
Pierre 30000.00
Jean 18900.00

#----------------------------------------------------

#sort

#!/usr/bin/perl
print "TRIS\n";
@liste = (4, 11, 24, 2, 43, 21, 16, 6);
print "Liste initiale : \n@liste\n";
@tri_alpha = sort @liste;
print "Liste triée alphabétiquement : \n@tri_alpha\n";
@tri_num = sort { $a <=> $b} @liste;
print "Liste triée numériquement (sens croissant) : \n@tri_num\n";
@tri_num = sort { $b <=> $a} @liste;
print "Liste triée numériquement (sens décroissant) : \n@tri_num\n";
@envers = reverse @liste;
print "Liste  inversée : \n@envers\n\n";

----------------------------------------------------

#join

$phrase = "Bonjour à toutes et à tous";
@mots = split " ",$phrase;
print "@mots\n";
$phrase1 = join " ", @mots;
print "$phrase1\n";

---------------------------------------------------
#index - substr

#!/usr/bin/perl

$Url = "http://www.selfhtml.com.fr/selfhtml/tgck.htm";

$Stop = index($Url,":");
$protocole = substr($Url,0,$Stop);
$Start = index($Url,"//") + 2;
$domaine = substr($Url,$Start);
$Stop = index($domaine,"/");
$domaine = substr($domaine,0,$Stop);
$Start = rindex($Url,"/") + 1;
$nomfichier = substr($Url,$Start);
$longURL = length($Url);

print "Le protocole Internet utilisé par l'adresse URL est: ", $protocole, "\n";
print "L'adresse domaine de l'adresse URL est: ", $domaine, "\n";
print "Le nom de fichier de lö'adresse URL est: ", $nomfichier, "\n";
print "Le nombre de caractères de l'adresse URL est : ", $longURL, " lettres\n";

--------------------------------------------------

#split

Transformer des chaînes de caractères en listes:

Si vous avez des chaînes de caractères contenant certains signes revenant régulièrement, 
vous pouvez traiter ces signes comme caractères de séparation, et reporter 
la chaîne de caractères dans une  liste.
Exemple:

$ligne_CSV = "Ludivine Créancier,13 rue de l'horloge,13860 Peyrolles,04 42578962";
@Adresse = split(/,/,$ligne_CSV,4);
$i = 0;
for(@Adresse)
 {
  print $i+1, "ème champ de l'adresse: ", $Adresse[$i], "\n";
  $i++;
 }
-------------------------------------------------------------

Caractère  Description                          Inverse

\d         chiffres (0-9)                       \D 
\w         caractères (0-9,a-z,A-Z,_)           \W 
\s         espaces ou assimilés ( ,\r,\t,\n)    \S 
\b         La frontière des mots, hors []       \B
\n         Une nouvelle ligne
\t         Une tabulation
.          tout caractère sauf une nouvelle ligne
+          matches one or more when combined with above    
^          Le début d'une ligne ou d'une chaine
$          La fin d'une ligne ou d'une chaine
*          Zero ou plusieurs fois le dernier caractère
+          Une ou plusieurs fois le dernier caractère
?          Zero ou une fois le dernier caractère

Exemple: 

/[abcd]/ # tout ce qui coïncide avec a ou b ou c ou d
/[^abc]/ # tout ce qui est différent de a ou b ou c
/[a-z]/  # les caractères minuscules
/[^a-z]/ # tout ce qui n'est pas une minuscule
/[a-z]+/ # une chaine de caractères non nulle en minuscule     
    
Exemples d'expressions régulières: 

/a.b/    # a suivi d'un caractère suivi de b
         # coïncide avec axb, mais pas avec ab ou axyzb
/.*/     # tout sauf une nouvelle ligne
/^abc/   # abc au début d'une ligne
/abc$/   # abc à la fin d'une ligne
/abx*/   # ab suivi de zero ou plusieurs caractères x
         # coïncide avec ab abx abxx abxxxxx
/^$/     # une ligne vide
/\/\s*0/ # / suivi de zero ou plusieurs espaces suivi de 0
         # représente une division par 0
    

Une barre verticale | représente un "ou"

-----------------------------------------------------------

i	Do case-insensitive pattern matching.
m	Treat string as multiple lines (^ and $ match internal \n).
s	Treat string as single line (^ and $ ignore \n, but . matches \n).
x	Extend your pattern's legibility with whitespace and comments.

 Assertion	Meaning
^	Matches at the beginning of the string (or line, if /m used)
$	Matches at the end of the string (or line, if /m used)
\b	Matches at word boundary (between \w and \W)
\B	Matches except at word boundary
\A	Matches at the beginning of the string
\Z	Matches at the end of the string
\G	Matches where previous m//g left off
(?=...)	Matches if engine would match ... next
(?!...)	Matches if engine wouldn't match ... next

 Maximal	Minimal	Allowed Range
{n,m}	{n,m}?	Must occur at least n times but no more than m times
{n,}	{n,}?	Must occur at least n times
{n}	{n}?	Must match exactly n times
*	*?	0 or more times (same as {0,})
+	+?	1 or more times (same as {1,})
?	??	0 or 1 time (same as {0,1})

 Code	Matches
\a	Alarm (beep)
\n	Newline
\r	Carriage return
\t	Tab
\f	Formfeed
\e	Escape
\d	A digit, same as [0-9]
\D	A nondigit
\w	A word character (alphanumeric), same as [a-zA-Z_0-9]
\W	A nonword character
\s	A whitespace character, same as [ \t\n\r\f]
\S	A non-whitespace character

 Modifier	Meaning
g	Match globally, that is, find all occurrences.
i	Do case-insensitive pattern matching.
m	Treat string as multiple lines. (continued)
o	Only compile pattern once.
s	Treat string as single line.
x	Use extended regular expressions.

 Modifier	Meaning
e	Evaluate the right side as an expression.
g	Replace globally, that is, all occurrences.
i	Do case-insensitive pattern matching.
m	Treat string as multiple lines.
o	Only compile pattern once.
s	Treat string as single line.
x	Use extended regular expressions.

 Modifier	Meaning
c	Complement the SEARCHLIST.
d	Delete found but unreplaced characters.
s	Squash duplicate replaced characters.

------------------------------------------------------

{n}   Reconnait n fois exactement le caractère qui précède. 
{n,}   Reconnait au moins n fois le caractère qui précède. 
{n,m}   Reconnait au moins n fois le caractère qui précède, mais pas plus de m fois. 
#!usr/bin/perl -w
$p1="brrrrr! il fait un froid de canard";$p0=$p1;
$p1=~s/r{2}//;
print "avant:$p0\napres:$p1\n";

résultat:
avant:brrrrr! il fait un froid de canard
apres:brrr! il fait un froid de canard

Et avec l'option g (globale) on obtient : 
$p1=~s/r{2}//g;

résultat:
avant:brrrrr! il fait un froid de canard
apres:br! il fait un froid de canard

------------------------------------------------------

#grep

#!/usr/bin/perl

open(OUT, ">entree-out1.txt");
open(FILE, "< entree.txt") || die "Can't open myfile\n"; 
     @lines = <FILE>; 	
     close(FILE); 	
    
$pattern = toto;
 @found = grep(/$pattern/, @lines);
print @found;
print OUT @found;
close(OUT);

-------------------------------------------------------

next unless

#travailler séquentiellement : 

open(FILE, "< entree.txt") || die "Can't openmyfile\n"; 
  
$pattern = titi;   
while (<FILE>) 
     { 	 
          next unless (/$pattern/); 	 
          print;
     } 	
     close(FILE);

#Si vous avez besoin de la liste des lignes contenant le motif, 
#il vous suffit de les mémoriser par push dans le traitement de la boucle. 
#Vous n'aurez pas à garder en mémoire l'intégralité du fichier.

------------------------------------------------------------

tableau d'éléments associés:

 %mots=("ALA","alanine","GLU","glutamine","TYR","tyrosine",
"CYS","cysteine","LEU","leucine","VAL","valine");
ou

 $mots{"ALA"}="alanine";...; $mots{"CYS","cysteine"}; etc...
ou

%mots = (
ALA => alanine,
GLU => glutamine
....
); 

Supprimer un élément: 
delete $mot{'ALA'};

Liste des valeurs, des indices : 
values(%mots); keys(%mots);

Taille du tableau :
print scalar keys(%mots);

exemple:

#!/usr/bin/perl
print "Cherche : "; $name=<STDIN>; chomp($name);
%mots=("ALA","alanine","GLU","glutamine","TYR","tyrosine",
"CYS","cysteine","LEU","leucine","VAL","valine");
print "$mots{$name}\n";
print "taille du tableau : ",scalar keys(%mots),"\n";
print "$mots[3]\n";               # ne marche pas !
print "|$mots{alanine}|\n";       # idem

résultat:
Cherche : VAL
valine
taille du tableau : 6
[3]
||

--------------------------------------------------------

la variable @ARGV:

lorsque vous tapez la commande suivante:
bali>  cmd.pl exe23d.pdb 45 1 out.pdb

alors PERL initialise la variable @ARGV avec les valeurs: 
exe23d.pdb  45  1   out.pdb

 on aura donc:
$ARGV[0] contient exe23d.pdb
$ARGV[1] contient 45
$ARGV[2] contient 1
$ARGV[3] contient out.pdb
La variable $#ARGV contient l'indice du dernier élément du tableau @ARGV, 
c'est à dire 3 dans l'exemple ci-dessus. 
S'il n'y a pas d'arguments passés, $#ARGV = -1.

exemple:
#!/usr/bin/perl
if ($#ARGV == -1) {
   print "Nom de fichier PDB : "; $fname=<STDIN>; chomp($fname);
  }
else {
   $fname=$ARGV[0];
   }
print "$fname\n";

------------------------------------------------------

lire un fichier ligne par ligne:

#!/usr/bin/perl
@lignes = ("");
open(MAILDAT, "<inbox.dat") || die "fichier avec E-Mails non trouvé\n";
while(<MAILDAT>)
 {
  push(@lignes,$_);
 }
close(MAILDAT);
for(@lignes)
 {
  if(/HTML/)
   {
    print $_;
   }
  }

------------------------------------------------------------

lire un fichier signe par signe:

#!/usr/bin/perl
@voyelle = ("a","e","i","o","u");
@nombre = (0,0,0,0,0);
open(FICHIER, "<$ARGV[0]") || die "$_[1] non touvé\n";
while(($signeactuel = getc(FICHIER)) ne "")
 {
  for($i=0;$i<=4;++$i)
   {
    if($signeactuel eq $voyelle[$i])
     {
      $nombre[$i]++;
     }
   }
 }
close(FICHIER);
for($i=0;$i<=4;++$i)
 {
  print "$voyelle[$i] apparaît dans  $ARGV[0] isg. $nombre[$i] fois\n";
 }

-----------------------------------------------------------

grep

#!/usr/bin/perl

open(OUT, ">entree-out1.txt");
open(FILE, "< entree.txt") || die "Can't open myfile\n"; 
     @lines = <FILE>; 	
     close(FILE); 	
    
$pattern = toto;
@found = grep(/$pattern/, @lines);
print @found;
print OUT @found;
close(OUT);

-------------------------------------------------------

unless

open(FILE, "< entree.txt") || die "Can't openmyfile\n"; 
  
$pattern = titi;   
while (<FILE>) 
     { 	 
          next unless (/$pattern/); 	 
          print;
     } 	
     close(FILE);

------------------------------------------------------

unshift(@tab, $var) : insère le contenu de $var au début du 
tableau @tab en décalant tous les éléments présents dans le tableau.

$var = shift(@tab) : retourne et supprime le premier élément du tableau.

push(@tab, $var) : insère le contenu de $var à la fin du tableau @tab.

$var = pop(@tab) : retourne et supprime le dernier élément du tableau.

@tab2 = reverse(@tab) : retourne un tableau en inversant l'ordre des éléments de @tab.

------------------------------------------------------------

#!/usr/bin/perl

@tablo = ("Barney", "Homer", "Marge", "Bart", "Lisa", "Maggie", "Moe", "Flanders");

print "Quel nom voulez-vous repérer ?\n";
$nom = <stdin>;
chomp $nom;
for ($i=0; $i<@tablo; $i++){
	if($tablo[$i] =~ /$nom/){
		print "$nom est en position $i\n";
	}
}

----------------------------------------------------------
# position - index

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open(DATA2, ">data2.txt");
open(DATA, "<data.txt");
while ($line = <DATA>)
{
#print $line;
$position = index($line, ","); 
print "$position\n";
print DATA2 "$position\n";
}
close(DATA);

$var1 = `
paste data2.txt data.txt>data3.txt`;
print $var1;

#Resultat:
#--------

#    6	     champ1,champ2,champ3
#    1	     1,2,3*
#    1	     4,5,6*
#    1	     7,8,9*
#    4	     titi,tata*
#    -1	     toto*
#    4	     tutu,bebe,maison*

----------------------------------------------------------------
# capture de 1ère et dernière ligne d'un pattern en colonne 2 :

#!/usr/bin/perl
print "Content-type:text.html\n\n";

use Shell qw(cat awk sed grep ls seq);
#selectionner la colonne à shifter (ecrit dans z1)
$var1 = `
awk '{print \$2}' fichier_de_base.txt>z1.txt`;
print $var1;

#écrire colonne shiftée dans z2.txt:
open(DATA, "<z1.txt");
open(DATA2, ">z2.txt");
@hu = <DATA>;
shift @hu;
print DATA2 @hu;

#coller colonne shiftée au fichier(->z3.txt):
#soustraction de colonne shiftée et non shiftée (->z4.txt):
$var2 = `
paste fichier_de_base.txt z2.txt>z3.txt;
awk '{print \$0,\$3-\$2}' z3.txt>z4.txt`;
print $var2;


#coller pattern '??' si différence non égale à 1 (->z5.txt):
#capture du pattern '??' + une ligne après (->z6.txt):
#résultat final dans z7.txt:
$var3 = `
awk '{if (\$4 != 1) print \$0"  ??" ; else print \$0}' z4.txt>z5.txt;
grep -A1 "??" z5.txt>z6.txt;
awk '{print \$1,\$2}' z6.txt>z7.txt`;
print $var3;

------------------------------------------------------------------------
# capture de 1ère et dernière ligne d'un pattern en colonne 1 :

#fichier_de_base.txt :
001 40
001 41
001 42
001 43
002 05
002 06
002 07
002 08
003 50
003 51
003 52
003 53
004 07
004 08
004 09
004 10

#!/usr/bin/perl
print "Content-type:text.html\n\n";

use Shell qw(cat awk sed grep ls seq);
#selectionner la colonne à shifter (ecrit dans z1.txt)
$var1 = `
awk '{print \$1}' fichier_de_base.txt>z1.txt`;
print $var1;

#écrire colonne shiftée dans z2.txt:
open(DATA, "<z1.txt");
open(DATA2, ">z2.txt");
@hu = <DATA>;
shift @hu;
print DATA2 @hu;

#coller colonne shiftée au fichier(->z3.txt):
#soustraction de colonne shiftée et non shiftée (->z4.txt):
$var2 = `
paste fichier_de_base.txt z2.txt>z3.txt;
awk '{print \$0,\$3-\$1}' z3.txt>z4.txt;
awk '{if (\$4 != 0) print \$0"??" ; else print \$0}' z4.txt>z5.txt;
grep -A1 "??" z5.txt>z6.txt;
awk '{print \$1,\$2}' z6.txt>z7.txt`;
print $var2;

#résultat dans z7.txt :
001 43
002 05
-- 
002 08
003 50
-- 
003 53
004 07
-- 
004 10

--------------------------------------------------------------------------
#require  :  commande l'exécution d'un script externe à sa suite:
#l'execution de z2.pl sera lancée dans le script z1.pl avec la commande:

require "z2.pl";

------------------------------------------------------------

#ls  (en perl, en sous programme)

sub ls
{
   while(<*>)
      {
        print("$_\n");
      }
}

&ls

------------------------------------------------------

Recherche d'une occurence dans un fichier:

#!/usr/bin/perl
print("Quel mot voulez-vous rechercher :");
$cherche = <STDIN>;
chop($cherche);
$ligne="0";
$sum="0";
$cond="0";
while(<>){
$cond=$sum;
$ligne +=1;
$sum += (s/\b$cherche\b/$cherche/g);
if($cond != $sum){
print("Ligne $ligne ==> ");
print("$sum\n");
};
};
print("----------------------------------------------------\n");
print("Votre fichier contient $sum fois le mot \'$cherche\'\n");

-----------------------------------------------------

# 4 facons d'utiliser une boucle...

# Facon 1.
__________
# "@chiffres" est un tableau.

@chiffres=(1..9);

while (@chiffres) {
    $i=shift @chiffres;
    print "$i\n";
}

# Facon 2.
_________
$somme=0;
$i=0;

while (1) { # toujours verifie.
    $i++;
    if ($i==5) {next}; # saute a l'iteration suivante.
    if ($i>10) {last}; # fin de boucle.
    $somme+=$i;
}
print "somme 1 -> 10 sans 5 : $somme\n";

# Facon 3.
_________
for ($i=0, $somme=0; $i<=20; $i++) {
    $somme+=$i;
}
print "somme 1 -> 20 : $somme\n";

# Facon 4.
_________
$somme=0;
$i=0;

foreach $i(1..30) {$somme+=$i;}
print "somme 1 -> 30 : $somme\n";

$somme=0;
$i=0;

foreach $i(1,30, 120) {$somme+=$i;}
print "somme 1+30+120 : $somme\n\n";

-------------------------------------------------------

#appels systeme
#Si le nom du fichier dans "open" est suivi de "|", ce nom est
# considéré comme une commande qui sera executee.

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open (pl, "ls -al |");
while (<pl>) 
{
  print $_;
}

-------------------------------------------------------

#Comment supprimer les doublons d'une liste ou d'un tableau ?
#voici 5 façons d'y arriver:

#fichier de départ : test.txt:
toto r
titi
tata m
1
5
toto r
1
titi

#le script:

#!/usr/bin/perl
print "Content-type:text.html\n\n";

open(DATA, "<test.txt");
@tableau = <DATA>;

#1ère façon:
my %hachage = map { $_, 1 } @tableau;
my @unique = keys %hachage;
print @unique;
print "\n";

#2ème façon:
# ou via une tranche de hachage :
@hachage{ @tableau } = ();
my @unique = keys %hachage;
print @unique;
print "\n";

#3ème façon:
# ou via un foreach : 
$hachage{$_} = 1 foreach ( @tableau );
my @unique = keys %hachage;
print @unique;

#4ème façon:
my @unique = ();
my %dejavu = ();
foreach my $elem ( @tableau )
    {
      next if $dejavu{ $elem }++;
      push @unique, $elem;
    }
print @unique;

#5ème façon:
my %dejavu = ();
my @unique = grep { ! $dejavu{ $_ }++ } @tableau;
print @unique;

close(DATA);

#résultat:
toto r
titi
tata m
1
5

-----------------------------------------------------------

#split

open(DATA, "<fichier.txt"); 
while (<DATA>) 
{
       foreach $word ( split ) 
{ 
   # faire quelque chose avec $word ici
      print "$word\n"; 
} 
}

------------------------------------------------------

#afficher numero de la ligne:

my $i=0;

open(DATA, "<fichier.txt"); 
while (<DATA>) 
{
$i++;
 print "$i : $_"; 

}

--------------------------------------------

Perl propose plusieurs abréviations pour des classes de caractères courantes :

\d est un chiffre et est équivalent à 
    [0-9]

\s est un blanc et est équivalent à 
    [\ \t\r\n\f]

\w est caractère mot (alphanumérique ou _) et est équivalent à 
    [0-9a-zA-Z_]

\D est la négation de \d; il représente tout autre caractère qu'un chiffre 
    [^0-9]

\S est la négation de \s 
    [^\s]

\W est la négation de \w 
    [^\w]

Le point '.' reconnaît n'importe quel caractère sauf ``\n''.

----------------------------------------------
1.	/a/	contient un 'a' 
2.	/[ab]/	contient un 'a' ou un 'b' 
3.	/[A-Z]/	contient une majuscule (sans accent ni cédille)
4.	/[0-9]/	contient un chiffre
5.	/\d/	contient un chiffre - exactement comme (4.)
6.	/\D/	contient un signe qui n'est pas un chiffre
7.	/[-\d]/	contient un chiffre ou le signe moins
8.	/[\[\]]/	contient un crochet

9.	/[a-zA-Z0-9_]/	contient un signe du type lettre (sans accent ni cédille), 
de type chiffre ou un tiret de soulignement

10.	/\w/	contient un signe des types lettre, chiffre ou tiret de soulignement - 
(presque) exactement comme (9.); que les signes avec accent peuvent être reconnus, 
dépend de la configuration du système

11.	/\W/	contient un signe qui n'est ni une lettre, ni un chiffre, ni un tiret de soulignement; 
que les signes avec accent peuvent être exclus, dépend de la configuration du système

12.	/\r/	contient un caractère de contrôle pour le retour du chariot
13.	/\n/	contient un caractère de contrôle pour l'avance d'une ligne
14.	/\t/	contient un caractère de contrôle pour le tabulateur
15.	/\f/	contient un caractère de contrôle pour le saut de page
16.	/\s/	contient un espace ou un caractère de contrôle des positions (12.-15.)
17.	/\S/	contient un signe qui n'est ni un espace, ni un caractère de contrôle des positions (12.-15.)
18.	/[^éèàùçÇêÉÈÀÙôÔâÂîÎ]/	contient un signe qui n'est pas un caractère français avec accent ou cédille 
(dans la codification de caractères correspondante) 

19.	/[^a-zA-Z]/	contient un signe qui n'est pas une lettre (sans accent)
-------------------------------------------------------
1.	/aus/	trouve 'aus' - même dans 'chaussée' ou 'Gauss'
2.	/aus?/	trouve 'aus' etc... - mais aussi 'au' et 'aut'
3.	/a./	trouve 'as' et 'an' (un quelconque autre signe derrière 'a', excepté \n)
4.	/a+/	trouve 'a' und 'aa' und 'aaaaa' (une ou un nombre quelconque de lettres 'a')
5.	/a*/	trouve 'a' und 'aa' und 'aaaaa' et 'b' (pas de ou un nombre quelconque de lettres 'a')
6.	/Ge.s/	trouve 'Gers' et 'Gens' mais pas 'Genes'
7.	/Ge.+s/	trouve 'Gers' et 'Gens' et 'Genes' (un signe quelconque ou un nombre 
quelconque de signes quelconques, excepté \n)

8.	/Ge.s/	trouve 'Gers' et 'Gens' mais pas 'Gene'
9.	/Ge.?s/	trouve 'Gers' et 'Gens' et 'Gene'
10.	/x{10,20}/	trouve entre 10 et 20 'x' à la suite
11.	/x{10,}/	trouve 10 'x' et plus à la suite
12.	/x.{2}y/	trouve 'xxxy' ou 'xaby' etc... (deux signes quelconques entre 'x' et 'y', excepté \n)
13.	/Jean\b/	trouve 'Jean' mais pas 'Jeannot' (limite du mot)
14.	/\bvers/	trouve 'verser' ou 'versatile' mais pas 'envers' (limite du mot)
15.	/\bvers\b/	trouve 'vers' mais pas 'envers' ni 'verser' (limite du mot)
16.	/\bvers\B/	trouve 'verser' mais ni 'vers' et ni 'envers' (limite du mot et limite du mot "négative")
17.	/^Jean/	trouve 'Jean' seulement au début du passage à parcourir
18.	/Jean$/	trouve 'Jean' seulement à la fin du passage à parcourir
19.	/^\s*$/	trouve les lignes ne comprenant que des espaces ou autres signes d'espacement ou qui sont vides
20.	/$Nom/	interprète le contenu de la scalaire $Nom comme expression régulière
--------------------------------------------------------------