Pense-bête langage PERL

 

a)    Sites : www.perl.com  le site de PERL

http://www.cpan.org    les archives complètes de Perl

http://www.perl.org   Perl Mongers (groupes d’utilisateurs de Perl)

http://www.mongueurs.net

www.use.perl.org 

www.perlmonks.org 

 

Les Mongueurs de Perl (groupes d’utilisateurs francophones)

b)    Documentation PERL : « perlinfo –f  fonction » ou « perlbook »

c)    Directive de diagnostic à mettre en début de programme (debugging) : « use warning ; » , à utiliser avec l’option « -w » de « perl ».

d)    exécuter : « perl prog.pl »  et mettre au début du programme PERL « # !/usr/bin/perl »

e)    print avec substitution de variables : print ‘’aaaaa’’ ; ou encore : print (‘’bbbbb’’) ; exemple : print ‘’car’’ . $nb * $snb ;

f)    print sans substitution de variables : print ‘aaaaa’;   exemple : print 42 ;

g)    variables : variables scalaires : $var1 = « car » ; $var2 = 123 ;

h)    variable par défaut : $_         print ; : affiche le contenu de la variable par défaut.

i)    Variables tableaux : @tab1 = (‘’val1’’,’’val2’’,’’val3’’) ;    @tab2 = (1,2,69) ;    @tab3=(‘’aa’’, 42, 1,25) ;

j)    Un élément de tableau : $tab1[1] ; print $tab1[0] ;

k)    Index (pointeur) du dernier élément d’un tableau : $#tab   print $tab[$#tab] ;

l)    Nombre d’éléments d’un tableau ? ? ? : $#array + 1

m)    Listes d’éléments d’un tableau : @tab[0,1] , ici tous les éléments du tableau :   @tab[0..$#tab] ;

n)    Tous les éléments du tableau sauf le 1er : @tab[1..$#tab] ;

o)    Opérations sur les tableaux : @tab_res1 = sort @tab ;   @tab_res2 = reverse @tab ;

p)    Variables et tableaux magiques :

1) arguments d’appel de votre script PERL en mode commande : @ARGV

2) arguments transmis à un sous programme : @_

3) arguments par défaut de certaines fonctions PERL : $_

q)    Tables de hashage : my %fruits_couleurs = (‘’pomme’’,’’rouge’’,’’banane’’,’’jaune’’) ; , résultat : $fuits_couleurs{‘’pomme’’) ; donne ‘’rouge’’

r)    my fruits = keys %fruits_couleurs ;

s)    my couleurs = values %fruits_couleurs ;

t)    tables de hashage spéciales : 1) table contenant les variables d’environnement du système : @ENV Références ( ?) : une référence (valeur scalaire) se reporte à n’importe quelle type de données. Exemples :

my $var = {      scalaire => {      description => "éléments isolé",

préfixe => $,

},

tableau =>      {      description =>"liste ordonnée d’éléments",

                          préfixe => @,

                  },

hash =>            {      description =>"paire clé + valeur",

                          préfixe => %,

                  },

} ;

print "Les scalaires commencent par $variables->{’scalaire’}->{’prefix’}\n";

u)    Exemple : $var -> {‘scalaire’} , {‘préfixe’}

v)    Types de création de variables : 1) en local (dans le bloc) : my $var = ‘’val’’ ;

w)    2) pour tout le programme : $var = ‘’val’’ ;   (note : pas de ‘’my’’ en préfixe de la déclaration).

x)    Tests :

if ( condition ) {

...

} elsif ( autre condition ) {

...

} else {

...

}

Il existe également une version négative du if :

unless ( condition ) {

...

}

y)    Boucle :

while ( condition ) {

...

}

until ( condition ) {

...

}

print "LA LA LA\n" while 1; # boucle infinie

for ($i=0; $i <= $max; $i++) {

...

}

foreach (@array) {

print "L’élément courant est $_\n";

}

foreach my $cle (keys %hash) {

print "La valeur de $cle est $hash{$cle}\n";

}

