FAQ PerlConsultez toutes les FAQ

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
#!/usr/bin/perl 
use warnings; 
use strict; 
  
my $repertoire = 'C:\tmp'; 
foreach my $rep ( lister_repertoires( $repertoire, 1 ) ) { 
  print "Rep : $rep\n"; 
} 
  
#====================================================== 
# Nombre d'arguments : 1 ou 2 
# Argument(s)        : un répertoire et valeur 0 ou 1 
# Retourne           : Tableau de répertoires (@repertoires) 
#====================================================== 
sub lister_repertoires { 
  my ( $repertoire, $recursivite ) = @_; 
  
  require Cwd; 
  require File::Spec; 
  
  my $cwd = Cwd::getcwd(); 
  
  # Recherche dans les sous-répertoires ou non 
  if ( ( not defined $recursivite ) || ( $recursivite != 1 ) ) { $recursivite = 0; } 
  
  # Verification répertoire 
  if ( not defined $repertoire ) { die "Aucun repertoire de specifie\n"; } 
  
  # Ouverture d'un répertoire 
  opendir my $fh_rep, $repertoire or die "impossible d'ouvrir le répertoire $repertoire\n"; 
  
  # Liste fichiers et répertoire sauf (. et ..) 
  my @fic_rep = grep { !/^\.\.?$/ } readdir $fh_rep; 
  
  # Fermeture du répertoire 
  closedir $fh_rep or die "Impossible de fermer le répertoire $repertoire\n"; 
  
  chdir $repertoire; 
  $repertoire = Cwd::getcwd(); 
  
  # On récupère tous les répertoires 
  my @repertoires; 
  foreach my $nom (@fic_rep) { 
    my $notre_repertoire = File::Spec->catdir( $repertoire, $nom ); 
  
    if ( -d $notre_repertoire and $recursivite == 0 ) { 
      push @repertoires, $notre_repertoire; 
    } 
    elsif ( -d $notre_repertoire and $recursivite == 1 ) { 
      push @repertoires, $notre_repertoire; 
      push @repertoires, lister_repertoires($notre_repertoire, $recursivite);    # recursivité 
    } 
  } 
  
  chdir $cwd; 
  
  return @repertoires; 
}

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
#!/usr/bin/perl 
use warnings; 
use strict; 
  
my $repertoire = 'C:/tmp'; 
foreach my $fichier ( lister_fichiers( $repertoire, 1 ) ) { 
  print "Fichier : $fichier\n"; 
} 
  
#====================================================== 
# Nombre d'arguments : 1 ou 2 
# Argument(s)        : un répertoire et valeur 0 ou 1 
# Retourne           : Tableau de fichier (@fichiers) 
#====================================================== 
sub lister_fichiers { 
  my ( $repertoire, $recursivite ) = @_; 
  
  require Cwd; 
  require File::Spec; 
  
  my $cwd = Cwd::getcwd(); 
  
  # Recherche dans les sous-répertoires ou non 
  if ( ( not defined $recursivite ) || ( $recursivite != 1 ) ) { $recursivite = 0; } 
  
  # Verification répertoire 
  if ( not defined $repertoire ) { die "Aucun repertoire de specifie\n"; } 
  
  # Ouverture d'un répertoire 
  opendir my $fh_rep, $repertoire or die "impossible d'ouvrir le répertoire $repertoire\n"; 
  
  # Liste fichiers et répertoire sauf (. et ..) 
  my @fic_rep = grep { !/^\.\.?$/ } readdir $fh_rep; 
  
  # Fermeture du répertoire 
  closedir $fh_rep or die "Impossible de fermer le répertoire $repertoire\n"; 
  
  chdir $repertoire; 
  $repertoire = Cwd::getcwd(); 
  
  # On récupère tous les fichiers 
  my @fichiers; 
  foreach my $nom (@fic_rep) { 
    my $notre_fichier = File::Spec->catfile( $repertoire, $nom ); 
  
    if ( -f $notre_fichier ) { 
      push @fichiers, $notre_fichier; 
    } 
    elsif ( -d $notre_fichier and $recursivite == 1 ) { 
      push @fichiers, lister_fichiers($notre_fichier, $recursivite);    # recursivité 
    } 
  } 
  
  chdir $cwd; 
  
  return @fichiers; 
}

