précèdent | suivant | sommaire

Exemple 4:


Ce programme sert à éditer deux fichiers et un rapport sur vos 400 dernières transactions depuis vidéoposte de la poste.  Il converti le fichier téléchargé au format .shtml et le tranforme en un rapport texte qui affiche vos transactions (une par ligne)

date transaction francs euro

et un autre fichier au format .csv (format qui est dirrectement chargable dans votre tableur ou base de données, Excel, Acces, Word etc...)   en plus, et à titre d'exemple il affiche sur votre écran les transactions dirrectement formaté et prêttent pour l'imprimante.
J'ai commencé à apprendre Perl avec ce programme, je l'ai réécrit plusieurs fois lui apportant à chaque fois un peu plus.  Il fonctionne trés bien en l'état actuel, mais je continu à le travailler pour qu'il télécharge réguliairement les derniers relevés et qu'il se mette à jours tout seul en me faisant un topo à chaque téléchargement. Voilà c'est tout ... alain Adelmar

ligne 1 ligne #!/usr/bin/perl -w
ligne 2 # remd: nettoyage de page shtml de (400 dernieres operations ccp)
ligne 3 # pour en sortir un fichier texte list par operation et une table de hash
ligne 4 # pour rechercher une operation par la date ou le montant ou le label,
ligne 5 # alain adelmar nov 2000
ligne 6 # *******************************************ce prog tourne a merveille

ligne 7 format STDOUT_TOP =
ligne 8 Page @<<
ligne 9 $%

ligne 10 Date  Transaction                 francs    euros
ligne 11 ===== ==========================  ========  ======
ligne 12 .
 

ligne 13 print "Entrez le nom du fichier a traiter\n";
ligne 14 $file = <STDIN>;
ligne 15 print "je traite le fichier $file\n";
 

ligne 16 $filout = "./log_a.txt";
ligne 17 $filoutcsv = "log400tr.csv";

ligne 18 #----------- construction du hash de hash et de la liste de liste.
ligne 19 $t400trs{$a} = ("$tdates{$a}", "$tdesigns{$a}", "$tfrancs{$a}", "$teuros{$a}");
ligne 20 @ttr400ccp = (@tdate, @tfrancs, @teuro, @tdesign);
 

ligne 21 $t = 0;  # compte les lignes du fichier source

ligne 22 $a = $b = 0; # francs ou euro (initialisation des tab & ls, nmb de tr).

ligne 23 open(F, "$file") or die "merde pbOpsrc $!";
ligne 24 @contenu = <F>;
ligne 25 close F or die "remerde pbfermsrc $!";

ligne 26 @nwcontenu = <FO>;
ligne 27 @tcsv = <FV>;