z)    Fonctions :

+ addition

- soustraction

* multiplication

/ division

== égalité

!= inégalité

< inférieur

> supérieur

<= inférieur ou égal

>= supérieur ou égal

eq égalité

ne inégalité

lt inférieur

gt supérieur

le inférieur ou égal

ge supérieur ou égal

&& and et

|| or ou

! not négation

= affectation

. concaténation de chaînes

x multiplication de chaînes

.. opérateur d’intervalle (crée une liste de nombres)

$a += 1; # comme $a = $a + 1

$a -= 1; # comme $a = $a - 1

$a .= "\n"; # comme $a = $a . "\n";

aa)Ouvertures de fichiers :

open(INFILE, "input.txt") or die "Impossible d’ouvrir input.txt en lecture : $!";

open(OUTFILE, ">output.txt") or die "Impossible d’ouvrir output.txt en écriture : $!";

open(LOGFILE, ">>my.log") or die "Impossible d’ouvrir logfile en ajout : $!";

my $ligne = <INFILE>; # lit une ligne du fichier

my @lignes = <INFILE>; # lit et range toutes les lignes dans la liste.

while (<INFILE>) { # chaque ligne est successivement affectée à $_

print "Je viens de lire la ligne : $_";

}

print STDERR "Dernier avertissement.\n";

print OUTFILE $record;

print LOGFILE $logmessage;

close INFILE;

bb)Expressions régulières (ou rationnelles) :

if (/foo/) { ... } # vrai si $_ contient "foo"

if ($a =~ /foo/) { ... } # vrai si $a contient "foo"

s/foo/bar/; # remplace foo par bar dans $_

$a =~ s/foo/bar/; # remplace foo par bar dans $a

$a =~ s/foo/bar/g; # remplace TOUTES LES INSTANCES de foo par bar dans $a

. un caractère unique (n’importe lequel)

\s un blanc (espace, tabulation, à la ligne)

\S un caractère non-blanc (le contraire du précédent)

\d un chiffre (0-9)

\D un non-chiffre

\w un caractère alphanumérique (a-z, A-Z, 0-9, _)

\W un non-alphanumérique

[aeiou] n’importe quel caractère de l’ensemble entre crochets

[^aeiou] n’importe quel caractère sauf ceux de l’ensemble entre crochets

(foo|bar|baz) n’importe laquelle des alternatives proposées

^ le début d’une chaîne de caractères

$ la fin d’une chaîne de caractères

* zéro ou plus

+ un ou plus

? zéro ou un

{3} exactement 3 fois l’élément précédent

{3,6} entre 3 et 6 fois l’élément précédent

{3,} 3 ou plus des éléments précédents

/^\d+/ une chaîne commençant par un chiffre ou plus

/^$/ une chaîne vide (le début et la fin sont adjacents)

/(\d\s){3}/ un groupe de trois chiffres, chacun suivi par un blanc (par exemple "3 4 5 ")

/(a.)+/ une chaîne dont toutes les lettres impaires sont des a (par exemple "abacadaf")

# La boucle suivante lit l’entrée standard

# et affiche toutes les lignes non vides :

while (<>) {

next if /^$/;

print;

}

cc)FONCTIONS RETOURNANT DES LISTES

Stat

localtime

caller

VARIABLES.SPÉCIALES

0 dev

0 seconde

0 package

$_    variable par défaut

1 ino

1 minute

1 nomfichier

$0    nom du programme

2 mode

2 heure

2 ligne

$/    séparateur d’entrée

3 nlink

3 jour

3 subroutine

$\    séparateur de sortie

4 uid

4 mois-1

4 avec args

$|    autoflush

5 gid

5 annee-1900

5 wantarray

$!    erreur appel sys/lib

6 rdev

6 j/semaine

6 eval texte

$@    erreur eval

7 size

7 j/anne

7 is_require

$$    ID du processus

8 atime

8 heure été

8 hints

$.    numero ligne

