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

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

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, 19h04

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;
}

@ ++

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

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, 19h16

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, 12h52

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, 12h54

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, 16h02

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, 16h46

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 !

@ ++

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

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, 23h51

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, 16h07

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, 02h14

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, 11h59

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, 21h03

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, 22h01

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";
}

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

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

**nematoad** · 15/03/2005, 15h21

Envoyé par GLDavid

(...)

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;

Le truc avec $mtime, ça n'a pas l'air de grande chose. D'ailleurs, si un snippet est censé être court, on peut remplacer tout ça par :

Code :

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

1
2
 
    @ficpl = glob( "$repertoire/*.pl" );

De nos jours, glob marche tout à fait bien sous Windows et ailleurs. Ça ne génère plus de sous-processes inefficaces.

**djibril** · 23/03/2005, 01h59

rajout sur le parcour recursif de repertoire.
Ce script donne l'adresse complet d'un fichier ou repertoire cherché.
Vous lui précisé un repertoire racine, et il parcours le repertoire et tous les sous repertoires, tres pratique.
exemple :

Code :

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

1
2
3
4
5
 
toto.pl gene
                 =>C:/Documents and Settings/perl/gene.tgz
                 =>C:/Documents and Settings/perl/files/gene.xml
                 =>repertoire : C:/Documents and Settings/gene

voilà le script, faut juste mettre le chemin d'un repertoire dans son script
dans $mon_dir

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
 
#!/usr/bin/perl -w 
 
#---------------------------------------------- 
# 
# ce script permet de parcourir un repertoire
# et affiche le chemin du fichier cherché. ou
# repertoire: nom du repertoire s'il en trouve
# -----------------------------------------------
 
 
use strict; 
use Carp; 
 
my $file = $ARGV[0];		#donne un bout de nom
my $mon_dir = "C:/Documents and Settings/Propriétaire/Mes documents/apprendre_progammation/perl";
&premier_repertoire($mon_dir, $file);
 
 
sub premier_repertoire {
	my $mon_rep = shift;
	my $file = shift;
	opendir (REP,$mon_rep) or die "Impossible d'ouvrir $mon_rep";
	my @dots = grep { /^\w+/ } readdir(REP);
	foreach  my $nom (@dots) {
	  &verification($nom, $mon_rep, $file); #recursivité et parcours du repertoire trouvé
	}
	closedir (REP);
}
sub verification { 
    my $dir = shift;
    my $mon_rep = shift;
    my $file = shift;
    my $repertoire = "$mon_rep/$dir";
     if ( -d $repertoire && $repertoire !~ /^\.*$/) {
       if ( $repertoire =~ /$file/i) { 
	 print "repertoire : $repertoire\n";
       }
       &premier_repertoire($repertoire, $file);
     }
     if ( -e "$mon_rep/$dir" && -f "$mon_rep/$dir") { 
      	my $nom_fichier = $dir;
	if ($nom_fichier =~ /$file/i) {
  	  print "$mon_rep/$dir"."\n";    	#on peut recuperer le fichier pour autre traitement
     	}
     }  
}

**Jedai** · 24/03/2005, 22h32

Notez bien que les snippets sont censés être utiles, pas de simples exercices de programmation : le code ci-dessus n'a donc pas vraiment sa place ici car find ou le module correspondant fait la même chose en mieux et plus rapide... Bien que le code en lui-même soit intéressant pour sa valeur pédagogique.

--
Jedaï

**GLDavid** · 16/04/2005, 14h29

Pour la conversion de fichiers ASCII ISO-8859-1 vers 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
 
#!/usr/bin/perl -w
 
use strict; 
use Unicode::String;
 
###########################################
#
#	2UTF8.pl
#	________
#
#Pour la conversion de fichiers ISO-8859-1
#vers UTF-8
#INPUT : un fichier ASCII ISO-8859-1
#OUTPUT : un fichier ASCII UTF-8
###########################################
 
Unicode::String->stringify_as('utf8');
my($file) = $ARGV[0];
my($file_dest) = $file.".new";
open FILE, "< $file" or die "$!\n";
open FILE2, "> $file_dest" or die "$!\n";
while(<FILE>){
	$_ = Unicode::String::latin1($_);
	print FILE2 $_;
}
close FILE and close FILE2;
unlink $file;
rename($file_dest, $file);
unlink $file_dest;