Publicité
Discussion fermée
Page 1 sur 6 12345 ... DernièreDernière
Affichage des résultats 1 à 20 sur 113
  1. #1
    Responsable Perl et Outils

    Avatar de djibril
    Homme Profil pro
    Inscrit en
    avril 2004
    Messages
    16 545
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : avril 2004
    Messages : 16 545
    Points : 465 274
    Points
    465 274

    Par défaut Scripts ou codes gratuits et disponibles pour tous en Perl

    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 :
    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
      0  0

  2. #2
    Expert Confirmé
    Avatar de GLDavid
    Inscrit en
    janvier 2003
    Messages
    2 684
    Détails du profil
    Informations personnelles :
    Âge : 37

    Informations forums :
    Inscription : janvier 2003
    Messages : 2 684
    Points : 2 626
    Points
    2 626

    Par défaut

    Obtenir un chemin relatif à partir d'un chemin absolu :
    Code :
    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;
    }
    @ ++
      0  0

  3. #3
    Expert Confirmé
    Avatar de GLDavid
    Inscrit en
    janvier 2003
    Messages
    2 684
    Détails du profil
    Informations personnelles :
    Âge : 37

    Informations forums :
    Inscription : janvier 2003
    Messages : 2 684
    Points : 2 626
    Points
    2 626

    Par défaut

    Effectuer une connexion FTP :
    Code :
    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 !";
    	}
    }
      0  0

  4. #4
    Expert Confirmé
    Avatar de 2Eurocents
    Inscrit en
    septembre 2004
    Messages
    2 177
    Détails du profil
    Informations personnelles :
    Âge : 44

    Informations forums :
    Inscription : septembre 2004
    Messages : 2 177
    Points : 2 845
    Points
    2 845

    Par défaut Conversion de listes exotiques en hachages tropicaux :-)

    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 :
    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 ...
      0  0

  5. #5
    Membre émérite
    Inscrit en
    février 2003
    Messages
    1 116
    Détails du profil
    Informations forums :
    Inscription : février 2003
    Messages : 1 116
    Points : 980
    Points
    980

    Par défaut

    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 :
    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.
      0  0

  6. #6
    Membre émérite
    Inscrit en
    février 2003
    Messages
    1 116
    Détails du profil
    Informations forums :
    Inscription : février 2003
    Messages : 1 116
    Points : 980
    Points
    980

    Par défaut

    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 :
    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.
      0  0

  7. #7
    Expert Confirmé
    Avatar de 2Eurocents
    Inscrit en
    septembre 2004
    Messages
    2 177
    Détails du profil
    Informations personnelles :
    Âge : 44

    Informations forums :
    Inscription : septembre 2004
    Messages : 2 177
    Points : 2 845
    Points
    2 845

    Par défaut

    Pour le formatage de date et heures, je m'étais forgé ça :
    Code :
    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 :
    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é ...
      0  0

  8. #8
    Expert Confirmé
    Avatar de GLDavid
    Inscrit en
    janvier 2003
    Messages
    2 684
    Détails du profil
    Informations personnelles :
    Âge : 37

    Informations forums :
    Inscription : janvier 2003
    Messages : 2 684
    Points : 2 626
    Points
    2 626

    Par défaut

    Un truc tout simple car j'ai encore vu un post à ce sujet : comment écrire dans un fichier :
    Code :
    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 !

    @ ++
      0  0

  9. #9
    Expert Confirmé
    Avatar de 2Eurocents
    Inscrit en
    septembre 2004
    Messages
    2 177
    Détails du profil
    Informations personnelles :
    Âge : 44

    Informations forums :
    Inscription : septembre 2004
    Messages : 2 177
    Points : 2 845
    Points
    2 845

    Par défaut Les chiffres romains ...

    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 :
    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 :
    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 ...
      0  0

  10. #10
    Expert Confirmé Sénior
    Avatar de Jedai
    Homme Profil pro
    Enseignant
    Inscrit en
    avril 2003
    Messages
    6 168
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Côte d'Or (Bourgogne)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : avril 2003
    Messages : 6 168
    Points : 7 663
    Points
    7 663

    Par défaut

    Un idiome pratique pour ignorer des valeurs dans une affectation :
    Code :
    1
    2
     
    my (undef, $seconde_valeur, undef, $quatrieme_valeur) = @tableau ;


    --
    Jedaï
      0  0

  11. #11
    Jeh
    Jeh est déconnecté
    Membre confirmé Avatar de Jeh
    Profil pro
    Inscrit en
    septembre 2003
    Messages
    203
    Détails du profil
    Informations personnelles :
    Âge : 32
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations forums :
    Inscription : septembre 2003
    Messages : 203
    Points : 215
    Points
    215

    Par défaut ma petite contribution

    Lister le contenu d'un répertoire et ses sous-répertoires :
    VERSION UNIX :
    Code :
    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 :
    1
    2
    3
    4
    5
    6
    7
     
         foreach(@files) {       
            if (-d $dir."\\".$_) {
                print "\n\nREPERTOIRE : ".$_."\n";
                ListRep($dir."\\".$_);
            }
         }
    Verre vide je te plains, verre plein, je te vide.
      0  0

  12. #12
    Responsable Perl et Outils

    Avatar de djibril
    Homme Profil pro
    Inscrit en
    avril 2004
    Messages
    16 545
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : avril 2004
    Messages : 16 545
    Points : 465 274
    Points
    465 274

    Par défaut

    ma petite contribution!
    voici un script permettant de passer d'un fichier csv ou txt à un fichier excel.
    Code :
    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à

    Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
      1  0

  13. #13
    Membre à l'essai
    Inscrit en
    janvier 2005
    Messages
    73
    Détails du profil
    Informations forums :
    Inscription : janvier 2005
    Messages : 73
    Points : 22
    Points
    22

    Par défaut

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


    Code :
    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;
    }
     
    ;
      0  0

  14. #14
    Candidat au titre de Membre du Club
    Inscrit en
    mars 2005
    Messages
    74
    Détails du profil
    Informations forums :
    Inscription : mars 2005
    Messages : 74
    Points : 12
    Points
    12

    Par défaut

    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 :
    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");
                            }
      0  0

  15. #15
    Responsable Perl et Outils

    Avatar de djibril
    Homme Profil pro
    Inscrit en
    avril 2004
    Messages
    16 545
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : avril 2004
    Messages : 16 545
    Points : 465 274
    Points
    465 274

    Par défaut

    encore plus simple pour date (jour/mois/annee, hh:min:sec)
    Code :
    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";
    }

    Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
      0  0

  16. #16
    Mr6
    Mr6 est déconnecté
    Membre chevronné

    Homme Profil pro
    Inscrit en
    septembre 2004
    Messages
    603
    Détails du profil
    Informations personnelles :
    Sexe : Homme

    Informations professionnelles :
    Secteur : Service public

    Informations forums :
    Inscription : septembre 2004
    Messages : 603
    Points : 691
    Points
    691

    Par défaut

    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 :
    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
      0  0

  17. #17
    Membre actif
    Inscrit en
    février 2005
    Messages
    167
    Détails du profil
    Informations forums :
    Inscription : février 2005
    Messages : 167
    Points : 184
    Points
    184

    Par défaut Re: Snippets

    Citation Envoyé par GLDavid

    (...)

    Lister dans un tableau les fichiers pl d'un répertoire :

    Code :
    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 :
    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.
      0  0

  18. #18
    Responsable Perl et Outils

    Avatar de djibril
    Homme Profil pro
    Inscrit en
    avril 2004
    Messages
    16 545
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : avril 2004
    Messages : 16 545
    Points : 465 274
    Points
    465 274

    Par défaut

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

    Pas de questions technique par messagerie privée (lisez les règles du forum Perl) et pour les nouveaux !
      0  0

  19. #19
    Expert Confirmé Sénior
    Avatar de Jedai
    Homme Profil pro
    Enseignant
    Inscrit en
    avril 2003
    Messages
    6 168
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Côte d'Or (Bourgogne)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : avril 2003
    Messages : 6 168
    Points : 7 663
    Points
    7 663

    Par défaut

    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ï
      0  0

  20. #20
    Expert Confirmé
    Avatar de GLDavid
    Inscrit en
    janvier 2003
    Messages
    2 684
    Détails du profil
    Informations personnelles :
    Âge : 37

    Informations forums :
    Inscription : janvier 2003
    Messages : 2 684
    Points : 2 626
    Points
    2 626

    Par défaut

    Pour la conversion de fichiers ASCII ISO-8859-1 vers UTF-8 :
    Code :
    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;
    Particulièrement utile quand vous importez un fichier d'un OS ISO-8859-1 vers un OS UTF-8 (ex : WinXP -> Ubuntu Hoary) .

    @++
    GLDavid
    Consultez la FAQ Perl ainsi que mes cours de Perl.
    N'oubliez pas les balises code ni le tag

    Je ne répond à aucune question technique par MP.
      0  0

Liens sociaux

Règles de messages

  • Vous ne pouvez pas créer de nouvelles discussions
  • Vous ne pouvez pas envoyer des réponses
  • Vous ne pouvez pas envoyer des pièces jointes
  • Vous ne pouvez pas modifier vos messages
  •