1
2
3
4
5
Fichier : C:\tmp\.metadata\.log 
Fichier : C:\tmp\.metadata\.plugins\org.eclipse.core.runtime\.settings\com.sneda.pgi.application.prefs 
Fichier : C:\tmp\.metadata\.plugins\org.eclipse.core.runtime\.settings\org.eclipse.ui.prefs 
Fichier : C:\tmp\.metadata\.plugins\org.eclipse.ui.workbench\dialog_settings.xml 
Fichier : C:\tmp\.metadata\.plugins\org.eclipse.ui.workbench\workbench.xml

1
2
3
4
5
6
7
8
9
10
#!/usr/bin/perl 
use warnings; 
use strict; 
use File::Find; 
  
find( { wanted => \&process, }, 'C:/tmp' ); 
  
sub process { 
  if ( -f $File::Find::name ) { print "File::Find : $File::Find::name\n"; } 
}

1
2
3
4
5
File::Find : C:\tmp\.metadata\.log 
File::Find : C:\tmp\.metadata\.plugins\org.eclipse.core.runtime\.settings\com.sneda.pgi.application.prefs 
File::Find : C:\tmp\.metadata\.plugins\org.eclipse.core.runtime\.settings\org.eclipse.ui.prefs 
File::Find : C:\tmp\.metadata\.plugins\org.eclipse.ui.workbench\dialog_settings.xml 
File::Find : C:\tmp\.metadata\.plugins\org.eclipse.ui.workbench\workbench.xml

1
2
3
4
5
6
7
#!/usr/bin/perl 
use strict; 
use warnings; 
  
my $repertoire     = 'C:/repertoire'; 
my $nom_fichier    = 'fichier.txt'; 
my $chemin_fichier = $repertoire . '/' . $nom_fichier;

1
2
3
4
5
6
7
#!/usr/bin/perl 
use strict; 
use warnings; 
  
my $repertoire     = 'C:\repertoire'; 
my $nom_fichier    = 'fichier.txt'; 
my $chemin_fichier = $repertoire . '\' . $nom_fichier;

1
2
3
4
5
6
7
8
9
10
11
12
#!/usr/bin/perl 
use strict; 
use warnings; 
use File::Spec; 
  
my $repertoire     = 'C:\repertoire'; 
my $nom_fichier    = 'fichier.txt'; 
my $chemin_fichier = File::Spec->catfile($repertoire, $nom_fichier); 
print $repertoire,"\n"; 
  
my $chemin_repertoire = File::Spec->catdir('\test', 'tmp', 'dossier'); 
print $chemin_repertoire,"\n";

1
2
C:\repertoire 
\test\tmp\dossier

1
2
C:/repertoire 
/test/tmp/dossier

1
2
3
4
5
6
#!/usr/bin/perl 
use strict; 
use warnings; 
use File::Copy; 
# Pour renommer un fichier toto.txt en tutu.txt 
rename("toto.txt","tutu.txt");

1
2
3
4
5
6
7
8
9
10
11
12
13
14
#!/usr/bin/perl 
use strict; 
use warnings; 
use File::Copy; 
my $fichier1 = "toto.txt"; 
my $fichier2 = "tutu.txt"; 
# Copie le fichier dans le même répertoire avec un nouveau nom 
copy($fichier1,$fichier2); 
  
# copie le fichier dans un autre répertoire avec un nom différent 
copy($fichier1,'C:/tata.txt'); 
  
# copie le fichier dans un autre répertoire avec le même nom 
copy($fichier1,'C:/');

1
2
3
4
5
6
7
#!/usr/bin/perl 
use strict; 
use warnings; 
use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove); 
my $repertoire1 = "./rep1"; 
my $repertoire2 = "./rep2"; 
dircopy($repertoire1,$repertoire2) or die("Impossible de copier $repertoire1 $!");

1
2
3
4
5
6
#!/usr/bin/perl 
use strict; 
use warnings; 
  
my $repertoire_vide = "./rep1"; 
rmdir($repertoire);

1
2
3
4
5
6
7
#!/usr/bin/perl 
use strict; 
use warnings; 
use File::Path; 
my $repertoire1 = "./rep1"; 
rmtree([$repertoire1], 1, 1); 
# rmtree([$repertoire1, $repertoire2, $repertoire3], 1, 1);

1
2
3
4
5
6
7
8
9
10
11
#!/usr/bin/perl 
use strict; 
use warnings; 
use File::Temp qw/ tempfile /; 
  
# Création d'un fichier temporaire qui sera supprimé une fois le script terminé. 
# N'oubliez pas les 4 XXXX, perl créera un fichier avec à la place des X des caractères aléatoires. 
my ($fh_temp, $file_temp) = tempfile("fichier_temporaireXXXX", UNLINK => 1);  
  