ligne 28 foreach $ligne(@contenu) {
ligne 29  $t++;
ligne 30  if ($t <= 82) {
ligne 31   print "#";
ligne 32   }
ligne 33  elsif ($t <= 83) {
ligne 34   $ligne = "date,designation,francs,euros" . "\n";
ligne 35   tlib_csv($ligne);
ligne 36   print "\ntraitement maintenant\n";
ligne 37   }
ligne 38     else {
ligne 39  $ligne =~ s/^(<.*?>)?//;
ligne 40  $ligne =~ s/^(<.*?>)?//;

ligne 41  $ligne =~ s/()(<.*?>)+//;
ligne 42  $ligne =~ s/()(<.*?>)+//;

ligne 43  $ligne =~ s/\n//; # ote les sauts de lignes.
ligne 44  next if ($ligne eq ""); # et degage les ligne vides.
ligne 45  $u++;

ligne 46  # reconnaitre le champ francs et le champ euro. (1/2)
ligne 47  if ($ligne =~ m/^\d{0,1}.*?\d{1,3}.?\d{2}&nbsp/) {
ligne 48      if ($a == $b) {
ligne 49   $ligne =~ s/().{1}nbsp.?//;
ligne 50   $tfrancs{$a} = $ligne; # ajoute un element a %tfrancs.
ligne 51   #*****format
ligne 52   $lf = $ligne; # ligne francs = $ligne
ligne 53   chomp $lf;
ligne 54   #*****tabl @tfrancs
ligne 55   push @tfrancs, $ligne;  # liste tfrancs
ligne 56   #**********
ligne 57   $lcsv = $ligne;
ligne 58   $lcsv =~ s/,/./;
ligne 59   $lcsv = $lcsv . ",";
ligne 60   push @tcsv, $lcsv;
ligne 61   #**********
ligne 62   $ligne = $ligne . " francs";
ligne 63   $a++;
ligne 64   }
ligne 65      else {
ligne 66   $ligne =~ s/().{1}nbsp.?//;
ligne 67   $teuros{$a} = $ligne;  #ajoute un element a %teuros.
ligne 68   $le = $ligne;
ligne 69   chomp $le;
ligne 70   write;
ligne 71   #************
ligne 72   $lcsv = $ligne;
ligne 73   $lcsv =~ s/,/./;
ligne 74   $lcsv = $lcsv . "\n";
ligne 75   push @tcsv, $lcsv;
ligne 76   #************
ligne 77   push @teuro, $ligne; # ass de la liste teuro.
ligne 78   $ligne = $ligne . " euro\n";
ligne 79   $b++;
ligne 80   }
ligne 81  }

ligne 82  # reconnaitre le champ date.
ligne 83  elsif ($ligne =~ m/^\d{2}\/\d{2}/) {
ligne 84   $tdates{$a} = $ligne;  #ajoute un element a %tdates.
ligne 85       #*******format
ligne 86   $ldt = $ligne;
ligne 87   chomp $ldt;
ligne 88   #*******tabl @tdate
ligne 89   push @tdate, $ligne;   # assignation de la liste tdate
ligne 90   #************
ligne 91   $lcsv = $ligne;
ligne 92   $lcsv = $ligne . ",";
ligne 93   push @tcsv, $lcsv;
ligne 94   #************
ligne 95       $ligne = $ligne . "\t";
ligne 96       }
ligne 97  elsif ($ligne =~ m/^.*?\w.?/) {
ligne 98      $tdesign{$a} = $ligne; # ajoute un element a %tdesigns.
ligne 99      #**********format
ligne 100      $ldg = $ligne;
ligne 101      chomp $ldg;
ligne 102      #**********tableau design
ligne 103      push @tdesign, $ligne;
ligne 104      #**********fichier csv
ligne 105      $lcsv = $ligne;
ligne 106      $lcsv = $lcsv . ",";
ligne 107      push @tcsv, $lcsv;

ligne 108      #**********************************alignement sans format***
ligne 109      if (length $ligne <= 16) {
ligne 110   $ligne = $ligne . "\t\t\t\t";
ligne 111   }
ligne 112      elsif (length $ligne <= 24) {
ligne 113   $ligne = $ligne . "\t\t\t";
ligne 114   }
ligne 115      elsif (length $ligne <= 32) {
ligne 116   $ligne = $ligne . "\t\t";
ligne 117    }
ligne 118      else {
ligne 119   $ligne = $ligne . "\t";
ligne 120   }
ligne 121  }
ligne 122  push @nwcontenu, $ligne;
ligne 123     }
ligne 124 }

ligne 125 sub tlib_csv {
ligne 126     my($ligne) = @_;
ligne 127     push @tcsv, $ligne;
ligne 128 }

ligne 129 print "\n$t lignes traitees pour $a operations enregistrees.\n";

ligne 130 #*********************************
ligne 131 # confection d'un fichier db
 

ligne 132 #@ttr400ccp = (@tdate, @tfrancs, @teuro, @tdesign);

ligne 133 open (FO, ">$filout") or die "merde pbOpcible $!";
ligne 134 print FO @nwcontenu;
ligne 135 close FO or die "rem pbfermcible $!";

ligne 136 open (FV, ">$filoutcsv") or die "mutain de poine ca couille pbOpfls $!";
ligne 137 print FV @tcsv;
ligne 138 close FV or die "flute that's os pbShutfls $!";

ligne 138 print "Voilà, les deux fichier sont créés:\nlog_a.txt => pour un listing texte\nlog400tr.csv => pour une db (séparé par des virgule).\n";

