#!/usr/bin/env perl # Déclaration des pragmas use strict; use utf8; use open qw/:std :utf8/; # Appel des modules externes de base use Encode qw(decode_utf8 encode_utf8 is_utf8); use Getopt::Long; my ($programme) = $0 =~ m|^(?:.*/)?(.+)|; my $usage = "Usage : \n" . " $programme -r répertoire [ -e expression_régulière ] [ -l log ] [ -s ] \n" . " $programme -f fichier [ -e expression_régulière ] [ -l log ] [ -s ] \n" . " $programme -h \n"; my $version = "1.5.3"; my $dateModif = "28 Septembre 2018"; # Variables nécessaires pour les options my $aide = undef; my $expression = undef; my $fichier = undef; my $log = undef; my $motif = undef; my $nombre = undef; # my $pdf = undef; my $repertoire = undef; my $supprime = 0; # integre les options que l'on peut donner en lancant le programme eval { $SIG{__WARN__} = sub {usage(1);}; GetOptions( "expression=s" => \$expression, "fichier=s" => \$fichier, "help" => \$aide, "log=s" => \$log, "motif=s" => \$motif, "nombre=i" => \$nombre, # "pdf" => \$pdf, "repertoire=s" => \$repertoire, "supprime" => \$supprime, ); }; $SIG{__WARN__} = sub {warn $_[0];}; if ( $aide ) { print "\nProgramme : \n"; print " “$programme”, version $version ($dateModif)\n"; print " Outil qui permet d'extraire le fichier XML éditeur d’une \n"; print " archive ZIP et de le renommer pour lui donner la même racine \n"; print " que le document auquel il fait référence. Il travaille sur \n"; print " un fichier ou sur un répertoire de fichiers “.zip”. \n\n"; print "$usage\n"; print "Options : \n"; print " -e indique l’expression régulière (compatible Perl) à utiliser \n"; print " pour identifier le fichier XML éditeur dans l’archive “.zip” \n"; print " (à mettre entre simples ou doubles quotes) \n"; # print " le fichier XML éditeur dans l’archive “.zip” \n"; print " -f donne le nom du fichier “.zip” contenant le fichier XML éditeur \n"; print " à extraire \n"; print " -h affiche cette aide \n"; print " -l indique le nom du fichier “log” où le programme écrit les \n"; print " messages d’erreur ou autres (N.B. : ce fichier n’est pas \n"; print " écrasé lorsque l’on relance le programme) \n"; print " -r indique le nom du répertoire où se trouvent les fichiers \n"; print " “.zip” d’où doivent être extraits les fichiers XML éditeurs \n"; print " -s supprime le fichier “.zip” si le fichier XML a été extrait \n"; print " avec succès \n\n"; print "Exemples : \n"; print " $programme -r Arthropodes -l logExtraitXml.txt \n"; print " $programme -f Arthropodes/arthropodes_000125.zip -e '\\.article' \n"; print " \n"; exit 0; } usage(2) if not $repertoire and not $fichier; if ( $expression ) { $expression = qr/$expression/; } if ( $log ) { if ( -f $log ) { open(LOG, ">>:utf8", $log) or die "$!,"; } else { open(LOG, ">:utf8", $log) or die "$!,"; } my @time = localtime(); my $jour = (qw(Dimanche Lundi Mardi Mercredi Jeudi Vendredi Samedi))[$time[6]]; my $mois = (qw(Janvier Février Mars Avril Mai juin Juillet Août Septembre Octobre Novembre Décembre))[$time[4]]; my $annee = $time[5] + 1900; my $date = "$jour $time[3] $mois $annee "; $date .= sprintf("%02d:%02d:%02D", $time[2], $time[1], $time[0]); if ( $repertoire ) { print LOG "\n===> $repertoire <=== $date\n\n"; } elsif ( $fichier ) { print LOG " - $fichier : $date\n"; } } else { open(LOG, ">&STDERR") or die "$!,"; } if ( $repertoire ) { if ( not -d $repertoire ) { print STDERR "Erreur : répertoire \"$repertoire\" absent\n"; exit 3; } my @restant = (); if ( defined $nombre ) { if ($nombre < 1 ) { print STDERR "Erreur : le nombre de fichier doit être un entier positif\n"; exit 4; } foreach my $valeur (1 .. $nombre) { $restant[$valeur] = 1; } } opendir(DIR, $repertoire) or die "$!,"; my @fichiers = (); if ( defined $motif ) { @fichiers = sort grep(/^${motif}_?\d+\.zip\z/, readdir DIR); } else { @fichiers = sort grep(/^.+\.zip\z/, readdir DIR); } closedir DIR; foreach my $fichier (@fichiers) { my $base = ""; my $valeur = ""; if ( defined $motif ) { ($base, $valeur) = $fichier =~ /^(${motif}_?(\d+))\.zip/o; $restant[$valeur] = 0; } elsif ( $fichier =~ /^([0-9A-F]{40})\.zip/o ) { $base = substr($fichier, 0, 40); } elsif ( $fichier =~ /^(.+?_?(\d+))\.zip/o ){ ($base, $valeur) = ($1, $2); } else { ($base) = $fichier =~ /^(.+)\.zip/o; } if ( -f "$repertoire/$base.xml" ) { next; } traite($repertoire, $fichier, $base); } if ( defined $nombre ) { my $absent = 0; foreach my $valeur (1 .. $nombre) { if ( $restant[$valeur] ) { $absent ++; print LOG "Pas de fichier ZIP pour document n° $valeur\n"; } } if ( $absent ) { print LOG "Total : $absent fichiers ZIP absents\n"; } } } elsif ( $fichier ) { my ($chemin, $nom, $base) = $fichier =~ m|^(.*/)?((.+)\.[Zz][Ii][Pp])|o; $chemin = "." if not $chemin; traite($chemin, $nom, $base); } exit 0; sub usage { my $code = shift; print STDERR "\n$usage"; exit $code; } sub erreur { my ($message, $code) = @_; print LOG "$message\n"; exit $code; } sub traite { my ($directory, $file, $base) = @_; my @pdf = (); my @xml = (); my $type = 0; open(INP, "unzip -l $directory/$file 2>&1 |") or die "$!,"; while(<INP>) { s/^\s+//o; s/[\n\r]+//o; if ( /\.pdf\s*$/io ) { my @tmp = split(/\s+/, $_, 4); push(@pdf, $tmp[$#tmp]); erreur("Erreur sur fichier \"$file\"", 5) if $tmp[$#tmp] !~ /\.pdf\z/i; } elsif ( /\.xml\s*$/io ) { my @tmp = split(/\s+/, $_, 4); push(@xml, $tmp[$#tmp]); erreur("Erreur sur fichier \"$file\"", 6) if $tmp[$#tmp] !~ /\.xml\z/i; } elsif ( /\.xml\b/io ) { my @tmp = split(/\s+/, $_, 4); push(@xml, $tmp[$#tmp]); erreur("Erreur sur fichier \"$file\"", 6) if $tmp[$#tmp] !~ /\.xml\b/i; } elsif ( /\.nxml\s*$/io ) { my @tmp = split(/\s+/, $_, 4); push(@xml, $tmp[$#tmp]); erreur("Erreur sur fichier \"$file\"", 6) if $tmp[$#tmp] !~ /\.nxml\z/i; } elsif ( $expression and /$expression\s*$/io ) { my @tmp = split(/\s+/, $_, 4); push(@xml, $tmp[$#tmp]); erreur("Erreur sur fichier \"$file\"", 6) if $tmp[$#tmp] !~ /$expression\z/i; } elsif ( /unzip: +cannot find zipfile directory/o ) { print LOG "Le fichier \"$file\" n'est pas une archive ZIP\n"; $type = 1; last; } elsif ( /: +zipfile is empty/o ) { print LOG "L'archive ZIP \"$file\" est vide\n"; $type = 2; last; } } close INP; return $type if $type; if ( $#pdf > 0 ) { my @tmp = (); foreach my $pdf (@pdf) { my ($debut) = $pdf =~ /^(.+)\.pdf/io; if (grep(/^$debut.xml\z/i, @xml) > 0) { push(@tmp, $pdf); next; } $debut =~ s/pdf/xml/o; if (grep(/^$debut.xml\z/, @xml) > 0) { push(@tmp, $pdf); next } $debut =~ s/PDF/XML/o; if (grep(/^$debut.xml\z/i, @xml) > 0) { push(@tmp, $pdf); next } ($debut) = $pdf =~ m|^(?:.+/)?(.+)\.pdf|io; if (grep(/\b$debut.xml\b/i, @xml) > 0) { push(@tmp, $pdf); } } # Dédoublonnage if ( $#tmp == 0 ) { @pdf = @tmp; } elsif ( $#tmp > 0 ) { print LOG "Attention : PDF multiples pour \"$file\"\n"; return 3; } elsif ( $#xml < 0 or $#xml > 0 ) { print LOG "Attention : cas bizarre pour \"$file\"\n"; return 4; } } if ( $#pdf == 0 ) { my ($debut) = $pdf[0] =~ /^(.+)\.pdf/io; my @cibles = grep(/^$debut.xml\z/i, @xml); if ( $#cibles == 0 ) { my ($racine) = $cibles[0] =~ m|^(?:.*/)?(.+)\.xml\z|io; my $retour = system "unzip -jo \"$directory/$file\" \"$cibles[0]\" > /dev/null"; if ( $retour ) { my $erreur = ($retour - ($retour % 256)) / 256; print "$programme : erreur $erreur d’ \"unzip\" pour fichier \"$file\"\n"; return 5; } if ( -f "$racine.xml" ) { $retour = system "mv \"$racine.xml\" \"$directory/$base.xml\""; efface("$directory/$file") if $supprime and not $retour; } elsif ( -f "$racine.XML" ) { $retour = system "mv \"$racine.XML\" \"$directory/$base.xml\""; efface("$directory/$file") if $supprime and not $retour; } else { print LOG "Erreur : pas de fichier \"$racine.xml\" extrait de \"$file\"\n"; } } else { if ( $debut =~ /\bpdf\b/o ) { $debut =~ s/pdf/xml/o; } if ( $debut =~ /\bPDF\b/o ) { $debut =~ s/PDF/XML/o; } @cibles = grep(/^$debut.xml\z/i, @xml); if ( $#cibles == 0) { my ($racine) = $cibles[0] =~ m|^(?:.*/)?(.+)\.xml\z|o; my $retour = system "unzip -jo \"$directory/$file\" \"$cibles[0]\" > /dev/null"; if ( $retour ) { my $erreur = ($retour - ($retour % 256)) / 256; print "$programme : erreur $erreur d’ \"unzip\" pour fichier \"$file\"\n"; return 5; } if ( -f "$racine.xml" ) { $retour = system "mv \"$racine.xml\" \"$directory/$base.xml\""; efface("$directory/$file") if $supprime and not $retour; } elsif ( -f "$racine.XML" ) { $retour = system "mv \"$racine.XML\" \"$directory/$base.xml\""; efface("$directory/$file") if $supprime and not $retour; } else { print LOG "Erreur : pas de fichier \"$racine.xml\" extrait de \"$file\"\n"; } } elsif ( $#xml == 0 ) { if ( $expression and $xml[0] =~ m|^((?:.*/)?(.*$expression))| ) { my $entree = $1; my $xml = $2; my $retour = system "unzip -jo \"$directory/$file\" \"$entree\" > /dev/null"; if ( $retour ) { my $erreur = ($retour - ($retour % 256)) / 256; print "$programme : erreur $erreur d’ \"unzip\" pour fichier \"$file\"\n"; return 5; } if ( -f "$xml" ) { $retour = system "mv \"$xml\" \"$directory/$base.xml\""; efface("$directory/$file") if $supprime and not $retour; } else { print LOG "Erreur : pas de fichier \"$xml\" extrait de \"$file\"\n"; } } else { my ($entree, $xml) = $xml[0] =~ m|^((?:.*/)?(.+\.n?xml.*))|io; my $retour = system "unzip -jo \"$directory/$file\" \"$entree\" > /dev/null"; if ( $retour ) { my $erreur = ($retour - ($retour % 256)) / 256; print "$programme : erreur $erreur d’ \"unzip\" pour fichier \"$file\"\n"; return 5; } if ( -f "$xml" ) { $retour = system "mv \"$xml\" \"$directory/$base.xml\""; efface("$directory/$file") if $supprime and not $retour; } else { print LOG "Erreur : pas de fichier \"$xml\" extrait de \"$file\"\n"; } } } else { print LOG "Pas de XML \"$debut.xml\" pour \"$file\"\n"; } } } elsif ( $#xml == 0 ) { my ($entree, $xml) = $xml[0] =~ m|^((?:.*/)?(.+\.xml))|; my $retour = system "unzip -jo \"$directory/$file\" \"$entree\" > /dev/null"; if ( $retour ) { my $erreur = ($retour - ($retour % 256)) / 256; print "$programme : erreur $erreur d’ \"unzip\" pour fichier \"$file\"\n"; return 5; } if ( -f "$xml" ) { $retour = system "mv \"$xml\" \"$directory/$base.xml\""; efface("$directory/$file") if $supprime and not $retour; } else { print LOG "Erreur : pas de fichier \"$xml\" extrait de \"$file\"\n"; } } elsif ( $#pdf > 0 ) { print LOG "Attention : encore des PDF multiples pour \"$file\"\n"; } else { print LOG "Attention : autre cas bizarre pour \"$file\"\n"; } return 0; } sub efface { my $cible = shift; my $rc = unlink $cible; if ( not $rc ) { print LOG "Erreur : impossible de supprimer le fichier \"$cible\"\n"; } }