# Fermeture du fichier temporaire 
close($fh_temp);

1
2
3
4
5
6
7
8
9
#!/usr/bin/perl 
use strict; 
use warnings; 
my $fichier = "C:\\Documents and Settings\\djibril\\fichier_faqperl.txt"; 
#ou my $fichier = "C:/Documents and Settings/djibril/fichier_faqperl.txt"; 
#ou my $fichier = "/home/djibril/fichier_faqperl.txt"; 
  
my ($repertoire,$nom_fichier) = $fichier =~ /(.+[\/\\])([^\/\\]+)$/; 
print "($repertoire,$nom_fichier)\n";

1
2
3
4
5
6
7
8
9
10
11
#!/usr/bin/perl 
use strict; 
use warnings; 
use File::Basename; 
my $fichier = "C:\\Documents and Settings\\djibril\\fichier_faqperl.txt"; 
#ou my $fichier = "C:/Documents and Settings/djibril/fichier_faqperl.txt"; 
#ou my $fichier = "/home/djibril/fichier_faqperl.txt"; 
  
my $repertoire = dirname($fichier); 
my $nom_fichier = basename($fichier); 
print "($repertoire,$nom_fichier)\n";

1
2
3
4
5
6
7
8
my ($filename, $directories, $suffix) = fileparse($path); 
my($filename, $directories, $suffix) = fileparse($path, @suffixes); 
my $filename                         = fileparse($path, @suffixes);  
  
fileparse("/foo/bar/baz.txt", qr/\.[^.]*/); # On Unix returns ("baz", "/foo/bar", ".txt") 
fileparse("/foo/bar/baz");                  # On Unix returns ("baz", "/foo/bar/", "") 
fileparse("C:/foo/bar/baz"); 				# On Windows returns ("baz", "C:/foo\bar/", "") 
fileparse("/foo/bar/baz/"); 				# On Unix returns ("", "/foo/bar/baz/", "")

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
#!/usr/bin/perl 
use strict; 
use warnings; 
  
# on récupère l'argument 
my $nom_fichier = shift; 
  
# on vérifie si le fichier existe 
die "Ce fichier <$nom_fichier> n'existe pas (ou n'est pas un vrai fichier)." 
   if -f $nom_fichier; 
  
# on commence par ouvrir le fichier en lecture 
open my($fichier), '<', $nom_fichier 
   or die "Ce fichier $nom_fichier n'a pu être ouvert : $!\n"; 
  
# on place le contenu dans un tableau de ligne 
my @lignes = <$fichier>; 
  
# on referme le fichier 
close $fichier; 
  
# on modifie la 3e ligne 
chomp( $lignes[2] ); 
$lignes[2] .= ", et Bob était là.\n"; 
  
# on rouvre le fichier en écriture en écrasant le contenu 
open my($fichier), '>', $nom_fichier 
   or die "Ce fichier $nom_fichier n'a pu être ouvert : $!\n"; 
  
# et on réécrit le contenu modifié 
print $fichier @lignes; 
  
close $fichier 
  
__END__ 
On a fini.

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
#!/usr/bin/perl 
use strict; 
use warnings; 
  
use File::Copy qw(move); 
use File::Temp; 
  
# on crée une fonction qui prend un bloc et un nom de fichier en paramètre 
# et exécute le bloc à chaque ligne du fichier : 
# dans le bloc $_ vaut la ligne courante, et toute modification de $_ 
# est reflétée sur la ligne dans le fichier 
sub modify_in_place (&$); 
  
my $filename = shift; 
  
# $. vaut le numéro de ligne dans le fichier qu'on est en train de lire 
modify_in_place { s/$/, et Bob était là./ if $. == 3 } $filename; 
  
sub modify_in_place (&$) { 
    my $block    = shift; 
    my $filename = shift; 
    local $_; 
    open my ($file), '<', $filename 
      or die "This file $filename couldn't be opened : $!\n"; 
  
    # on utilise File::Temp pour créer un fichier temporaire en toute sécurité 
    my $tempfile = new File::Temp(); 
  
    while (<$file>) { 
        $block->(); 
        print $tempfile $_; 
    } 
    close $file; 
    close $tempfile; 
    move "$tempfile", $filename 
      or die "We couldn't overwrite $filename with $tempfile : $!\n"; 
} 
  
__END__

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
#!/usr/bin/perl 
use strict; 
use warnings; 
use File::Temp; 
  
