Scripts ou codes gratuits et disponibles pour tous en Perl [Sources]

**djibril** · 09/11/2004, 17h15

Bonjour à vous tous

Grâce à la suggestion et à l'initiative de 2Eurocents, j'ouvre ce post-it sur les snippets. Que sont les snippets ? Des petits morceaux de code bien astucieux qu'on utilise souvent dans nos programmes. Un exemple ? Lister dans un tableau les fichiers pl d'un répertoire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
my($repertoire) = "/path/de/mon/repertoire";
my(%mtime);
my(@ficpl);
opendir (DIR, "$repertoire") || die ("can't open $repertoire");
@ficpl = grep { 
	/\.(pl)$/i && ($mtime{$_} = (stat ("$repertoire\\$_"))[9]);
} 
readdir (DIR);
closedir DIR;
my(@ordered_pl_names) = @ficpl;

Donc, si vous désirez poster un morceau de code que vous utilisez souvent et dont vous pensez qu'il sera utile pour la communauté, n'hésitez pas !

Les meilleurs bouts de codes seront mis à la disposition de tout le monde sur la page source de la rubrique Perl.

N'hésitez pas à y contribuer ou faire des remarques.

Merci

**GLDavid** · 09/11/2004, 18h04

Obtenir un chemin relatif à partir d'un chemin absolu :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
sub Relative_path_Unix {
        #@_ = "/home/toto/tata";
	my($name) = @_;
	my($i) = rindex($name, '/');
	my($nom) = substr($name, $i+1);
        #retourne "Tata"
	return $nom;
}
 
sub Relative_path_DOS {
        #@_ = "C:\\Toto\\Tata";
	my($name) = @_;
	my($i) = rindex($name, '\\');
	my($nom) = substr($name, $i+1);
        #retourne "Tata"
	return $nom;
}

@ ++

**mhooreman** · 27/09/2006, 14h10

Envoyé par GLDavid

Obtenir un chemin relatif à partir d'un chemin absolu :

Le module Cwd permet de le faire.

Sous linux:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
perl -e 'use Cwd; print Cwd::abs_path("./bashrc"); print $/'
/data01/samba/users/mhoo/bashrc

Sous windows:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
perl -e "use Cwd; print Cwd::abs_path('perl.exe') . $/;"
C:\Perl\bin\perl.exe

**GLDavid** · 09/11/2004, 18h08

Effectuer une connexion FTP :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
use Net::FTP;
 
sub ftp_call {
	#download à partir d'un répertoire FTP
	my($file);
	my($ftp) = Net::FTP -> new (
 		"xxx.xxx.xxx.xxx",
  		Passive =>1,
  		Timeout => 30
  	) or die "Unreachable host !\n";
	$ftp->login("toto","toto") or die "Connexion impossible";
	$ftp->binary; 
	$ftp->cwd("MonRepertoire");
	foreach $file (@_) {
		$file = $file.".pl";
		$ftp->get($file) or die "Impossible d'obtenir $file !";
#Pour l'upload ?
#$ftp->put($file) or die "Impossible d'envoyer $file !";
	}
}

**2Eurocents** · 09/11/2004, 18h16

Bonjour à tous,

Puisque l'on parle de moi, je rajoute mon petit bout de code ...

Il s'agit du balayage d'un fichier dont les champs sont séparés par des virgules. On veut ce fichier dans une table de hachage, mais la clef est la quatrième colonne du fichier. En plus (spécif. idiote des structures de données

), on veut récupérer les autres colonnes dans une liste, référencée dans la fameuse table de hachage ... Mais peut être que le code est plus explicite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
#! /usr/bin/perl -w
my @fichier;
my %liste;
 
open ( FICHIER , "< ./data.txt" ) or  die "Fichier Introuvable";
chomp ( @fichier = <FICHIER> );
close ( FICHIER ) ;
 
%liste=map ( { my @ligne=split(/,/,$_); 
             ($ligne[3], [ @ligne[0..(@ligne-2)] ]) } @fichier);
 
foreach $key (keys (%liste)) {
  print $key." = ".$liste{$key}[0]."/".$liste{$key}[1]."/".$liste{$key}[2]."\n" ;
}

La cle de tout ce code est dans les lignes 9 et 10 (%liste = map ...) où l'on a un traitement systématique (map), un usage de référence anonyme ( [] autour du 2e élément que l'on met dans la liste de sortie), usage de tranches de tableau (sur laquelle on fait la référence anonyme), affectation d'une liste correctement formatée à une table de hachage ...

J'espère que l'idée qui a sous-tendu ce code servira à d'autres ...

**Arioch** · 10/11/2004, 11h52

Voici une vieille fonction qui retourne la date du jour selon différents formats en fonction du format passé en paramètre.

Liste des formats disponibles :