9 mtime

 

9 bitmask

@ARGV args ligne commande

10 ctime

just use

 

@INC   chemin inclusion

11 blksz

POSIX::

3..9 only

@_     args subroutine

12 blcks

strftime!

with EXPR

%ENV   environnement

 


Exemples de programmes PERL :

 

#!/usr/bin/perl

#

# cop_diskette_dos.pl : copie tous les fichiers d'une disquette DOS

# Version plus concise

 

# stocker la liste des fichiers d'une disquette DOS

 

 

foreach (`dosdir | egrep -v "^(Free|Total)"`) { # boucle sur les fichiers

   chop ; # suppression du retour chariot

   y/A-Z/a-z/;   # converion en minuscules

 

   print $f," * ",$g,"\n";

   system""dosread -a -v $_ ./$_");

   }

 

exit;

[webinfo@webdev3 perl]$ cat cop_diskette_dos.pl

#!/usr/bin/perl

#

# cop_diskette_dos.pl : copie tous les fichiers d'une disquette DOS

 

# stocker la liste des fichiers d'une disquette DOS

@files = `dosdir | egrep -v "^(Free|There)"`;

 

foreach $f (@files) { # boucle sur les fichiers

   chop $f; # suppression du retour chariot

   $g = $f ;

   $g = ~tr/A-Z/a-z/;   # converion en minuscules

 

   print $f," * ",$g,"\n";

   system""dosread -a -v $f ./$g");

   }

 

exit;

 

 

#!/usr/bin/perl

#

# cop_diskette_dos2.pl : copie tous les fichiers d'une disquette DOS

# Version plus concise

 

# stocker la liste des fichiers d'une disquette DOS

 

 

foreach (`dosdir | egrep -v "^(Free|Total)"`) { # boucle sur les fichiers

   chop ; # suppression du retour chariot

   y/A-Z/a-z/;   # converion en minuscules

 

   print $f," * ",$g,"\n";

   system""dosread -a -v $_ ./$_");

   }

 

exit;

 

 

#!/usr/bin/perl

#

# cop_diskette_dos.pl : copie tous les fichiers d'une disquette DOS

# Version plus concise

 

# stocker la liste des fichiers d'une disquette DOS

 

 

foreach (`dosdir | egrep -v "^(Free|Total)"`) { # boucle sur les fichiers

   chop ; # suppression du retour chariot

   y/A-Z/a-z/;   # converion en minuscules

 

   print $f," * ",$g,"\n";

   system""dosread -a -v $_ ./$_");

   }

 

exit;

[webinfo@webdev3 perl]$ cat cop_diskette_dos.pl

#!/usr/bin/perl

#

# cop_diskette_dos.pl : copie tous les fichiers d'une disquette DOS

 

# stocker la liste des fichiers d'une disquette DOS

@files = `dosdir | egrep -v "^(Free|There)"`;

 

foreach $f (@files) { # boucle sur les fichiers

   chop $f; # suppression du retour chariot

   $g = $f ;

   $g = ~tr/A-Z/a-z/;   # converion en minuscules

 

   print $f," * ",$g,"\n";

   system""dosread -a -v $f ./$g");

   }

 

exit;

 

 

#!/usr/bin/perl

#

# cop_diskette_dos2.pl : copie tous les fichiers d'une disquette DOS

# Version plus concise

 

# stocker la liste des fichiers d'une disquette DOS

 

 

foreach (`dosdir | egrep -v "^(Free|Total)"`) { # boucle sur les fichiers

   chop ; # suppression du retour chariot

   y/A-Z/a-z/;   # converion en minuscules

 

   print $f," * ",$g,"\n";

   system""dosread -a -v $_ ./$_");

   }

 

exit;

 

 

#!/usr/bin/perl
#
# ctl_users.pl : script perl surveillant des comptes utilisateurs

# en-tete en debut de chaque page du rapport

format top =

Username (UID)      Home directory       Disk Space   Security
-------------------------------------------------------------------
.