# creation du fichier temporaire 
my ($fh_temp, $file_temp)  
    = tempfile( "fichier_temporaireXXXX", UNLINK => 1); 
  
# Ouverture du fichier à modifier        
open (my $fh, '<', $file) or die "Can't open $file : $!\n"; 
  
# declaration d'un compteur 
my $compteur = 0; 
  
# Lecture du fichier ligne à ligne 
while(my $ligne = <$fh>) { 
  $compteur ++; 
  chomp ($ligne); 
  # modification de la ligne 
  if ($compteur == 3) { 
    $ligne = $ligne.", et Bob était là."; 
  } 
  # ecriture dans le fichier temporaire 
  print {$fh_temp} "$ligne\n"; 
} 
close($fh_temp); 
close($fh); 
  
# copie du fichier temporaire 
rename($file_temp,$file);

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
#!/usr/bin/perl 
use strict; 
use warnings; 
  
use Tie::File; 
  
my $filename = shift; 
  
# @lines représente maintenant les lignes du fichier 
# $object est l'objet de classe Tie::File sous-jacent 
# sur lequel on peut appeler les méthodes de Tie::File 
my $object = tie my (@lines), 'Tie::File', $filename 
  or die "We couldn't tie $filename to an array in readwrite mode : $!\n"; 
  
$lines[2] .= ', et Bob était là.'; 
  
# ces deux lignes (undef et untie) sont l'équivalent d'un close() 
# dans notre cas 
undef $object; 
# cette ligne suffit si on n'a pas récupéré $object (par exemple 
# dans ce script on aurait pu s'en passer) 
untie @lines; 
  
__END__

1
2
3
4
5
6
7
8
9
10
11
12
#!/usr/bin/perl 
use strict; 
use warnings; 
  
use Tie::File; 
  
my $filename = shift; 
  
tie my (@lines), 'Tie::File', $filename 
  or die "We couldn't tie $filename to an array in readwrite mode : $!\n"; 
$lines[2] .= ', et Bob était là.'; 
__END__

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
#!/usr/bin/perl 
use warnings; 
use strict; 
use Carp; 
  
# declaration des fichiers 
# mon fichier à traiter 
my $fichier_initial = "mon_fichier.txt"; 
# le fichier modifie que je cree 
my $fichier_modifie = "fichier_modifie.txt"; 
  
# appel de la procedure: - en entree: mon fichier à traiter 
#- en sortie: mon fichier modifie 
traite_fichier($fichier_initial, $fichier_modifie); 
  
# procedure qui permet de rendre les fichiers compatibles unix/windows 
sub traite_fichier { 
  # passage des parametres $fichier <- $fichier_initial 
  #$fichier_modif <- $fichier_modifie 
  my ($fichier, $fichier_modif) = @_; 
  
  # lecture du fichier initial 
  open ( my $FhLecture, '<', $fichier) || die ("pb d'ouverture du fichier $fichier $! ");  
  # ecriture du fichier modifie 
  open ( my $FhEcriture, '>', $fichier_modif) || die ("pb d'ecriture dans le fichier $fichier_modif $! "); 
  while (my $ligne = <$FhLecture>){ 
    # remplacement des retours chariots! 
    $ligne =~ s/\r\n?/\n/g; 
    print {$FhEcriture} $case; 
  } 
  close ($FhLecture); 
  close ($FhEcriture); 
}

perl -pi.bak -e "s/\r\n/\n/" toto.txt

perl -pi -e "s/\r\n/\n/" toto.txt

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
#!/usr/bin/perl 
use strict; 
use warnings; 
  
TransposerFichier('tabule.txt','transpose.txt'); 
  
#============================================ 
# TransposerFichier 
# Transposer un fichier tabule 
#============================================ 
sub TransposerFichier { 
  my ( $FichierTabuleOriginal, $FichierTranspose ) = @_; 
  
  my %HashTranspose; 
  
  # Lecture du fichier tabule 
  open( my $FH, '<', $FichierTabuleOriginal )  
    or die("Impossible de lire le fichier $FichierTabuleOriginal\n"); 
  
  while ( my $Line = <$FH> ) { 
    chomp $Line; 
    my @data = split( /\t/, $Line ); 
    for ( my $i = 0; $i < scalar(@data); $i++ ) { 
      $HashTranspose{$i} .= $data[$i] . "\t"; 
    } 
  } 
  close($FH); 
  
  # Création du fichier transpose 
  open( my $FHTranpose, '>', $FichierTranspose )  
    or die("Impossible de creer le fichier $FichierTranspose\n"); 
  
  foreach ( sort { $a <=> $b } keys %HashTranspose ) { 
    $HashTranspose{$_} =~ s{\t$}{}; 
    print {$FHTranpose} "$HashTranspose{$_}\n"; 
  } 
  close($FHTranpose); 
  
  return $FichierTranspose; 
}

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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
#!/usr/bin/perl 
use warnings; 
use strict; 
  
