Des codes sources perlConsultez toutes les FAQ

#!/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 File::Spec;

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

  # On récupère tous les fichiers
  my @fichiers;
  foreach my $nom (@fic_rep) {
    my $notre_ficrephier = File::Spec->catdir( $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é
    }
  }
  return @fichiers;
}

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

#!/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"; }
}

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

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

#!/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:/');

#!/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 $!");

#!/usr/bin/perl
use strict;
use warnings;

my $repertoire_vide = "./rep1";
rmdir($repertoire);

#!/usr/bin/perl
use strict;
use warnings;
use File::Path;
my $repertoire1 = "./rep1";
rmtree([$repertoire1, 1, 1);

#!/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);

#!/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";

#!/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";

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/", "")

#!/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.

#!/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__

#!/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);

#!/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__

#!/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__

#!/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

#!/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;
}

#!/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;

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

#!/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"