# format de chaque ligne ecrites vers STDOUT

format STDOUT =
@<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<< @>>>>>>>>> @<<<<<<<<<<
$uname,          $home_dir,       $disk,     $warn
.

open (PASSWD, "/etc/passwd") || die "Can't open passwd: $!\n";

USER:
while (<PASSWD>) { # boucle sur les lignes du fichier mot de passe
        chop;
        # listes sont entouree de parantheses
       
($uname, $pass, $uid, $gid, $junk, $home_dir, $junk) = split(/:/);
       
# supprimer retour chariot, analyser ligne, ignorer entrees ininteressantes
       
if ( $uname eq "root" || $uname eq "nobody" || substr($uname,0,2) eq "uu" ||
       
$uid <= 100 && $uid > 0 ) { next USER; }
        # positionner variable sur probleme de securite potentiel
       
$warn = ($uid == 0 && $uname ne "root") ? "** UID=0" : " ";
       
$warn = ($pass ne "!" && $pass ne "*") ? "** CK PASS" : $warn;
       
# .= signifie concatenation de chanines de caractetes
        $uname .= " ($uid)"; # ajouter UID a username
        # lancer "du" sur le repertoire principal & extraire taille totale
       
if (-d $home_dir && $home_dir ne "/") {
               
$du = `du -s -k $home_dir` ; chop($du);
               
($disk, $junk) = split(/\t/,$dh); $disk .= "K";
                }
        else { $disk = $home_dir eq "/" ? "skipped" : "deleted"; }
        write; # ecrire ligne formattee sur sortie standard
        }
exit;
 

 

 

#!/usr/bin/perl

#

# wgrep : utilitaire simulant une commande unix "grep" a fenetre

#

# Usage : wgrep [-n@] [-w|b] [:a] | -W] [-d] [-p] (-s] [-m] regexp fichier(s)

#   -n = inclure numeros de lignes

#   -s = signaler les occurences avec des astérisques

#   -wb:a = affiche b lignes avant et a lignes apres chaque occurence

#           (valeur par defaut de 3)

#   -W = supprime les fenetres; equivalent a -w0:0

#   -d = supprime lignes de séparation entre sections de fichier

#   -m = supprime ligne d'en-tête contenant nom de fichier

#   -p = mode normal, equivalent a -W -d

#   -h = affiche ce message d'aide et se termine

# Note : si présent, -h prevaut; sinon l'option la plus a droite l'emporte si contradiction.

#

# Exemple : wgrep.pl -n -s -w1:1 /etc/password /etc/group

 

$before = 3; $after = 3; # taille des fenetres par defaut (et zones tampons)

$show_stars = 0; # compteurs

$ show_nums = 0; # compteurs

$sep = "*********\n"; # ligne de separation

$show_fname = 1;

$show_sep = 1;

 

# boucle jusqu'à ce que l'argument ne commence pas par "-"

 

# test du 1er argument d'@ARGV

while (@ARGV[0] =~ /^-(\w)(.*)/) {

      # Note : \w est une forme abréviée de [a-zA-Z0-9_]

      $arg = $1; # la variable $arg contient l'option

     

      if ($arg eq "s") { $show_stars = 1; }

      elsif ($arg eq "n") { $show_nums = 1; }

      elsif ($arg eq "m") { $show_fname = 1; }

      elsif ($arg eq "d") { $show_sep = 0; }

      elsif ($arg eq "w") {

      # analyser seconde section trouvée aux deux-points

      # dans tableau par defaut @_

       split(/:/,$2);

       $before = @_[0] if @_[0] ne '';

       $after = @_[1] if @_[1] ne '';

      }

      elsif ($arg eq "p") {

            $before = 0;

            $after = 0;

            $show_sep = 0;

      }

      elsif ($arg eq "W") {

            $before = 0;

            $after = 0;

      }

      elsif ($arge eq "h") { $usage("");}

      else { &usage("wgrep: option non valide : $ARGV[0]");

      }      # fin du if

      shift  # on passe à l'argument suivant du @ARGV (meme commande qu'en shell)

}

 