my %Arguments = ( 
  -fichier    => "/chemin/vers/fichier.xls",    # notre fichier excel 
  -type       => "csv",                         # ou txt, ou autre 
  -separateur => ";",                           # ou "\t" , "|", ... au choix 
  -repertoire => "/autre/repertoire",           # par defaut, repertoire fichier.xls 
  -feuilles   => 1,                             # ou 0 => demande confirmation 
); 
my $fichier = ExcelToCsvTxt( \%Arguments ); 
  
#============================================================================ 
# But       : Convertit un fichier excel en txt, csv ou autre fichier plat 
# Arguement : Une référence de hash 
# Retourne  : fichier txt ou csv 
# Necessite : Spreadsheet::ParseExcel, Spreadsheet::XLSX et File::Basename 
#============================================================================ 
sub ExcelToCsvTxt { 
  my $RefArgument = shift; 
  
  my $FichierXls = $RefArgument->{-fichier}; 
  my $Type       = $RefArgument->{-type}; 
  my $Repertoire = $RefArgument->{-repertoire}; 
  my $Separateur = $RefArgument->{-separateur}; 
  my $feuilles   = $RefArgument->{-feuilles}; 
  $feuilles = 1 unless defined $feuilles; 
  
  # vérification du fichier 
  unless ( defined $FichierXls and $FichierXls =~ /\.xlsx?$/i ) { 
    die <<'USAGE'; 
        my %Arguments = ( 
          -fichier    => "/chemin/vers/fichier.xls",    # notre fichier excel 
          -type       => "csv",                         # ou txt, ou autre 
          -separateur => ";",                           # ou "\t" , "|", ... au choix 
          -repertoire => "/autre/repertoire",           # par defaut, repertoire fichier.xls 
          -feuilles   => 1,                             # ou 0 => demande confirmation 
        ); 
        my $fichier = ExcelToCsvTxt( \%Arguments ); 
  
USAGE 
  } 
  
  # vérification du type de conversion voulu 
  unless ( defined $Type and $Type =~ m{^csv|txt$}i ) { 
    $Type = 'txt'; 
  } 
  
  require File::Basename; 
  
  # vérification du type de conversion voulu 
  unless ( defined $Repertoire and -d $Repertoire ) { 
    $Repertoire = File::Basename::dirname($FichierXls); 
  } 
  
  # Nouveau fichier 
  my (@FileParse) = File::Basename::fileparse( $FichierXls, qr/\.[^.]*/ ); 
  my $FichierTxtCsv = $Repertoire . '/' . $FileParse[0] . ".$Type"; 
  
  # On verifie si c'est un fichier excel version 2007 ou plus ancien 
  my $ExcelObj; 
  if ( $FichierXls =~ m{\.xls$}i ) { 
    require Spreadsheet::ParseExcel; 
    $ExcelObj = Spreadsheet::ParseExcel::Workbook->Parse($FichierXls) 
      or die("Impossible de lire le fichier $FichierXls\n"); 
  } 
  else { 
    require Spreadsheet::XLSX; 
    $ExcelObj = Spreadsheet::XLSX->new($FichierXls) 
      or die("Impossible de lire le fichier $FichierXls\n"); 
  } 
  
  # Nombre de feuilles dans le fichier excel 
  my $NbrFeuilles = scalar @{ $ExcelObj->{Worksheet} }; 
  
  # Création du fichier final 
  open( my $fh, '>', $FichierTxtCsv ) 
    or die "impossible de ceer le fichier $FichierTxtCsv\n"; 
  
  my ( $iR, $iC, $ObjetFeuille, $oWkC ); 
  
  foreach my $ObjetFeuille ( @{ $ExcelObj->{Worksheet} } ) { 
  
    if ( $NbrFeuilles > 1 and $feuilles != 1 ) { 
      print "Voulez vous convertir l'onglet '$ObjetFeuille->{Name}' [Y/n] : "; 
      chomp( my $Reponse = <STDIN> ); 
      print "\n"; 
      next if ( defined $Reponse and uc($Reponse) eq 'N' ); 
    } 
  
    # Parcours des lignes 
    for ( 
      my $iR = $ObjetFeuille->{MinRow}; 
      defined $ObjetFeuille->{MaxRow} && $iR <= $ObjetFeuille->{MaxRow}; 
      $iR++ 
      ) 
    { 
  
      # Parcours des colonnes 
      for ( 
        my $iC = $ObjetFeuille->{MinCol}; 
        defined $ObjetFeuille->{MaxCol} && $iC <= $ObjetFeuille->{MaxCol}; 
        $iC++ 
        ) 
      { 
        $oWkC = $ObjetFeuille->{Cells}[$iR][$iC]; 
        if ( defined $oWkC ) { 
          print {$fh} $oWkC->Value, $Separateur; 
        } 
        else { 
          print {$fh} $Separateur; 
        } 
      } 
      print {$fh} "\n"; 
    } 
  } 
  close($fh); 
  
  return $FichierTxtCsv; 
}