"JJMMAA" pour obtenir JJ/MM/AA exemple "10/11/04"
"JJMMAAAA" pour JJ/MM/AAAA exemple "10/11/2004"
"JJMMMAAAA" exemple "10 nov 2004"
"JJMMMMAAAA" exemple "10 novembre 2004"
"AAAAMMJJ" exemple "20041110"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
sub DonneDate
{
	my $Format;
	$Format = ($_[0] ? $_[0] : "AAAAMMJJ");
	my ($Sec,$Min,$Heure,$Mjour,$Mois,$Annee,$Sjour,$Ajour,$Isdst) = localtime(time);
	$Annee += 1900;
	$Mois += 1;
	$Mois = 1 if ($Mois == 13);
	if ($Format eq "JJMMMAAAA")
	{
		my @MoisCourt = qw(jan fév mar avr mai juin juil août sept oct nov déc);
		return $Mjour . ' ' . $MoisCourt[$Mois-1] . ' ' . $Annee;
	}
	elsif ($Format eq "JJMMMMAAAA")
	{
		my @MoisLong = qw(janvier février mars avril mai juin juillet août septembre octobre novembre décembre);
		return $Mjour . ' ' . $MoisLong[$Mois-1] . ' ' . $Annee;
	}
	else	# on ne traite que du format numérique ici
	{
		$Mois = '0' . $Mois if ($Mois < 10);
		$Mjour = '0' . $Mjour if ($Mjour < 10);
		if ($Format eq "JJMMAA")
		{
			if ($Annee =~ /(\d{2})(\d{2})/)
			{
				return $Mjour . '/' . $Mois . '/' . $2;
			}
			else
			{
				return $Mjour . '/' . $Mois . '/' . $Annee;
			}
		}
		elsif ($Format eq "JJMMAAAA")
		{
			return $Mjour . '/' . $Mois . '/' . $Annee;
		}
		else
		{
			return "$Annee$Mois$Mjour";
		}
	}
}

Fonctionne sous Linux et Windows.

**Arioch** · 10/11/2004, 11h54

Autre vieille fonction qui retourne l'heure cette fois.

2 formats au choix en paramètres à la fonction :
"HHMM" retourne par ex. "10:30"
"HHMMSS" retourne par ex. "10:30:07"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
sub DonneHeure
{
	my $Format;
	$Format = ($_[0] ? $_[0] : "HHMMSS");
	my ($Sec,$Min,$Heure,$Mjour,$Mois,$Annee,$Sjour,$Ajour,$Isdst) = localtime(time);
	$Sec = '0' . $Sec if ($Sec < 10);
	$Min = '0' . $Min if ($Min < 10);
	$Heure = '0' . $Heure if ($Heure < 10);
	if ($Format eq "HHMM")
	{
		return "$Heure:$Min";
	}
	else
	{
		return "$Heure:$Min:$Sec";
	}
}

Idem que fonction précédente, fonctionne sous Linux comme Windows.

**2Eurocents** · 10/11/2004, 15h02

Pour le formatage de date et heures, je m'étais forgé ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
sub fdate
{
  my $chaine = shift;
  my $date;
  if ( @_ ) { $date = shift } else { $date = time }
  my ($sec,$min,$heure,$jourmois,$mois,$annee,$joursem,$jourannee,$dst) = localtime($date);
  $annee+=1900;
  my $anneecourte = join ('', (split('',$annee))[2,3]);
  map ( { $_ = sprintf ("%02d", $_) } ($sec,$min,$heure,$jourmois,$mois,$anneecourte) );
 
  my $nommois = qw (Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre)[$mois];
  my $moiscourt = qw (Jan Fev Mar Avr Mai Jun Jui Aou Sep Oct Nov Déc)[$mois];
  my $nomjour = qw (Dimanche Lundi Mardi Mercredi Jeudi Vendredi Samedi Dimanche)[$joursem];
  my $nomjourcourt = join ('', (split('',$nomjour))[0..2]);
 
  $chaine =~ s/\#SS\#/$sec/g ;
  $chaine =~ s/\#MN\#/$min/g ;
  $chaine =~ s/\#HH\#/$heure/g ;
  $chaine =~ s/\#JJ\#/$jourmois/g ;
  $chaine =~ s/\#MM\#/$mois/g ;
  $chaine =~ s/\#NM\#/$nommois/g ;
  $chaine =~ s/\#MC\#/$moiscourt/g ;
  $chaine =~ s/\#AAAA\#/$annee/g ;
  $chaine =~ s/\#AA\#/$anneecourte/g ;
  $chaine =~ s/\#JS\#/$joursem/g ;
  $chaine =~ s/\#NJ\#/$nomjour/g ;
  $chaine =~ s/\#JC\#/$nomjourcourt/g ;
  $chaine =~ s/\#JA\#/$jourannee/g ;
  $chaine =~ s/\#DS\#/$dst/g ;
 
  return ($chaine) ;
}

... qui marche bien aussi, comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
#Demonstration ...
my $instant = time ;
print fdate ("Il est #HH#:#MN#")."\n" ;
print fdate ("Nous sommes en #AA# ou #AAAA#")."\n" ;
sleep (5) ;
print fdate ("Nous sommes le #JC# #JJ#.#MM#.#AA# (#JA# jour de l'annee) et il est #HH#:#MN#:#SS# (DST=#DS#)")."\n" ;
print fdate ("Nous étions le #NJ# #JJ# #NM# #AAAA# (#JA# jour de l'annee) et il est #HH#:#MN#:#SS# (DST=#DS#)", $instant)."\n" ;

