Projet

Général

Profil

Perl script : extracting some columns from a .maple file » hz_colMaple.pl

Julien Troufflard, 12/03/2015 11:10

 
#!/usr/bin/perl
#!/usr/local/bin/perl
use strict;
use Math::Trig;
use English;
#####use Regexp::Common;#expressions regulieres; par exemples pour reconnaitre un entier $RE{num}{int} ou un reel $RE{num}{real}
use File::Basename;
#nom de ce script
my $NOM_PROG = basename $PROGRAM_NAME;
#expression reguliere pour reconnaitre un nombre reel (on aurait pu aussi utiliser le package Regexp::Common, mais a la date du 12/03/2015, ce package etait non disponible sur les machines linux de la salle de calcul)
my $format_reel = '[+-]?[\.]?\d+[\.]?\d*(?:[eE][+-]?\d*)?';



my $VERSION = '1.01';
#################################################################################################
# script pour extraire des colonnes d un fichier .maple #
# version 1 : version initiale #
# version 1.01 : introduction de la variable $format_reel au lieu d utiliser le package #
# Regexp::Common (car non disponible sur linux a la date du 12/03/2015) #
#################################################################################################














sub affichage_aide {
use Text::Wrap;
#config du package Text::Wrap
$Text::Wrap::columns = 80;#le nombre de caracteres maximum par ligne sera egal a ($Text::Wrap::columns - 1) dans le cas ou utilise wrap

#indentation pour l affichage de Usage 2
my $indent_Usage2 = ""; $indent_Usage2 .= " " for(1 .. length(" > $NOM_PROG "));

print "\n";
print "-----------------------------------------------\n";
print " script $NOM_PROG (version 1.0)\n";
print "-----------------------------------------------\n";
print "\n";
print "But : extraire une ou plusieurs colonnes d un fichier de sortie Herezh++\n";
print " au format maple\n";
print "\n";
print "Usage 1 : mode interactif\n";
print " > $NOM_PROG\n";
print "Usage 2 : lancement avec arguments\n";
print wrap(" ",$indent_Usage2, "> $NOM_PROG [-h|help] [-v] fmaple_ini no_col1 [no_col2 .. no_colN] [fmaple_new]\n");
print "\n";
print "Arguments :\n";
print " o fmaple_ini : fichier .maple original\n";
print " o no_col_1 [no_col2 .. no_colN] : liste des numeros de colonnes a extraire\n";
print " format : > nombre entier (exemple : 1)\n";
print " > plage de colonnes (exemple : 3-6)\n";
print " o [fmaple_new] : fichier de sortie (par defaut : affichage dans le terminal)\n";
print "\n";
print "Options :\n";
print " -v : affichage du numero de version\n";
print "\n";
print "Exemples avec arguments :\n";
print " o sortir les colonnes 1 4 et 6 7 8 9 du fichier calcul_princ.maple\n";
print " dans le fichier resu.txt :\n";
print " > $NOM_PROG calcul_princ.maple 1 4 6-9 resu.txt\n";
print " o sortir les colonnes 1 et 9 du fichier calcul_princ.maple\n";
print " dans le terminal :\n";
print " > $NOM_PROG calcul_princ.maple 1 9\n";
print "\n";
print "Auteur :\n";
print " TROUFFLARD Julien\n";
print " julien.troufflard\@univ-ubs.fr\n";
print " julien.troufflard\@free.fr\n";
print "--------------------------------\n";
exit;
}

#------------------------------------
#option -h ou -help => affichage de l aide
#------------------------------------
# rq : insensible a la casse
foreach my $arg (@ARGV) {
if(($arg =~ /^-h$/i) or ($arg =~ /^-help$/i)) {
affichage_aide();
}
}

#------------------------------------
#option -v => affichage de la version
#------------------------------------
foreach my $arg (@ARGV) {
if($arg eq '-v') {
print "\n $NOM_PROG : version $VERSION\n\n";
exit;
}
}