# traitement de l'expression rationnelle à rechercher

 

&usage("absence d'expression rationnelle") if ! @ARGV[0];

$regexp = @ARGV[0];

shift;

$regexp =~s/,\\/,g;  # "/" => "\/"

# si aucun fichier specifie, utiliser entree standarcd

if (! @ARGV[0]) { @ARGV[0] = "STDIN"; }

 

# traitement du cas ou aucun nom de fichier n a ete donne en argument

 

LOOP:

foreach $file (@ARGV) {

      if ($file ne "STDIN" && ! open(NEWFILE, $file)) {

            print STDERR "Ne peut ouvrir fichier $file; on le saute.\n";

            next LOOP;

      }

      $fhandle = $file eq "STDIN" ? STDIN : NEWFILE;

      $lnum = "00000";

      $nbef = 0; $naft = 0; # Init à 0, des compteurs after et ???

      $matched 0; $matched2 = 0;

      &clear_buf(0) if $before > 0;

 

      # logique du script ci-dessous :

      # tant qu'il y a des lignes dans le fichier

      #    si nous avons déjà trouvé une ligne

      #      si la ligne courante est aussi une occurence

      #        on l'affiche et on remet à zéro le compteur after

      #      mais si la ligne courante n'est pas une occurence

      #         si on est encore dans la fenêtre after (apres)

      #           on affiche la ligne de toute façon

      #         sinon

      #           on est hors de la fenêtre, remettre des drapeaux à zéro

      #           et on sauvegarde la ligne courante dans le tampon before.

      "     sinon on est en train de cherche une ligne

      #       si la ligne courante correspond

      #         afficher les séparateurs et la fenêtre before,

      #         afficher la ligne courante et positionner le drapeau match

      #       mais si la ligne courante ne correspond pas

      #         la sauvegarder dans le tampon before.

 

      while (<$fhandle>) {          # boucle sur les lignes du fichier

            ++$lnum;              # incremente le numero de ligne

            if ($matched) {       # affichage fenetre correspondance (si ligne trouve ?)

                  if ($_ =é /$regexp/) {  # cas : si ligne courante correspond

                        $naft = 0;      # remise à zéro du compteur after

                        &print_info(1); # affichages préliminaires

                        print $_;       # et affichage de la ligne

                  }

                  else {        # cas : si ligne courante ne correspond pas

                        if ($after > 0 && ++$naft <= $after) {

                        # afficher la ligne, si on est encore dans la fenêtre after

                           &print_info(0); print $_;

                        }

                        else {                # cas : fenetre after terminee

                               $matched = 0;  # on est plus dans une occurence

                               $naft = 0;     # remise à zero du compteur after

                               # conserver ligne dans tampon before

                               push(@line_buf, $_); $nbef++;

                        } # fin du else "pas dans la fenetre after"

                  } # fin du else "ligne courante ne correspond pas"

            } # fin du else "on est hors de la fenêtre" ????

            else {                                # on recherche toujours

                  if ($_ =~ /$regexp/) {  # on a trouve

                  $matched = 1;           # donc mettre drapeau match (trouve) a 1

                  # afficher separateur(s) fichier et/ou section

                  print $sep if $matched2 && $nbef > $before && $show_sep && $show_fname;

                  print "********* $file ***********\n" if ! $matched2++ && $show_fname;

                  # afficher et nettoyer tampon before,

                  # mettre a zero compteur before

                  &clear_buf(1) if $before > 0; $nbef = 0;

                  &print_info(1); print $_; # afficher la ligne courante

            }

            elsif ($before > 0) {

                  # époper" la plus ancienne lignedu tampon before

                  # & ajouter la ligne courante

                  shift(@line_buf) if $nbef >= $before;

                  push(@line_buf,$_); $nbef++;

                  } # fin elsif "fenetre before non nulle"

            } # fin du else si on n'a pas trouve (no match)

      } # fin boucle while sur les lignes de ce fichier

} # fin de la boucle foreach sur la liste des fichiers

 

