Practical Extraction and Report Language

Après Bash (utile pour traiter les noms de fichiers et leurs emplacements), voici Perl un langage très pratique et aussi barbare pour traiter le contenu des fichiers.

Voici donc un scipts exemple pour mémoire (vous l'avez compris ce blog me sert surtout comme assistant de mémoire personnelle).

# lancer cpan
perl -MCPAN -e 'shell'

#!/usr/bin/perl

# pour avoir les fonction starthtml, h3...
use CGI qw(:standard);

# pour avoir les erreurs et warnings dans le navigateur web
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);

#pour faire des GET HTTP
use LWP::Simple;

#pour les connexions BDD
use DBI;

#C'est toujours mieux
use strict;
use warnings;

#Ca c'est de la balle, vous comprenez ce que ça fait?
eval get "http://foo.bar/programme.pl";

#encore de la balle, avoir une liste d'éléments uniques à partir d'une liste d'éléments non uniques
my %seen;
my @uniqed = grep !$seen{$_}++, @list;


#Un tri selon 2 clés d'un tableau de hashtables
@clients = sort { $::a->{"nom"} cmp $::b->{"nom"}
                or $::a->{"type"} cmp $::b->{"type"}
              } @clients;


print header();
print start_html(-title=>'Deadlines',
               -style=>{'src'=>'/styles.css'});

#un trim
sub trim {
  my $string = shift;
  for ($string) {
      s/^\s+//;
      s/\s+$//;
  }
  return $string;
}


#Une fonction qui découpe une chaine en sous-chaine de taille égale
sub split_chunks
{
  my $texte        = shift(@_);
  my $taille_chunk = shift(@_);

  my @chunks;

  while( length($texte)>0 ){
      if( length($texte)<$taille_chunk ){
          push @chunks, $texte;
          $texte="";
      }
      else{
          push @chunks, substr($texte,0,$taille_chunk);
          $texte = substr($texte,$taille_chunk);
      }
  }
  return @chunks;
}




#Des jolies fonctions pour créer de beau tableaux
sub tableau
{
  print "<p><table cellpadding=\"2px\" cellspacing=\"0\">\n";
}

sub tableau_end
{
  print "</table></p>\n";
}

sub entete_colonne
{
  my $tmp=shift;
  my $align=shift;
  $align="center" unless $align;
  print "<th align=\"$align\" class=\"HdrClmn\">$tmp</th>\n";
}

sub entete_colonne_end
{
  my $tmp=shift;
  my $align=shift;
  print "<th align=\"$align\" class=\"HdrClmnEnd\">$tmp</th>\n";
}

sub ligne
{
  print "<tr>\n";
}

my $couleur="row1";
sub ligne_end
{
  if( $couleur eq "row0" ){
      $couleur="row1";
  }
  else{
      $couleur="row0";
  }
  print "</tr>\n";
}

sub colonne
{
  my $tmp=shift;
  my $align=shift;
  $align="left" unless $align;
  if( !$tmp or $tmp eq "" ){
      $tmp=" " unless $tmp;
  }
  print "<td align=\"$align\" style=\"border-right: 1px solid black\" class=\"$couleur\">$tmp</td>\n";
}


sub colonne_end
{
  my $tmp=shift;
  my $align=shift;
  $align="left" unless $align;
  if( !$tmp or $tmp eq "" ){
      $tmp=" " unless $tmp;
  }
  print "<td align=\"$align\" class=\"$couleur\">$tmp</td>\n";
}


#exmples de connexion BDD
$ENV{'ORACLE_HOME'}    ="/oracle/8.1.7";
$ENV{'NLS_LANG'}       = "french_france.we8iso8859p1";
$ENV{'LD_LIBRARY_PATH'}="/oracle/8.1.7/lib:/usr/local/lib";

my $dbh = = DBI->connect("DBI:Oracle:montns", "login", "pass", {AutoCommit => 0 } ) or die "$DBI::errstr\n";

#mettre "DBI:mysql:mabdd" pour une connexion Mysql et enlever le dernier paramètre


my $select = $dbh->prepare("select champ1,champ2
                          from table1
                          where champ3=? and champ4=? ") or die "$DBI::errstr\n";

$select->execute("var1","var2");

while( ($var1,$var2) = $select->fetchrow() ){

}
#y a aussi $select->finish() si on va pas au bout du fetchrow()

$select->commit(); # ou rollback
$dbh->disconnect();


#Les formulaires
print start_form("POST");
print textarea("nom","contenu",hauteur,largeur);
print submit('envoyer','envoyer');
print checkbox("nom",bool_checked,"valeur","libelle");
print endform;