ligne 139 print " Voulez vous jeté une oeil ? [o/n]\n";
ligne 140 $resp = <STDIN>;

ligne 141 #-------- appel a oui_non dans boucle while, fort isn't it ?
ligne 142 while (! oui_non($resp)) {
ligne 143  print "indiquer le numéro de la transaction:\n";
ligne 144  $numt = <STDIN>;
ligne 145  chomp $numt;
ligne 146  $linep = $t400trs{$numt};
ligne 147  # $linep = $ttr400ccp["$numt"];
ligne 148  print "transaction $numt = $linep\n";
ligne 149  print "voulez vous continuer ? [o-n]\n";
ligne 150  $resp = <STDIN>;
ligne 151 }

ligne 152 print "tchao !!\n";

ligne 153 #-------------- oui-non -----faire une routine qui renvoie 1 si oui
ligne 154 sub oui_non {
ligne 155  my($rep) = @_;

ligne 156  $rep =~ s/\W.*//;
ligne 157  $resp =~ tr/A-Z/a-z/;
ligne 158  if ($rep =~ /^o|y/) {
ligne 159   return 0; # faux pour while(! oui_non($resp))
ligne 160   }
ligne 161  else {
ligne 162   return 1; # vrai pour sortir
ligne 163   }
ligne 164 }

ligne 165 format STDOUT =
ligne 166 @<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<< @<<<<<<<
ligne 167 $ldt, $ldg, $lf, $le
ligne 168 .

ligne 169 END;

Le même en couleurs ci-dessous édité depuis l'éditeur Scite.exe (super éditeur gratuit qui édite plus d'une trentaine de langage téléchargable sur http://www.scantilla.com/) pour Windows95 de Petit Mou qui lui n'a rien à part notepad ...pffff
 
  #!/usr/bin/perl -w
# remd: nettoyage de page shtml de (400 dernieres operations ccp)
# pour en sortir un fichier texte list par operation et une table de hash
# pour rechercher une operation par la date ou le montant ou le label,
# alain adelmar nov 2000
# *******************************************ce prog tourne a merveille

format STDOUT_TOP =
Page @<<
$%

Date  Transaction                 francs    euros
===== ==========================  ========  ======
.
  
print "Entrez le nom du fichier a traiter\n";
$file = <STDIN>;
print "je traite le fichier $file\n";
  
$filout = "./log_a.txt";
$filoutcsv = "log400tr.csv";

#----------- construction du hash de hash et de la liste de liste.
$t400trs{$a} = ("$tdates{$a}", "$tdesigns{$a}", "$tfrancs{$a}", "$teuros{$a}");
@ttr400ccp = (@tdate, @tfrancs, @teuro, @tdesign);
  
$t = 0;  # compte les lignes du fichier source

$a = $b = 0; # francs ou euro (initialisation des tab & ls, nmb de tr).

open(F, "$file") or die "merde pbOpsrc $!";
@contenu = <F>;
close F or die "remerde pbfermsrc $!";

@nwcontenu = <FO>;
@tcsv = <FV>;