exit; # fin du script

 

# cette sub-routine "print_info" attend un 0 ou 1 en argument, qui lui indique si la ligne courante

# correspond ou pas _ et donc si elle doit afficher une etoile ou que des espaces au debut

# de la ligne quand $show_stard est vraie.

sub print_info {

      print @_[0] ? "* " : "  " if $show_stars;

      print $lnum," " if $show_nums; # affiche les numeros de ligne, si c'est necessaire

}

 

# cette sub-routine "clear_buf" est responsable de l'affichage de la fenêtre before et du nettoyage

# du tableau correspondant, @line_buf:

sub clear_buf {

      # argument dit qu'il faut afficher fenetre before ou pas

      $print_flag = @_[0];

      $i = 0; $j = 0;

      if ($print_flag) {

      # si on affiche des numero de ligne, manipuler le compteur

      # pour prendre en compte fenêtre before et garder bonne numerotation

            if ($show_nums) {

                  # $#line_buf = # elements dans tableau line_buf

                  $target = $lnum - ($#line_buf + 1);

                  $lnum = "00000";

                  # si oui, on compte en arriere jusqu'au bon numero

                  while ($i++ < $target) { ++$lnum; }

                  }

            while ($j < $#line_buf) { # afficher fenetre before

                  &print_info(0);

                  print @line_buf[$j++];

                  $lnum++ if $show_nums;

            } # fin du while

      } # fin du "if" print_flag

      @line_buf = (); # nettoyage du tableau line_buf

} # fin de la sub-routine "clear_buf"

 

# cette sub-routine "usage" affiche le message d'erreuyr qui lui est passe en argulet

# et les lignes restantes affichent le message d'utilisation standard et provoque la

# terminaison de "wgrep" :

sub usage {

         print STDERR @_[0],"\n" if @_[0];

         print STDERR "\n

Usage : wgrep [-n@] [-w|b] [:a] | -W] [-d] [-p] (-s] [-m] regexp fichier(s)

   -n    = inclure numeros de lignes

   -s    = signaler les occurences avec des astérisques

   -wb:a = affiche b lignes avant et a lignes apres chaque occurence

           (valeur par defaut de 3)

   -W    = supprime les fenetres; equivalent a -w0:0

   -d    = supprime lignes de séparation entre sections de fichier

   -m    = supprime ligne d'en-tête contenant nom de fichier

   -p    = mode normal, equivalent a -W -d

   -h    = affiche ce message d'aide et se termine

Note : si présent, -h prevaut; sinon l'option la plus a droite l'emporte si contradiction.

Exemple : wgrep.pl -n -s -w1:1 /etc/password /etc/group

";

         exit;

}

 

 

 

#!/usr/bin/env perl -w

 

# exo_perl.pl : programme pour s'exercer aux commandes PERL

# Auteur : Benjamin LISAN

 

#use warn; # module ne fonctionnant pas pour l instant (doit assurer le debugging).

 

use strict ; # module qui fonctionne (rend le programme PERL plus fiable).

 

my $nom = "LISAN";

my @array = (0,1,2,3,4,5);

my $zippy = "ZIPPY";

my $bananes = "banane";

my %hash = ("pomme","rouge","orange","orange");

 

 

# ceic est un commentaire

print "Salut, la terre\n";

$nom = "toto";

print "Bonjour, $nom \n"; # Affiche : Bonjour, toto

print 'Bonjour, $nom \n'; # Affiche littéralement : Bonjour, $name\n

 

# La phrase suivante passe à la ligne en plein milieu du texte

print "Salut

la terre\n";

 

print("Salut, la terre\n");

print "Salut, la terre\n";

 

my $animal = "chameau";

print $animal;

print "\nL'animal est un $animal\n";

my $nombre = 42;

print "Le carré de $nombre est " . $nombre*$nombre . "\n";

 

my @animaux = ("chameau", "lama", "hibou");