Mais j'avoue, je viens de rajouter le traitement des noms courts de jour et de mois, parce qu'à l'époque du codage, je n'y avait pas pensé ...

**GLDavid** · 12/11/2004, 15h46

Un truc tout simple car j'ai encore vu un post à ce sujet : comment écrire dans un fichier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
open FILE, '>truc.txt' or die "truc.txt : $!\n";
print FILE "Bla bla bla !!!!";
close FILE;

Les redirections dans la close open sont identiques à celles d'Unix :
> je crée un fichier s'il n'existe pas sinon j'écrase le précédent s'il existe
>> je crée un fichier s'il n'existe pas sinon j'écris à la suite du précédent.
Ajout de 2Eurocent toujours utile

: EN AUCUN CAS mettre de virgule entre le FILE et la chaine dans l'instruction print !

@ ++

**mhooreman** · 27/09/2006, 14h19

Envoyé par GLDavid

Un truc tout simple car j'ai encore vu un post à ce sujet : comment écrire dans un fichier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
open FILE, '>truc.txt' or die "truc.txt : $!\n";
print FILE "Bla bla bla !!!!";
close FILE;

Les redirections dans la close open sont identiques à celles d'Unix :
> je crée un fichier s'il n'existe pas sinon j'écrase le précédent s'il existe
>> je crée un fichier s'il n'existe pas sinon j'écris à la suite du précédent.
Ajout de 2Eurocent toujours utile

: EN AUCUN CAS mettre de virgule entre le FILE et la chaine dans l'instruction print !

@ ++

Pour les redirections, petite remarque: il est plus fiable d'utiliser un 'open' à 3 arguments (cfr camel book entres autres). On préfèrera donc:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

open FILE, '>', 'truc.txt' or die ...

**rcageot** · 27/09/2006, 16h36

salut,
je me suis fait il y a longtemps un librairie de fonction que j'utilise souvent
je n'ai pas remis le nez dans le code donc il peut y avoir des optimisations mais ça marche très bien depuis des années :-)
############################################################################
# Sub : right_adjust (justify a droite)
# Usage : &right_adjust("#caractere","chaine");
# retour: la chaine ajuste a droite au nombre de caracteres

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
sub right_adjust {
    local($sp,$str) = @_;
    $long = length($str);
    for ($r=$long;$r<=$sp;$r++) {
       $str = $str." ";
    }
    return $str;
}

############################################################################
# Sub : which (emulation du which Unix)
# Usage : &which("file");
# retour: le path complet du fichier .
#---------------------------------------------------------------------------

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
sub which {
   local ($file) = @_;
   my($file) = shift;
   foreach (split(/:/, $ENV{PATH})) {
    return "$_/$file" if (-x "$_/$file");
   }
   return undef;
}

############################################################################
# Sub : isnum (test si la chaine de caractere est numerique)
# Usage : if (&isnum("chaine") ) {;
# retour: 1 ou vrai si la chaine est numerique .
#---------------------------------------------------------------------------

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
sub isnum {
   local ($test) = @_;
   $test2 = $test;
   $cnt = $test2 =~ tr/0-9//;
   if ($cnt != length($test)) {
      return (0);
   } else {
      return (1);
   }
}

############################################################################
# sub : select _jour, _mois, _annee, _heure, _minutes
# usage : &select
#---------------------------------------------------------------------------

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
 
sub select_jour {
   local ($first,$last,$sel,$js_add,$name) = @_;
   if ($first eq "") {$first = 1;}
   if ($last eq "") {$last =31;}
   if (defined $name) {
      print "   <SELECT name=\"$name\" $js_add>";
   } else {
      print "   <SELECT name=\"jour\" $js_add>";
   }
   print "    <OPTION>";
   for ($z=$first;$z<=$last;$z++) {
      if ($sel == $z) {
         print "    <OPTION SELECTED VALUE=\"$z\">$z";
      } else {
         print "    <OPTION VALUE=\"$z\">$z";
      }
   }
   print "   </SELECT>";
}
sub select_mois {
   local ($first,$last,$sel,$js_add,$name) = @_;
   if ($first eq "") {$first = 1;}
   if ($last eq "") {$last =12;}
   if (defined $name) {
      print "   <SELECT name=\"$name\" $js_add>";
   } else {
      print "   <SELECT name=\"mois\" $js_add>";
   }
   print "    <OPTION>\n";
   for ($z=$first;$z<=$last;$z++) {
      if ($sel == $z) {
         print "    <OPTION SELECTED VALUE=\"$z\">$z\n";
      } else {
         print "    <OPTION VALUE=\"$z\">$z\n";
      }
   }
   print "   </SELECT>\n";
}
 