print {$fh} $oWkC->Value, $Separateur;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
value() 
 
The value() method returns the formatted value of the cell. 
 
    my $value = $cell->value(); 
 
Formatted in this sense refers to the numeric format of the cell value.  
For example a number such as 40177 might be formatted as 40,117, 40117.000 or even as the date 2009/12/30. 
 
If the cell doesn't contain a numeric format then the formatted and unformatted  
cell values are the same, see the unformatted() method below. 
 
For a defined $cell the value() method will always return a value. 
 
In the case of a cell with formatting but no numeric or string contents  
the method will return the empty string ''.

print {$fh} $oWkC->unformatted, $Separateur;

perl nom_programme.pl -help

perl nom_programme.pl -man

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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
#!/usr/bin/perl 
#=============================================================================== 
# Author :  djibril 
# Date   :  23/02/2011 10:24:10 
# Main   :  Fusionner plusieurs classeurs Excel d'un répertoire en un unique fichier 
#=============================================================================== 
use Carp; 
use strict; 
use warnings; 
  
use Spreadsheet::ParseExcel; 
use Spreadsheet::XLSX; 
use Spreadsheet::WriteExcel; 
use Getopt::Long; 
use Pod::Usage; 
  
my ( $repertoire_excel, $fichier_excel_fusionne ) = (); 
my ( $man, $help ) = ( 0, 0 ); 
  
GetOptions( 
  'repertoire|d=s' => \$repertoire_excel, 
  'output|o=s'     => \$fichier_excel_fusionne, 
  'help|?'         => \$help, 
  'man'            => \$man 
) or pod2usage(2); 
  
pod2usage( -exitstatus => 0, -verbose => 2 ) if ( $man || $help ); 
if ( ( !defined $repertoire_excel or !defined $fichier_excel_fusionne ) ) { 
  pod2usage( { -verbose => 1, -output => \*STDERR } ); 
} 
  
# Lister les fichiers excel d'un répertoire et de ses sous répertoires 
my @fichiers_excel = lister_fichiers($repertoire_excel); 
  
fusionner_fichiers_excel( \@fichiers_excel, $fichier_excel_fusionne ); 
  
# Procédure de fusion excel 
sub fusionner_fichiers_excel { 
  my ( $ref_fichiers_excel, $fichier_excel_final ) = @_; 
  
  print "Creation de $fichier_excel_fusionne\n"; 
  
  # Liste des fichiers excel à fusionner 
  my @les_fichiers_excel = @{$ref_fichiers_excel}; 
  
  # Creation du classeur Excel 
  my $workbook_final = Spreadsheet::WriteExcel->new($fichier_excel_final); 
  
  foreach my $fichier_excel (@les_fichiers_excel) { 
    next unless ( $fichier_excel =~ m{\.xlsx?$}i ); 
  
    # Lecture du fichier Excel 
    print "Lecture du fichier $fichier_excel\n"; 
    my $workbook; 
    if ( $fichier_excel =~ m{\.xls$} ) { 
      my $parser = Spreadsheet::ParseExcel->new(); 
      $workbook = $parser->parse($fichier_excel); 
    } 
    else { 
      $workbook = Spreadsheet::XLSX->new($fichier_excel); 
    } 
  
    if ( !defined $workbook ) { die "Erreur de lecture du fichier $fichier_excel : "; } 
  
    for my $worksheet ( $workbook->worksheets() ) { 
      my ( $row_min, $row_max ) = $worksheet->row_range(); 
      my ( $col_min, $col_max ) = $worksheet->col_range(); 
      next if ( $row_max == 0 and $col_max == 0 ); 
  
      # Création de la feuille 
      my $worksheet_final = $workbook_final->add_worksheet(); 
  
      for my $row ( $row_min .. $row_max ) { 
        for my $col ( $col_min .. $col_max ) { 
  
          my $cell = $worksheet->get_cell( $row, $col ); 
          next unless $cell; 
          $worksheet_final->write( $row, $col, $cell->unformatted() ); 
        } 
      } 
    } 
    print "\n"; 
  
  } 
  $workbook_final->close(); 
  
  return; 
} 
  
