On pourrait écrire
#!/usr/bin/perl -w
use strict;
use Tk;
use Tk::ProgressBar;
my $fichier_source = '';
my $fichier_destination = '';
my $pourcentage = 0 ;
my $main ;
sub usage {
print "Usage: $0 fichier_source fichier_destination\n";
exit 1 ;
}
if ($#ARGV == -1 || $#ARGV >2) {
usage() ;
}
$fichier_source = $ARGV[0];
$fichier_destination = $ARGV[1];
cre_main_tk() ;
sub cre_main_tk {
$main =MainWindow->new(-title =>'cp graphique');
$main ->geometry( '250x20' );
my $progress = $main->ProgressBar(-length => 200,
-from => 0,
-to => 100,
-blocks => 10,
-colors => [0, 'green', 50, 'yellow' ,70,'orange', 80, 'red'],
-variable => \$pourcentage
);
$progress->pack( -padx=>5, -pady=>5, -fill=>'x' );
my $bouton=$main -> Button( -text => "Copier", -command => \&copie_fichier() )-> pack;
MainLoop ;
}
sub copie_fichier {
if ( ! open(SCE, $fichier_source) ) {
die "Impossible d'ouvrir $fichier_source:$!:\n" ;
}
my $taille = (stat(SCE))[7] ;
my $cpt = 0 ;
my $nb_octets = 0 ;
my $tampon ;
my $p = -1 ;
if ( ! open(DEST, ">$fichier_destination")) {
die "Impossible de créer $fichier_destination:$!:\n" ;
}
while ($nb_octets = sysread(SCE, $tampon, 10240)) {
$cpt += $nb_octets ;
$pourcentage = int(($cpt/$taille)*100) ;
# print "coucou:$cpt:$pourcentage:\n" ;
if ( $p != $pourcentage ) {
$main->update() ;
$p = $pourcentage ;
}
syswrite(DEST, $tampon, $nb_octets) ;
}
close(SCE) ;
close(DEST);
exit ;
}
Il reste à voir si les messages d'erreur doivent être envoyés en graphique, s'il faut un message graphique à la fin du traitement.
Il reste à prévoir un bouton <Annuler>.
Il reste à prévoir une syntaxe fic_sce1 fic_sce2 .... rep_dest, une syntaxe -r pour une copie récursive.
Bref, on peut faire encore beaucoup plus de choses qu'avec cet exemple trivial.