sub select_annee {
   local ($first,$last,$sel,$js_add,$name) = @_;
   if ($first eq "") {$first = $annee;}
   if ($last eq "") {$last = $first + 20;}
   if (defined $name) {
      print "   <SELECT name=\"$name\" $js_add>";
   } else {
      print "   <SELECT name=\"annee\" $js_add>";
   }
   print "    <OPTION>\n";
   for ($z=$first;$z<=$last;$z++) {
      if ($sel == $z) {
         print "    <OPTION SELECTED VALUE=\"$z\">$z\n";
      } else {
         print "    <OPTION VALUE=\"$z\">$z\n";
      }
   }
   print "   </SELECT>\n";
}
 
sub select_heure {
   local ($first,$last,$sel,$js_add) = @_;
   if ($first eq "") {$first = 0;}
   if ($last eq "") {$last = 23;}
   print "   <SELECT name=\"heure\" $js_add>\n";
   print "    <OPTION>\n";
   for ($z=$first;$z<=$last;$z++) {
      if ($sel == $z) {
         print "    <OPTION SELECTED VALUE=\"$z\">$z\n";
      } else {
         print "    <OPTION VALUE=\"$z\">$z\n";
      }
   }
   print "   </SELECT>\n";
}
 
sub select_minute {
   local ($first,$last,$sel,$js_add) = @_;
   if ($first eq "") {$first = 0;}
   if ($last eq "") {$last = 59;}
   print "   <SELECT name=\"minute\" $js_add>\n";
   print "    <OPTION>\n";
   for ($z=$first;$z<=$last;$z+=5) {
      if ($sel == $z) {
         print "    <OPTION SELECTED VALUE=\"$z\">$z\n";
      } else {
         print "    <OPTION VALUE=\"$z\">$z\n";
      }
   }
   print "   </SELECT>\n";
}

############################################################################
# Sub : commify (Converti chiffre en chaine 1000 => 1,000)
# Usage : print "debut " . &commify($chiffre) ." suite";
# retour: chaine modifie
#---------------------------------------------------------------------------

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
sub commify {
    local($_) = shift;
    1 while s/^(-?\d+)(\d{3})/$1,$2/;
    return $_;
}