my @nombres = (23, 42, 69);

my @melange = ("chameau", 42, 1.23);

 

print $animaux[0]; # Affiche "chameau"

print "\n";

print $animaux[1]; # Affiche "lama"

print "\n";

 

print $melange[$#melange]; # dernier élément, affiche 1.23

print "\n";

 

if (@animaux < 5) {

   print "Nombre d'animaux < a 5 \n";

   }

else

  {  print "Nombre d'animaux >= a 5 \n";

  }

 

@animaux[0,1]; # donne ("chameau", "lama");

@animaux[0..2]; # donne ("chameau", "lama", "Hibou");

@animaux[1..$#animaux]; # donne tous les éléments sauf le premier

 

my @tri = sort @animaux; # tri

my @sansdessusdessous = reverse @nombres; # inversion

 

my %fruit_couleur = (

pomme => "rouge",

banane => "jaune",

);

 

print $fruit_couleur{"pomme"}; # donne "rouge"

print "\n";

 

my @fruits = keys %fruit_couleur;

my @couleurs = values %fruit_couleur;

 

my $variables = {

scalaire => {

description => "élément isolé",

prefix => '$',

},

tableau => {

description => "liste ordonnée d.éléments",

prefix => '@',

},

hash => {

description => "paire clé/valeur",

prefix => '%',

},

};

print "Les scalaires commencent par $variables -> {'scalaire'} -> {'prefix'}\n";

print "Les scalaires commencent par $variables->{'scalaire'}->{'prefix'}\n";

print "Les scalaiires commencent par $variables->scalaire->prefix\n";

 

foreach (@array) {

print "L'élément courant est $_\n";

}

 

# comme d.habitude

if ($zippy) {

print "Yahou!";

}

unless ($bananes) {

print "Y'a plus de bananes";

print "\n";

}

 

# la post-condition Perlienne

print "Yahou!" if $zippy;

print "Y'a plus de bananes" unless $bananes;

print "\n";

 

# Vous n.êtes pas non plus obligé d.utiliser $_ ...

foreach my $cle (keys %hash) {

print "La valeur de $cle est $hash{$cle}\n";

}

 

my $a = 0;

my $b = "---";

 

$a += 4; # comme $a = $a + 1

$a -= 1; # comme $a = $a - 1

$b .= "\n"; # comme $b = $b . "\n";

print $a . " " . $b ;

print "===\n";

 

print "OUVERTURE, TRAITEMENT ET FERMETURE DE FICHIER \n";

#system("cp -p output.txt_sav output.txt");

 

open(INFILE, "input.txt") or die "Impossible d'ouvrir input.txt en lecture : $!";

open(OUTFILE, ">>output.txt") or die "Impossible d'ouvrir output.txt en écriture : $!";

open(LOGFILE, ">>my.log") or die "Impossible d'ouvrir logfile en ajout : $!";

 

#my $ligne = <INFILE>;

#my @lignes = <INFILE>;

 

while (<INFILE>) { # chaque ligne est successivement affectée à $_

print "Je viens de lire la ligne : $_";

}

 

my $record = "Jacques\n";

my $logmessage = "Dernier avertissement avant arret base \n";

 

print OUTFILE $record;

print LOGFILE $logmessage;

 

close INFILE;

close OUTFILE;

close LOGFILE;

 

 

print "== INPUT.TXT ==\n";

system("cat input.txt");

print "== OUTPUT.TXT ==\n";

system("cat output.txt");

print "== MY.LOG ===\n";

system("cat my.log");

 

# la méthode du pauvre pour décomposer une adresse e-mail

my $email = 'benjamin.lisan@free.fr';

if ($email =~ /([^@])+@(.+)/) {

print "Compte : $1\n";

print "Hôte : $2\n";

}

 

# La boucle suivante lit l.entrée standard

# et affiche toutes les lignes non vides :

while (<>) {

  if ( $_ != "end" )

   {

    #exit 2 if /end/;

    next if /^$/;

    print "ligne non vide : ";

    print;

   }

  else { goto SORTIE ; }

}

# ce type de sortie de boucle, par un goto, n'est pas tres propre mais fonctionne

# (juste pour résoudre le pb de l'absence (?) de commande 'break' de sortie de boucle

SORTIE :

 

my $num = 4 ;

print "==> : i= " . $num . " i2= " . &square($num) . "\n" ;

 

sub square {

my $num = shift;

my $result = $num * $num;

return $result;

}

 

 

 

#!/usr/bin/perl -w

 # charger le module DBI

use DBI;

 # fixer la source de données $dns (=database name source) et le compte utilisateur

 # (l'utilisateur doit bien sûr avoir les droits d'accès à cette base)

$database= "lettre_info";

$hostname= "localhost";

$porto= "3306";

$dsn   = "DBI:mysql:database=$database;host=$hostname;port=$porto";

$login = "dev";

$mdp   = "dev";

 

 ########################################################################################################

 # Se connecter à la source de données (avec ce compte valide sur la base) revient à créer un objet     #

 # La méthode connect de la classe DBI renvoie une référence vers cet objet, qui est un                #

 # identifiant de connexion, noté usuellement $dbh (=DataBase Handle).                              #

 # Les méthodes sont appelées suivant la syntaxe usuelle orientée-objet $dbh -> methode          #

 ########################################################################################################

 

$dbh = DBI->connect($dsn, $login, $mdp) or die "Echec de la connexion\n";

$requete = "SELECT max(Numero) FROM ae_lettre_dinfo ";

@enr = $dbh -> selectrow_array($requete);

print "@enr\n";

 

$requete1 = "SELECT * FROM Abonnes WHERE envoyer = 0";

$sth = $dbh->prepare($requete1);

 

$sth -> execute();

while (@liste = $sth -> fetchrow_array)

        {

       $requete2 = "SELECT ID FROM ae_sections WHERE section = ?";

        $sth2 = $dbh->prepare($requete2);

        $sth2->bind_param(1,$liste[1]);

        $sth2 -> execute();

      while (@liste2 = $sth2 -> fetchrow_array)

            {

               #printf "@liste2\n";

              $requete3 = "SELECT * FROM ae_lettre_dinfo WHERE Espaces= ? and Numur= ? and Numero= ?";

                $sth3 = $dbh->prepare($requete3);

                $sth3->bind_param(1,$liste[7]);

                $sth3->bind_param(2,$liste2[0]);

                $sth3->bind_param(3,$enr[0]);

                $sth3 -> execute();

              while (@liste3 = $sth3 -> fetchrow_array)

                        {

                  $message .= $liste3[9];

                      #printf "@liste3\n";

                    }
            $server = 'localhost';
            use Mail::Sendmail;

            #$loaded = 1;
           
print "ok 1\n";
           
if ($server)

                  {
                  $mail{Smtp} = $server;
                  print "Server set to: $server\n";
                    } #
            %mail = ('To' =>$liste[0] ,'From' => 'lettreinfo@urssaf.fr','content-type' => 'text/html; charset="iso-8859-1"','Subject' => 'La Lettre dinfo des Urssaf','Message' => $message);

            print "Sending...\n";

            if (sendmail %mail)

                  {
                  print "content of \$Mail::Sendmail::log:\n$Mail::Sendmail::log\n";
                  if ($Mail::Sendmail::error)

                        {
                  print "content of \$Mail::Sendmail::error:\n$Mail::Sendmail::error\n";
                       
}
     
            print "ok 2\n";

                  #requete update

                  $requete4 = "UPDATE Abonnes SET envoyer=1 WHERE email='".$liste[0]."'";

                  $sth4 = $dbh->prepare($requete4);

                  $sth4 -> execute();
                  }
            else       {
                  print "\n!Error sending mail:\n$Mail::Sendmail::error\n";
                  print "not ok 2\n";
                 
}

      }

}

 

$dbh -> disconnect;