#====================================================== 
# Nombre d'arguments : 1 
# Argument(s)        : un répertoire ($repertoire) 
# Retourne           : Tableau de fichier (@fichiers) 
#====================================================== 
sub lister_fichiers { 
  my ($repertoire) = @_; 
  my @fichiers; 
  
  # Ouverture d'un répertoire 
  opendir( my $fh_rep, $repertoire ) 
    or die "impossible d'ouvrir le répertoire $repertoire\n"; 
  
  # Liste fichiers et répertoire sauf (. et ..) 
  my @Contenu = grep { !/^\.\.?$/ } readdir($fh_rep); 
  
  # Fermeture du répertoire 
  closedir($fh_rep); 
  
  # On récupère tous les fichiers 
  foreach my $nom (@Contenu) { 
  
    # Fichiers 
    if ( -f "$repertoire/$nom" ) { 
      push( @fichiers, "$repertoire/$nom" ); 
    } 
  
    # Repertoires 
    elsif ( -d "$repertoire/$nom" ) { 
  
      # recursivité 
      push( @fichiers, lister_fichiers("$repertoire/$nom") ); 
    } 
  } 
  
  return @fichiers; 
} 
  
__END__ 
  
=head1 NAME 
  
    Ce programme permet de fusionner plusieurs classeurs excel (xls et xslx) d'un repertoire en un fichier Excel (xlsx) 
  
    Il copie toutes les feuilles des differents classeurs dans un seul fichier. Le seul inconvenient est qu'il ne garde  
    pas les noms des feuilles mais en genere automatiquement (feuille1, 2, 3, ...) et les formats des cellules ne sont  
    pas conserves, uniquement le contenu des cellules. 
  
=head1 SYNOPSIS 
  
  perl programme_perl.pl -d "C:/REPERTOIRE/EXCEL" -o "fichier_excel_fusionne.xls"

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
#! /usr/bin/perl 
use strict; 
use warnings; 
use POSIX 'strftime'; 
use DateTime; 
  
my ( @infos, %hash, $date, @monthoffile ); 
  
## Affiche la date du jour au format YYYY-MM-DDJHH-MM-SS 
my $mydate = DateTime->now(); 
my @month = split( '-', $mydate ); 
  
##### Liste les fichiers ayant l'extension .txt 
my @list = glob("/dossier/sousdossier/*.txt"); 
  
### recupere le nombre de fichier 
my $numberoffile = scalar(@list); 
  
for ( my $v = 0; $v < $numberoffile; $v++ ) { 
  @infos = stat( $list[$v] );                              ### recupere les informations du fichier en seconde 
  $date = strftime( "%Y-%m-%d", localtime( $infos[9] ) );  #### format l'information du fichier 
  @monthoffile = split( '-', $date );                      #### recupere le mois de la date 
  if ( $month[1] != $monthoffile[1] ) { 
    ### verifie si le mois de creation du fichier est different de celui en cours 
    print $list[$v] . "\n fichier supprime\n"; 
    unlink $list[$v];                                      ### supprime le fichier 
  } 
}

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
#! /usr/bin/perl  
#=============================================================================== 
# Auteur : djibril 
# But    : Supprimer les fichiers en fonction de certains critères 
# - fichiers vieux de plus de X jours 
# - dans certains répertoires à donner en arguments 
# - vous pouvez donner une regex pour cibler les fichiers 
#=============================================================================== 
use strict; 
use warnings; 
use English '-no_match_vars'; 
use Getopt::Long; 
  
my $USAGE = <<"USAGE"; 
  perl $PROGRAM_NAME -d '/chemin/vers/repertoire1' -d '/chemin/vers/repertoire2' -j X   
    -d : permet de spécifier un répertoire ou plusieurs répertoires.  
    -j : donner le nombre de jours à partir duquel les fichiers sont supprimés  
    -p : expression régulière (utile pour matcher des extensions)  
    -r : récursivité  
USAGE 
  