############################################################################
# Sub : compress (elimine tous les espaces dans une chaine de caractères)
# Usage : &compress($chaine);
# retour: chaine modifie
#---------------------------------------------------------------------------

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
sub compress {
   local ($chaine_a_compresser) = @_;
   while ( index($chaine_a_compresser," ") != -1) { $chaine_a_compresser =~ s/ //g;}
   return $chaine_a_compresser;
}

############################################################################
# Sub : trim_space (elimine tous les caractères choisis en début et à la fin dans une chaine de caractères)
# Usage : &trim_space($chaine);
# retour: chaine modifie
#---------------------------------------------------------------------------

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
sub trim_space {
   local ($chaine_a_traiter,$car2del) = @_;
   if ($car2del eq "") {$car2del = " ";}
   while (substr($chaine_a_traiter,0,1) eq "$car2del") {
      $chaine_a_traiter = substr($chaine_a_traiter,1);
   }
   while (substr($chaine_a_traiter,length($chaine_a_traiter)-1,1) eq "$car2del") {
      $chaine_a_traiter = substr($chaine_a_traiter,0,length($chaine_a_traiter)-1);
   }
   return $chaine_a_traiter;
}

############################################################################
# Sub : br_to_lf et lf_to_br (remplace les retours chariot/line feed par des code <BR>
# et vice versa dans une chaine)
# Usage : &br_to_lf($chaine);
# retour: chaine modifie
#---------------------------------------------------------------------------

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
 
sub br_to_lf {
   local($ch_mod) = @_;
   $ch_mod =~ s/<BR>/\n/g;
   return $ch_mod;
}
 
sub lf_to_br {
   local($ch_mod) = @_;
   $ch_mod =~ s/\r//g;
   while (index($ch_mod, "\n\n") != -1) {$ch_mod  =~ s/\n\n/\n/g;}
   if (substr($ch_mod,length($ch_mod)-1) eq "\n") {
      $ch_mod = substr($ch_mod,0,length($ch_mod)-1);
   }
   $ch_mod =~ s/\n/<BR>/g;
   return $ch_mod;
}

############################################################################
# Obtenir le jour de la semaine d'un jour donné
# Usage: $week_day = &get_week_day($jour,$mois,$annee)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
 
sub get_week_day {
        local($d,$m,$y) = @_;
        local($ya,$c);
 
        $y = (localtime(time))[5] + 1900  if ($y eq '');
 
        if ($m > 2) {
                $m -= 3;
        } else {
                $m += 9;
                --$y;
        }
        $c = int($y/100);
        $ya = $y - (100 * $c);
        $jd =  int((146097 * $c) / 4) +
                   int((1461 * $ya) / 4) +
                   int((153 * $m + 2) / 5) +
                   $d + 1721119;
        $sem_jour = ($jd + 1) % 7;
        return($sem_jour);
}

############################################################################
# Copy d'un répertoire avec ses sous répertoires dans un autre répertoire
# Usage: &copy_dir ( source, destination)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
 
sub copy_dir {
   local ($path_from,$path_to) = @_;
   $path_from =~ s$//$/$g;
   $path_to   =~ s$//$/$g;
   local (*DIR);
   opendir( DIR, "$path_from" ) || &web_error("Impossible d'ouvrir le répertoire $path_from<BR>Erreur: $!","$cgiurl");
 
   while ( $entry = readdir( DIR ) ) {
      $type = ( -d "$path_from/$entry" ) ? "dir" : "file"; 
      if ( ($type eq "dir") && ($entry ne "..") && ($entry ne ".") ) {
         if (!-d "$path_to/$entry") { 
            &web_error("Impossible de se placer sur le répertoire $path_to  <BR>Erreur: $!\n","$cgiurl") unless chdir ("$path_to");
            &web_error("Impossible de créer le sous répertoire $entry dans $path_to  <BR>Erreur: $!\n","$cgiurl") unless mkdir "$entry" , 0755;
            #print "<BR>Création de $path_to/$entry\n";
         }
         &copy_dir("$path_from/$entry","$path_to/$entry");
      }
      if ( ( $type eq "file" ) && ($entry ne "..") ) {
         #print "<BR>Copy $path_from/<b>$entry</b> \n";
         &copy_file("$path_from/$entry","$path_to/$entry");
      }
   }
 
   closedir( DIR );
   return;
}

############################################################################
# backup de dossier avec test si le fichier cible a été modifié
# Usage: backup_dir (origine , destination, mo)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
 
sub backup_dir {
   local ($path_from,$path_to,$mode) = @_;
   $path_from =~ s$//$/$g;
   $path_to   =~ s$//$/$g;
   local (*DIR);
   if ($mode ne "test") {
      print "<UL><LI>backup de $path_from";
   }
   opendir( DIR, "$path_from" ) || &web_error("Impossible d'ouvrir le répertoire $path_from<BR>Erreur: $!","$cgiurl");
 
   while ( $entry = readdir( DIR ) ) {
      $type = ( -d "$path_from/$entry" ) ? "dir" : "file"; 
      if ( ($type eq "dir") && ($entry ne "..") && ($entry ne ".") ) {
         if (!-d "$path_to/$entry") {
            if ($mode ne "test") {
               &web_error("Impossible de se placer sur le répertoire $path_to  <BR>Erreur: $!\n","$cgiurl") unless chdir ("$path_to");
               &web_error("Impossible de créer le sous répertoire $entry dans $path_to  <BR>Erreur: $!\n","$cgiurl") unless mkdir "$entry" , 0777;
               print "<BR><b>Création de $path_to/$entry</b>\n";
            }
         }
         &backup_dir("$path_from/$entry","$path_to/$entry","$mode");
      }
      if ( ( $type eq "file" ) && ($entry ne "..") && (compress($entry) ne "") ) {
         ($dev_source,
          $ino_source,
          $mode_source,
          $nlink_source,
          $uid_source,
          $gid_source,
          $rdev_source,
          $size_source,
          $atime_source,
          $mtime_source,
          $ctime_source,
          $blksize_source,
          $blocks_source) = stat("$path_from/$entry");
         ($dev_dest,
          $ino_dest,
          $mode_dest,
          $nlink_dest,
          $uid_dest,
          $gid_dest,
          $rdev_dest,
          $size_dest,
          $atime_dest,
          $mtime_dest,
          $ctime_dest,
          $blksize_dest,$blocks_dest) = stat("$path_to/$entry");
         if ( ($atime_source != $atime_dest) && ($mtime_source != $mtime_dest) ) {
            if ($mode ne "test") {
               $perms1 = $mode_source & 07777;
               $oct_perms1 = sprintf "%lo", $perms1;
               print "<table border><tr><td colspan=5>$entry ($size_source bytes)</td></tr>\n";
               print "<tr><td></td><td>A</td><td>M</td><td>C</td><td>Mode</td></tr>\n";
               print "<tr><td>source</td><td>$atime_source</td><td>$mtime_source</td><td>$ctime_source</td><td>$mode_source : $oct_perms1</td></tr>\n";
               if (-e "$path_to/$entry") {
                  $perms2 = $mode_dest & 07777;
                  $oct_perms2 = sprintf "%lo", $perms2;
                  print "<tr><td>destination</td><td>$atime_dest</td><td>$mtime_dest</td><td>$ctime_dest</td><td>$mode_dest : $oct_perms2</td></tr>\n";
               } else {
                  print "<tr><td>destination</td><td colspan=4><font color=red>Création</font></td></tr>\n";
               }
               print "</table>\n";
               &copy_file("$path_from/$entry","$path_to/$entry");
               $perm = "0"."$oct_perms1";
               chmod  0666 , "$path_to/$entry";
               print "<br><font color=blue><b>Copie ok</b></font>";
               ($atime, $mtime) = (stat("$path_from/$entry"))[8,9];
               utime $atime, $mtime, "$path_to/$entry";
            }
            $nbfilebck +=1;
         } 
      }
   }
   if ($mode ne "test") {
      print "</LI></UL>";
   }
   closedir( DIR );
   return;
}

############################################################################
# Copie de fichier en mode binaire
# Usage: copy_file(origine , destination)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
sub copy_file {
    local ($infile,$outfile) = @_;
 
    open( INFILE, "<$infile" );
    open( OUTFILE, ">$outfile" );
 
    binmode( INFILE ); binmode( OUTFILE ); # crucial for binary files!
 
    while ( read( INFILE, $buffer, 1024 ) ) {
      print OUTFILE $buffer;
    }
 
    close( INFILE ); close( OUTFILE );
}

**2Eurocents** · 22/11/2004, 18h17

Tiens, un bout de code qui ne sert à rien ...

Non, j'exagère. Il peut servir :
1) Aux informaticiens de l'état civil
2) Aux profs en manque d'idées de TP d'informatique, niveau débutant