#----------------------------------
#saisie du fichier maple original
#----------------------------------
my $fmaple_ini;
#cas avec arguments
if($#ARGV > -1) {$fmaple_ini = shift(@ARGV);}
#cas mode interactif
else {
$fmaple_ini = -1;
while($fmaple_ini eq '-1') {
print "\nNom du fichier maple original ? ";
$fmaple_ini = <STDIN>; chomp($fmaple_ini);
}
}
#verif de l existence du fichier
(-e $fmaple_ini) or die "\nErreur (prog:$NOM_PROG) : fichier $fmaple_ini introuvable ...\n\n";
#verif de l ouverture
open(FIC, "<$fmaple_ini") or die "\nErreur (prog:$NOM_PROG) : impossible d ouvrir fichier $fmaple_ini ...\n\n"; close(FIC);


#----------------------------------
#saisie des numeros de colonnes
#----------------------------------
my @no_colonnes;
#cas avec arguments
if($#ARGV > -1) {
foreach my $arg (@ARGV) {
#cas d un numero de colonne simple
push(@no_colonnes, $1) if($arg =~ /^(\d+)$/);
#cas d une plage de colonnes
push(@no_colonnes, ($1 .. $2)) if($arg =~ /^(\d+)-(\d+)$/);
}
}
#cas mode interactif
else {
print "\nSaisie de la liste des colonnes :\n";
print " - par de simples nombres entiers (exemple : 12)\n";
print " - par une plage de colonnes (exemple : 3-6)\n";
print " (taper liste pour afficher la liste actuelle)\n";
my $choix = -1;
SAISIE_COL:while() {
print " > saisie (f pour finir) : ";
$choix = <STDIN>; chomp($choix);
$choix =~ s/^\s+//; $choix =~ s/\s+$//;

#on traite la saisie en separant par rapport aux espaces pour gerer le cas ou l utilisateur donne plusieurs saisies sur une meme ligne
foreach my $val (split(/\s+/, $choix)) {
#cas d un numero de colonne simple
push(@no_colonnes, $1) if($val =~ /^(\d+)$/);
#cas d une plage de colonnes
push(@no_colonnes, ($1 .. $2)) if($val =~ /^(\d+)-(\d+)$/);
#cas du mot liste => affichage de la liste actuelle
print " Liste actuelle :\n @no_colonnes\n\n" if($val eq 'liste');
#cas de la lettre f => fin de la saisie
last SAISIE_COL if($val eq 'f');
}
}
}
#verif de la presence d au moins une colonne a extraire
($#no_colonnes > -1) or die "\nErreur (prog:$NOM_PROG) : aucun numero de colonne n a ete specifie ...\n\n";


#--------------------------
#verification des colonnes
# methode : on regarde la premiere ligne de donnees du fichier original et on y verifie la presence des colonnes demandees
#
# remarque : on aurait pu faire cette verif au moment de l ecriture des colonnes, mais en le faisant ici, on evite de creer
# inutilement le nouveau fichier en cas de colonne absente
#--------------------------
my @colonnes_inexistantes;
open(FIC, "<$fmaple_ini");
while(<FIC>) {
next if(/^\s*\#/);
next if(not /^\s*$format_reel/);
s/^\s+//; s/\s+$//;
my @val = split(/\s+/, $_);
foreach my $col (@no_colonnes) {
push(@colonnes_inexistantes, $col) if(not defined($val[$col-1]));
}
last;
}
close(FIC);
#pas de colonnes absentes, sinon erreur
($#colonnes_inexistantes == -1) or die "\nErreur (prog:$NOM_PROG) : les colonnes suivantes n existent pas dans le fichier $fmaple_ini : @colonnes_inexistantes ...\n\n";


#-------------------------------------
#saisie du fichier eventuel de sortie
#-------------------------------------
# rq : en mode arguments : le fichier de sortie sera ecrase automatiquement si il existe deja
# en mode interactif : on demande a l utilisateur si il veut ecraser un fichier deja existant
my $fmaple_new = "";

#cas avec arguments
if($#ARGV > -1) {
#on suppose que le fichier de sortie est le dernier argument, a moins que ce ne soit un numero de colonne
$fmaple_new = $ARGV[$#ARGV] unless($ARGV[$#ARGV] =~ /^\d+$/ or $ARGV[$#ARGV] =~ /^\d+-\d+$/);
}
#cas mode interactif
else {
print "\nSaisie du fichier de sortie (taper entree pour une sortie dans le terminal) :\n";
print " Nom du fichier a creer : ";
$fmaple_new = <STDIN>; chomp($fmaple_new);

#cas ou le fichier existe deja (on demande en boucle jusqu a ce que le nom ne corresponde pas a un fichier existant ou que l utilisateur veut bien effacer l existant)
while() {
last if(not -e $fmaple_new);#fin si le fichier n existe pas

print "Le fichier de sortie $fmaple_new existe deja :\n";
my $choix = -1;
while($choix ne 'o' and $choix ne 'n') {
print " Voulez-vous l effacer ? (o/n) ";
$choix = <STDIN>; chomp($choix);
}
last if($choix eq 'o');#fin si l utilisateur veut ecraser le fichier existant

print " Donner un autre nom de fichier : ";
$fmaple_new = <STDIN>; chomp($fmaple_new);
}
}

#Handle d affichage pour la commande print ...
my $Handle;
#...vers un fichier si il a ete defini
if($fmaple_new ne "") { open($Handle, ">$fmaple_new"); }
#sinon, vers le terminal
else { $Handle = *STDOUT; }


#-------------------------------------
#ecriture de l en-tete
#-------------------------------------
print $Handle "#Fichier original : $fmaple_ini\n";
print $Handle "#\n";
print $Handle "#Correspondance avec les colonnes du fichier original :\n";
for(my $i=1; $i<=($#no_colonnes + 1); $i++) {
print $Handle "# col $i => $no_colonnes[$i-1]\n";
}
print $Handle "#\n";
print $Handle "\n";

#-------------------------------------
#ecriture des colonnes
#-------------------------------------
open(FIC, "<$fmaple_ini");
while(<FIC>) {
next if(/^\s*\#/);
next if(not /^\s*$format_reel/);
s/^\s+//; s/\s+$//;
my @val = split(/\s+/, $_);
print $Handle "$val[ $no_colonnes[0]-1 ]";
for(my $i=1; $i<=$#no_colonnes; $i++) {
print $Handle " $val[ $no_colonnes[$i]-1 ]";
}
print $Handle "\n";
}
close(FIC);


#fin du programme si l ecriture se fait dans le terminal
exit if(not defined($fmaple_new));
#fermeture du fichier
close($Handle);
print "\nLe fichier $fmaple_new a ete cree ...\n\n";
    (1-1/1)
    Redmine Appliance - Powered by TurnKey Linux