foreach $ligne(@contenu) {
$t++;
if ($t <= 82) {
  print "#";
  }
elsif ($t <= 83) {
  $ligne = "date,designation,francs,euros" . "\n";
  tlib_csv($ligne);
  print "\ntraitement maintenant\n";
  }
    else {
$ligne =~ s/^(<.*?>)?//;
$ligne =~ s/^(<.*?>)?//;

$ligne =~ s/()(<.*?>)+//;
$ligne =~ s/()(<.*?>)+//;

$ligne =~ s/\n//; # ote les sauts de lignes.
next if ($ligne eq ""); # et degage les ligne vides.
$u++;

# reconnaitre le champ francs et le champ euro. (1/2)
if ($ligne =~ m/^\d{0,1}.*?\d{1,3}.?\d{2}&nbsp/) {
     if ($a == $b) {
  $ligne =~ s/().{1}nbsp.?//;
  $tfrancs{$a} = $ligne; # ajoute un element a %tfrancs.
  #*****format
  $lf = $ligne; # ligne francs = $ligne
  chomp $lf;
  #*****tabl @tfrancs
  push @tfrancs, $ligne;  # liste tfrancs
  #**********
  $lcsv = $ligne;
  $lcsv =~ s/,/./;
  $lcsv = $lcsv . ",";
  push @tcsv, $lcsv;
  #**********
  $ligne = $ligne . " francs";
  $a++;
  }
     else {
  $ligne =~ s/().{1}nbsp.?//;
  $teuros{$a} = $ligne;  #ajoute un element a %teuros.
  $le = $ligne;
  chomp $le;
  write;
  #************
  $lcsv = $ligne;
  $lcsv =~ s/,/./;
  $lcsv = $lcsv . "\n";
  push @tcsv, $lcsv;
  #************
  push @teuro, $ligne; # ass de la liste teuro.
  $ligne = $ligne . " euro\n";
  $b++;
  }
}

# reconnaitre le champ date.
elsif ($ligne =~ m/^\d{2}\/\d{2}/) {
  $tdates{$a} = $ligne;  #ajoute un element a %tdates.
      #*******format
  $ldt = $ligne;
  chomp $ldt;
  #*******tabl @tdate
  push @tdate, $ligne;   # assignation de la liste tdate
  #************
  $lcsv = $ligne;
  $lcsv = $ligne . ",";
  push @tcsv, $lcsv;
  #************
      $ligne = $ligne . "\t";
      }
elsif ($ligne =~ m/^.*?\w.?/) {
     $tdesign{$a} = $ligne; # ajoute un element a %tdesigns.
     #**********format
     $ldg = $ligne;
     chomp $ldg;
     #**********tableau design
     push @tdesign, $ligne;
     #**********fichier csv
     $lcsv = $ligne;
     $lcsv = $lcsv . ",";
     push @tcsv, $lcsv;

     #**********************************alignement sans format***
     if (length $ligne <= 16) {
  $ligne = $ligne . "\t\t\t\t";
  }
     elsif (length $ligne <= 24) {
  $ligne = $ligne . "\t\t\t";
  }
     elsif (length $ligne <= 32) {
  $ligne = $ligne . "\t\t";
   }
     else {
  $ligne = $ligne . "\t";
  }
}
push @nwcontenu, $ligne;
    }
}

sub tlib_csv {
    my($ligne) = @_;
    push @tcsv, $ligne;
}

print "\n$t lignes traitees pour $a operations enregistrees.\n";

#*********************************
# confection d'un fichier db
  
#@ttr400ccp = (@tdate, @tfrancs, @teuro, @tdesign);

open (FO, ">$filout") or die "merde pbOpcible $!";
print FO @nwcontenu;
close FO or die "rem pbfermcible $!";

open (FV, ">$filoutcsv") or die "mutain de poine ca couille pbOpfls $!";
print FV @tcsv;
close FV or die "flute that's os pbShutfls $!";

print "Voilà, les deux fichier sont créés:\nlog_a.txt => pour un listing texte\nlog400tr.csv =>
 pour une db (séparé par des virgule).\n";

print " Voulez vous jeté une oeil ? [o/n]\n";
$resp = <STDIN>;

#-------- appel a oui_non dans boucle while, fort isn't it ?
while (! oui_non($resp)) {
print "indiquer le numéro de la transaction:\n";
$numt = <STDIN>;
chomp $numt;
$linep = $t400trs{$numt};
# $linep = $ttr400ccp["$numt"];
print "transaction $numt = $linep\n";
print "voulez vous continuer ? [o-n]\n";
$resp = <STDIN>;
}

print "tchao !!\n";

#-------------- oui-non -----faire une routine qui renvoie 1 si oui
sub oui_non {
my($rep) = @_;

$rep =~ s/\W.*//;
$resp =~ tr/A-Z/a-z/;
if ($rep =~ /^o|y/) {
  return 0; # faux pour while(! oui_non($resp))
  }
else {
  return 1; # vrai pour sortir
  }
}

format STDOUT =
@<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<< @<<<<<<<
$ldt, $ldg, $lf, $le
.

END;