Il s'agit de deux fonctions destinées à convertir les nombres écrits en chiffres arabes vers des chiffres romains, et inversement.

C'est vrai que ça fait quand même plus classieux d'écrire :
22 Novembre MMIV que 22 Novembre 2004

Et puis une date de naissance en MDMLXX, par exemple, ça vous pose tout de suite quelqu'un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
sub romain
{
  my $nombre=shift;
  my $chaine="";
 
  while ($nombre >= 1000) { $chaine.="M"; $nombre-=1000; }
  if ($nombre >= 900) { $chaine.="CM"; $nombre-=900; }
  while ($nombre >= 500) { $chaine.="D"; $nombre-=500; }
  if ($nombre >= 400) { $chaine.="CD"; $nombre-=400; }
  while ($nombre >= 100) { $chaine.="C"; $nombre-=100; }
  if ($nombre >= 90) { $chaine.="XC"; $nombre-=90; }
  while ($nombre >= 50) { $chaine.="L"; $nombre-=50; }
  if ($nombre >= 40) { $chaine.="XL"; $nombre-=40; }
  while ($nombre >= 10) { $chaine.="X"; $nombre-=10; }
  if ($nombre >= 9) { $chaine.="IX"; $nombre-=9; }
  while ($nombre >= 5) { $chaine.="V"; $nombre-=5; }
  if ($nombre >= 4) { $chaine.="IV"; $nombre-=4; }
  while ($nombre > 0) { $chaine.="I"; $nombre--; }
 
  return $chaine;
}
 
 
sub arabe
{
  my $chaine=shift;
  my @elements=reverse (split (//,$chaine));
  my $nombre=0;
  my %valeurs = ( "M" => 1000, "D" => 500, "C" => 100, "L" => 50, "X" => 10, "V" => 5, "I" => 1 );
  my $dernier=1;
 
  foreach (@elements) {
    if ($valeurs{$_} < $dernier) { $nombre-=$valeurs{$_}; }
    else { $nombre+=$valeurs{$_}; }
    $dernier=$valeurs{$_};
  }
 
  return $nombre;
}

Et une petite démonstration vite faite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
print "1994 = ".romain(1994)."\n";
print "2948 = ".romain(2948)."\n";
print "1398 = ".romain(1398)."\n";
print "1835 = ".romain(1835)."\n";
print "1970 = ".romain(1970)."\n";
print "-----------------------------------\n";
print "MCMXCIV = ".arabe("MCMXCIV")."\n";
print "MMCMXLVIII = ".arabe("MMCMXLVIII")."\n";
print "MCCCXCVIII = ".arabe("MCCCXCVIII")."\n";
print "MDCCCXXXV = ".arabe("MDCCCXXXV")."\n";
print "MCMLXX = ".arabe("MCMLXX")."\n";

Nota bene : Avec les chiffres romains, il n'est pas prévu de dépasser 4998 (?). Le comportement de ces fonctions est alors assez indéfini ...

**Jedai** · 25/11/2004, 22h51

Un idiome pratique pour ignorer des valeurs dans une affectation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
my (undef, $seconde_valeur, undef, $quatrieme_valeur) = @tableau ;

--
Jedaï

**Jeh** · 22/12/2004, 15h07

Lister le contenu d'un répertoire et ses sous-répertoires :
VERSION UNIX :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
#!/usr/bin/perl
 
use strict;
my $nb_arg = @ARGV;
if (($nb_arg > 1) or ($nb_arg <1)) {
    print "\nNombre d'arguments incorrect.";
    exit(1);
}
 
my $dir = $ARGV[0];
 
ListRep($dir);
 
sub ListRep {
    my ($dir) = @_;
    if (! -e $dir ) {
      print "Répertoire inconnu ($dir).";
      return undef;
     }
 
     if (! -d $dir ) {
      print "$dir n'est pas un répertoire.";
      return undef;
     }
 
     if (! opendir( DIR, $dir) ) {
      print "Impossible d'ouvrir le répertoire $dir : $!.";
      return undef;
     }
 
     my @files = grep !/(?:^\.$)|(?:^\.\.$)/, readdir DIR;
     closedir DIR;
     print "\nFICHIERS CONTENUS:\n";
     foreach(@files) {
        print $_."\n";
     }
     foreach(@files) {       
        if (-d $dir."/".$_) {
            print "\n\nREPERTOIRE : ".$_."\n";
            ListRep($dir."/".$_);
        }
     } 
 
}
 
1;

VERSION WINDOWS: changer le dernier 'foreach' par celui-ci.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
     foreach(@files) {       
        if (-d $dir."\\".$_) {
            print "\n\nREPERTOIRE : ".$_."\n";
            ListRep($dir."\\".$_);
        }
     }

**djibril** · 09/03/2005, 01h14

ma petite contribution!
voici un script permettant de passer d'un fichier csv ou txt à un fichier excel.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
 
#!/usr/bin/perl -w
 
#######################################################################
#Ce script permet de transformer un fichier txt ou csv en fichier excel.
# - Si c'est un fichier csv donner en argumant le fichier csv
# Ex script.pl fichier.csv
#
# - Si c'est un fichier txt donner en argument le fichier txt et
# preciser le separateur dans le script ligne 29 ou modifier la ligne 54
# Ex: script.pl fichier.txt 
######################################################################
use strict;
use Carp;
use Spreadsheet::WriteExcel;	#module pour creer des fichiers excel
 
my $nbr_argument = @ARGV;	#recupere le nombre fichiers entres en argument
unless( $nbr_argument == 1) {print "trop de fichiers donnes en argument\n"; exit; }
my $separateur;			#le separateur
my $fichier_a_transformer = $ARGV[0];
 
my $fichier_excel = $fichier_a_transformer;
    #si c'est un fichier csv
    if ($fichier_a_transformer =~ /\.csv$/i){
      $fichier_excel =~ s/(.+)\.csv$/$1\.xls/gi;
      $separateur = ",";		#le separateur est une virgule
    } 
    else {
      #si c'est un fichier txt	
      $fichier_excel =~ s/(.+)\.txt$/$1\.xls/gi;
      $separateur = ",";		#le separateur est à préciser      
     }
 
    # Creer une page excel ayant pour le même nom que le fichier txt
    my $workbook = Spreadsheet::WriteExcel->new($fichier_excel) || die "impossible de creer $fichier_excel ou fichier ouvert";
 
    # nom de la feuille
    my $worksheet = $workbook->add_worksheet("feuille1");
 
    #  Definition d'un format d'ecriture
    my $format = $workbook->add_format();  #creation du format
    $format->set_bold();		#caractere en gras
    $format->set_align('center');	#caracteres centres
 
    # recuperer les donnees du fichier txt et mise dans le fichier excel
    my $colonne_excel = 0;
    my $ligne_excel = 0;
    my $ligne;
    my @tab_ligne;
    my $last_case;
 
    open (FILE, "$fichier_a_transformer") || die ("impossible de d'ouvrir $fichier_a_transformer $!");
    while ($ligne = <FILE>) {
      chomp($ligne);			#suppression des retour à la ligne
      @tab_ligne = split ($separateur, $ligne);
      $last_case = $#tab_ligne;		#dernier index du tableau
      for ($colonne_excel = 0; $colonne_excel<= $last_case; $colonne_excel++) {
      	#remplissage du fichier excel
        $worksheet->write($ligne_excel, $colonne_excel, $tab_ligne[$colonne_excel], $format);	
      } 
      $colonne_excel = 0;		#reinitialise la colonne à 0      
      $ligne_excel++;			#on passe a la ligne suivante dans le fichier excel
    }
    close (FILE);

voilà

**siaoly** · 14/03/2005, 10h59

Voici un script permettant entre autre de coder de latin1 a utf-8

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
#!/usr/local/bin/perl
 
use strict;
use Unicode::String qw(latin1 utf8);	# conversion latin1 <-> utf8
use MIME::Base64;
 
 
{
  my ($ligne, $CN, @table, $Parametre, $Retour, $Oid, $Pos);
  die "Erreur de syntaxe. Il faut passer le nom de fichier LDIF em parametre." if ($#ARGV != 0);
  die "Impossible d'ouvrir le fichier $ARGV[0]" if (!open (FICLDIF, "<$ARGV[0]"));
  while ($ligne = <FICLDIF>)
  {
    chomp($ligne);
    $Pos = index($ligne, ": ");
    if ($Pos)
    {
      $Oid = substr($ligne, 0, $Pos);
      $Parametre = substr($ligne, $Pos + 2);
      $Retour = $Parametre;
 
      if (&EncodeUTF8_64($Retour))     # c'est encode
      {
        $ligne = $Oid . ":: " . $Retour;
      }
    }
    print "$ligne\n";
  }
}
 
# **************************************************************************************
# fonction EncodeUTF8-64
# encode en utf8 puis MIME 64 l'argument passé en paramètre si celui-ci n'est pas
#     ASCII pur
# retourne 1 si encodage, 0 sinon
# **************************************************************************************
sub EncodeUTF8_64
{
  my $temp;
  $temp = latin1($_[0])->utf8;
  return 0 if ($temp eq $_[0]);     # y a pas de modif
  $_[0] = encode_base64($temp, "");
#  chomp $_[0];
  return 1;
}
 
# **************************************************************************************
# fonction EncodeUTF8
# encode en utf8 l'argument passé en paramètre si celui-ci n'est pas ASCII pur
# retourne 1 si encodage, 0 sinon
# **************************************************************************************
sub EncodeUTF8
{
  my $temp;
  $temp = latin1($_[0])->utf8;
  return 0 if ($temp =~ /$_[0]/);     # y a pas de modif
  $_[0] = $temp;
  return 1;
}
 
;

**cryptorchild** · 14/03/2005, 20h03

Moi je suis nouveau sur le forum voici ma petite participation pour le moment !

Ce programme sert a retourner la date du jour au format JJ/MM/AA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
                 sub afficher_date
                 {
                 (@date);
                              ($an,$jour,$mois)=('','','');
                              @date=gmtime(time());
                              if (length($date[5]) == 2) {if ($date[5]>70) {$an='19';}  else{$an='20';}
                               }
                              if (length($date[5]) == 3) {$date[5]=$date[5]+1900; }
                              if (length($date[5]) == 4) { }
                              $an.=$date[5];
                              $jour=$date[3];
                              if (length($jour) == 1) {$jour='0'.$jour}
                              $mois=$date[4];
                              $mois++;
                              if (length($mois) == 1) {$mois='0'.$mois}
                               return ("$jour/$mois/$an");
                        }

**djibril** · 14/03/2005, 21h01

encore plus simple pour date (jour/mois/annee, hh:min:sec)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
#!/usr/bin/perl 
use strict;
use Carp;
&date_h_j();
sub date_h_j{
my @tab_date =localtime(time);
my $jour = $tab_date[3];
my $mois = ($tab_date[4]+1);
my $annee =  ($tab_date[5]+1900);
my $heure = $tab_date[2];
my $minute = $tab_date[1];
my $sec= $tab_date[0];
 
print "$jour/$mois/$annee, $heure:$minute:$sec\n";
}

**mhooreman** · 27/09/2006, 14h14

Je veux récupérer les lignes d'un fichier qui commencent par TDR, et trier avec comme clé les 10 caractères à partir du 32eme.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

cat file | perl -nle 'push @r,$_;}{print foreach (sort {substr($a,32,10) cmp substr($b,32,10)} @r)' > file.filtered_and_sorted

Remarque: le }{ apres le push correspond à l'opérateur "secret" "baiser eskimo":

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

a}{b

est équivalent à

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

END{b}a

**Mr6** · 15/03/2005, 07h43

Plus long, mais assez pratique, tjrs dans les dates

Les 4 lignes repérées par #A supprimer pour faire un package peuvent être dégagées si on veut mettre la fonction ds un package, perso, c comme ca ke je l'utilise.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 
#!/usr/bin/perl 
use strict;
 
#package mon_package; # Enlever le commentaire pour déclarer le package
 
my @WEEK_DAYS = ('Dimanche', 'Lundi', 'Mardi', 'Mercredi', 'Jeudi', 'Vendredi', 'Samedi');
my @MONTHS    = ('Janvier','F&eacute;vrier','Mars','Avril','Mai','Juin','Juillet','Ao&ucirc;t','Septembre','Octobre','Novembre','D&eacute;cembre');
 
my $time = time; #optionel                                       #A supprimer pour faire un package
my $sql_date = conv_date($time, '%sql');                  #A supprimer pour faire un package
my $date_normale = conv_date($time, '%d %B %Y'); #A supprimer pour faire un package
my $heure = conv_date($time, '%X');                        #A supprimer pour faire un package
 
 
sub conv_date {
	my($time, $format) = @_;
	if (! $time)   { $time = time; }
	if (! $format) { $format = '%D' }
	my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($time);
	my $full_en_text_date = localtime($time);
	$mon++;
	my $yearl = $year + 1900;
	if ($year > 99) { $year -= 100; }
	my $short_mon  = substr($MONTHS[$mon - 1],  0, 3);
	my $short_wday = substr($WEEK_DAYS[$wday], 0, 3);
	my $mdayl = sprintf('%02d', $mday);
	my $monl  = sprintf('%02d', $mon);
	$sec   = sprintf('%02d', $sec);
	$min   = sprintf('%02d', $min);
	$hour  = sprintf('%02d', $hour);
	$year  = sprintf('%02d', $year);
 
	$_ = $format;
	s/%%/%/g;
	s/%sql/$yearl-$monl-$mdayl/g;
	s/%a/$short_wday/g;
	s/%A/$WEEK_DAYS[$wday]/g;
	s/%b|%h/$short_mon/g;
	s/%B/$MONTHS[$mon-1]/g;
	s/%c/$full_en_text_date/g;
	s/%d/$mdayl/g;
	s/%D|%x/$monl\/$mday\/$year/g;
	s/%e/$mday/g;
	s/%m/$monl/g;
	s/%H/$hour/g;
	s/%j/$yday/g;
	s/%M/$min/g;
	s/%S/$sec/g;
	s/%n/\n/g;
	s/%t/\t/g;
	s/%X|%T/$hour:$min:$sec/g;
	s/%y/$year/g;
	s/%Y/$yearl/g;
	return $_;
}

@+
Mr6

Scripts ou codes gratuits et disponibles pour tous en Perl [Sources]

Langage Perl

Vue hybride

Discussions similaires

Partager

Partager