# Récupération des arguments 
my ( @repertoires, $nombre_jours, $regex, $recursivite ) = (); 
GetOptions( 
	'd=s' => \@repertoires, 
	'j=i' => \$nombre_jours, 
	'p=s' => \$regex, 
	'r'   => \$recursivite, 
); 
  
my $time            = time; 
my $seconde_journee = 24 * 3600; 
if ( not defined $nombre_jours or scalar(@repertoires) == 0 ) { 
	print "Options manquantes\n\n$USAGE"; 
	exit; 
} 
if ( not defined $regex ) { $regex = '.'; } 
  
print "Suppression fichiers de plus de $nombre_jours jours\n"; 
foreach my $fichier ( map { lister_fichiers( $_, $recursivite ) } @repertoires ) { 
	my $mtime = ( stat($fichier) )[9]; 
	my $differences_jours = int( ( time - $mtime ) / $seconde_journee ); 
	if ( ( $differences_jours > $nombre_jours ) and ( $fichier =~ m/$regex/ ) ) { 
		print "- $fichier [$differences_jours jours]\n"; 
		unlink $fichier or print "Impossible de supprimer $fichier : $!\n"; 
	} 
} 
  
sub lister_fichiers { 
	my ( $repertoire, $recursivite ) = @_; 
  
	require Cwd; 
	require File::Spec; 
  
	my $cwd = Cwd::getcwd(); 
  
	# Recherche dans les sous répertoire ou non 
	if ( ( not defined $recursivite ) || ( $recursivite != 1 ) ) { $recursivite = 0; } 
  
	# Verification répertoire 
	if ( not defined $repertoire ) { die "Aucun repertoire de specifie\n"; } 
  
	# Ouverture d'un répertoire 
	opendir my $fh_rep, $repertoire or die "impossible d'ouvrir le répertoire $repertoire\n"; 
  
	# Liste fichiers et répertoire sauf (. et ..) 
	my @fic_rep = grep { !/^\.\.?$/ } readdir $fh_rep; 
  
	# Fermeture du répertoire 
	closedir $fh_rep or die "Impossible de fermer le répertoire $repertoire\n"; 
  
	chdir $repertoire; 
	$repertoire = Cwd::getcwd(); 
  
	# On récupère tous les fichiers 
	my @fichiers; 
	foreach my $nom (@fic_rep) { 
		my $notre_ficrephier = File::Spec->catfile( $repertoire, $nom ); 
  
		if ( -f $notre_ficrephier ) { 
			push( @fichiers, $notre_ficrephier ); 
		} 
		elsif ( -d $notre_ficrephier and $recursivite == 1 ) { 
			push( @fichiers, lister_fichiers( $notre_ficrephier, $recursivite ) );    # recursivité 
		} 
	} 
  
	chdir $cwd; 
  
	return @fichiers; 
}

1
2
3
4
5
  perl $PROGRAM_NAME -d '/chemin/vers/repertoire1' -d '/chemin/vers/repertoire2' -j X   
    -d : permet de spécifier un répertoire ou plusieurs répertoires.  
    -j : donner le nombre de jours à partir duquel les fichiers sont supprimés  
    -p : expression régulière (utile pour matcher des extensions)  
    -r : récursivité

perl test.pl -d "C:\logs" -d "C:\data\logs" -j 60 -p "\.txt$"

1
2
3
4
5
6
7
8
9
10
11
12
#!/usr/bin/perl 
use strict; 
use warnings; 
use Win32::Shortcut; 
  
# Trouvons le fichier cible de notre raccourci .lnk 
my $fichier_raccourci = 'C:\Users\Public\Desktop\CCleaner.lnk'; 
my $lien_win32        = Win32::Shortcut->new(); 
$lien_win32->Load($fichier_raccourci); 
print "Raccourci : $fichier_raccourci\n"; 
print "Cible : ", $lien_win32->{'Path'}, "\n"; 
$lien_win32->Close();

1
2
3
4
5
6
7
8
9
10
11
12
13
#!/usr/bin/perl 
use strict; 
use warnings; 
use Win32::Shortcut; 
  
# Création d'un raccourci .lnk à partir d'un fichier quelconque 
my $fichier    = 'C:\DVP\Article_Dvp\script\Perl\zippage.pl'; 
my $lien_win32 = Win32::Shortcut->new(); 
$lien_win32->{'Path'}             = $fichier; 
$lien_win32->{'Description'}      = 'Mon programme Perl'; 
$lien_win32->{'WorkingDirectory'} = 'C:\Users\Public\Desktop'; 
$lien_win32->Save('RaccourciPerl.lnk'); 
$lien_win32->Close();