x-lours has asked for the wisdom of the Perl Monks concerning the following question:
Hello, i use perl v5.12.4 from activeperl
i try a script which copy many distants files (with "pscp" from 'PUTTY' because i can't use ppm at my job) on my disk if the user answers "yes" to a question (using Tkx::tk___messageBox) the script run nearly good and i put some threads, with detach, inside to avoid waiting for some files before asking for the others. but now i got a problem with one file about 108Mo. i got the message "DeleteInterpProc called with active evals" after the loading of this file and the script stop. because of the detach, if i go fast enough, i can get the others files but ... in google, i found some page about "DeleteInterpProc called with active evals" talking over TCL. is there a way to avoid the error ? Thanks in advance for any suggestions and for any comment permiting to go further
x-l_ours
Re: Threads and TCL DeleteInterpProc
by zentara (Archbishop) on Jun 13, 2014 at 09:26 UTC
|
is there a way to avoid the error ? This is just a basic piece of advice when running threads from a gui. Most GUI's are not thread safe, meaning you should not invoke any GUI code BEFORE launching your threads. This is because perl threads copy the entire parent process when they are initiated, and if GUI code
is already in the main code, you get multiple ( often error causing) copies of the gui code in the different threads. Now some GUI toolkits do offer some thread safety, like Gtk2, Gtk3, and others based on the Glib system. I don't know about your gui toolkit, but I would guess it's non-thread-safety the source of the problem. The most reliable way to avoid the issue, is to create all your threads before any GUI code is invoked in your parent, AND do not put any GUI code into your threads.
I only have an example with Tk , but it should show you the idea. See Re: Perl Tk and Threads or you can google for "perl tk thread safety" and get alot of examples.
| [reply] [Watch: Dir/Any] |
|
That is probably too late for Tkx because the interpreter is a global
BEGIN {
$Tcl::STACK_TRACE = 0;
$interp = Tcl->new;
$interp->Init;
}
| [reply] [Watch: Dir/Any] [d/l] |
|
thanks for the path to explore.i will search in this way, in french of course ;-) i don't know much about GUI but in my script i HAVE to alternate between asking user and launching thread if needed.i could try the questions and close the widgets BEFORE launching the threads but not the opposite i will follow the investigation ;-)
| [reply] [Watch: Dir/Any] |
|
i could try the questions and close the widgets BEFORE launching the threads but not the opposite
The idea is to launch as many worker threads as you think you need, right at the beginning, and put them into a sleep loop until you want to wake them. Then make your gui code, and wake up and feed the pre-made threads your command to perform. Finally always program a way so that you can reuse your workers, instead of killing them off and creating new ones.
Just for your education, you can pass strings to your threads to be eval'd, this makes it easy to reuse threads. For example, look at the simple thread code in this example. You can ask your questions at anytime after the threads are formed, and pass in code to be eval'd by the thread, thru a shared variable.
Finally, Gtk2 does have some thread safety built-in, allowing you to make widgets as the threads are formed, but it is full of difficulty to get it right. Even in Gtk2, the advice remains the same, make your threads first, before gui code.
#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
# works on Windows as far as my limited testing goes
my $data = shift || 'date'; #sample code to pass to thread
my %shash;
#share(%shash); #will work only for first level keys
my %hash;
my %workers;
my $numworkers = 3;
foreach my $dthread(1..$numworkers){
share ($shash{$dthread}{'go'});
share ($shash{$dthread}{'progress'});
share ($shash{$dthread}{'timekey'}); #actual instance of the thread
share ($shash{$dthread}{'frame_open'}); #open or close the frame
share ($shash{$dthread}{'handle'});
share ($shash{$dthread}{'data'});
share ($shash{$dthread}{'pid'});
share ($shash{$dthread}{'die'});
$shash{$dthread}{'go'} = 0;
$shash{$dthread}{'progress'} = 0;
$shash{$dthread}{'timekey'} = 0;
$shash{$dthread}{'frame_open'} = 0;
$shash{$dthread}{'handle'} = 0;
$shash{$dthread}{'data'} = $data;
$shash{$dthread}{'pid'} = -1;
$shash{$dthread}{'die'} = 0;
$hash{$dthread}{'thread'} = threads->new(\&work,$dthread);
}
use Tk;
use Tk::Dialog;
my $mw = MainWindow->new(-background => 'gray50');
my $lframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
->pack(-side =>'left' ,-fill=>'y');
my $rframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
->pack(-side =>'right',-fill =>'both' );
my %actives = (); #hash to hold reusable numbered widgets used for d
+ownloads
my @ready = (); #array to hold markers indicating activity is need
+ed
#make 3 reusable downloader widget sets-------------------------
foreach(1..$numworkers){
push @ready, $_;
#frames to hold indicator
$actives{$_}{'frame'} = $rframe->Frame( -background => 'gray50' );
$actives{$_}{'stopbut'} = $actives{$_}{'frame'}->Button(
-text => "Stop Worker $_",
-background => 'lightyellow',
-command => sub { } )->pack( -side => 'left', -padx => 10
+);
$actives{$_}{'label1'} = $actives{$_}{'frame'} ->Label(
-width => 3,
-background => 'black',
-foreground => 'lightgreen',
-textvariable => \$shash{$_}{'progress'},
)->pack( -side => 'left' );
$actives{$_}{'label2'} = $actives{$_}{'frame'} ->Label(
-width => 1,
-text => '%',
-background => 'black',
-foreground => 'lightgreen',
)->pack( -side => 'left' );
$actives{$_}{'label3'} = $actives{$_}{'frame'} ->Label(
-text => '',
-background => 'black',
-foreground => 'skyblue',
)->pack( -side => 'left',-padx =>10 );
}
#--------------------------------------------------
my $button = $lframe->Button(
-text => 'Get a worker',
-background => 'lightgreen',
-command => sub { &get_a_worker(time) }
)->pack( -side => 'top', -anchor => 'n', -fill=>'x', -pady
+=> 20 );
my $text = $rframe->Scrolled("Text",
-scrollbars => 'ose',
-background => 'black',
-foreground => 'lightskyblue',
)->pack(-side =>'top', -anchor =>'n');
my $repeat;
my $startbut;
my $repeaton = 0;
$startbut = $lframe->Button(
-text => 'Start Test Count',
-background => 'hotpink',
-command => sub {
my $count = 0;
$startbut->configure( -state => 'disabled' );
$repeat = $mw->repeat(
100,
sub {
$count++;
$text->insert( 'end', "$count\n" );
$text->see('end');
}
);
$repeaton = 1;
})->pack( -side => 'top', -fill=>'x', -pady => 20);
my $stoptbut = $lframe->Button(
-text => 'Stop Count',
-command => sub {
$repeat->cancel;
$repeaton = 0;
$startbut->configure( -state => 'normal' );
})->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20 )
+;
my $exitbut = $lframe->Button(
-text => 'Exit',
-command => sub {
foreach my $dthread(keys %hash){
$shash{$dthread}{'die'} = 1;
$hash{$dthread}{'thread'}->join
}
if ($repeaton) { $repeat->cancel }
#foreach ( keys %downloads ) {
# #$downloads{$_}{'repeater'}->cancel;
#}
# $mw->destroy;
exit;
})->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20
+ );
#dialog to get file url---------------------
my $dialog = $mw->Dialog(
-background => 'lightyellow',
-title => 'Get File',
-buttons => [ "OK", "Cancel" ]
);
my $hostl = $dialog->add(
'Label',
-text => 'Enter File Url',
-background => 'lightyellow'
)->pack();
my $hostd = $dialog->add(
'Entry',
-width => 100,
-textvariable => '',
-background => 'white'
)->pack();
$dialog->bind( '<Any-Enter>' => sub { $hostd->Tk::focus } );
my $message = $mw->Dialog(
-background => 'lightyellow',
-title => 'ERROR',
-buttons => [ "OK" ]
);
my $messagel = $message->add(
'Label',
-text => ' ',
-background => 'hotpink'
)->pack();
$mw->repeat(10, sub{
if(scalar @ready == $numworkers){return}
foreach my $set(1..$numworkers){
$actives{$set}{'label1'}->
configure(-text =>\$shash{$set}{'progress'});
if(($shash{$set}{'go'} == 0) and
($shash{$set}{'frame_open'} == 1))
{
my $timekey = $shash{$set}{'timekey'};
$workers{ $timekey }{'frame'}->packForget;
$shash{$set}{'frame_open'} = 0;
push @ready, $workers{$timekey}{'setnum'};
if((scalar @ready) == 3)
{ }
$workers{$timekey} = ();
delete $workers{$timekey};
}
}
});
$mw->MainLoop;
###################################################################
sub get_a_worker {
my $timekey = shift;
$hostd->configure( -textvariable => \$data);
if ( $dialog->Show() eq 'Cancel' ) { return }
#----------------------------------------------
#get an available frameset
my $setnum;
if($setnum = shift @ready){print "setnum->$setnum\n"}
else{ print "no setnum available\n"; return}
$workers{$timekey}{'setnum'} = $setnum;
$shash{$setnum}{'timekey'} = $timekey;
$workers{$timekey}{'frame'} = $actives{$setnum}{'frame'};
$workers{$timekey}{'frame'}->pack(-side =>'bottom', -fill => 'both' );
$workers{$timekey}{'stopbut'} = $actives{$setnum}{'stopbut'};
$workers{$timekey}{'stopbut'}->configure(
-command => sub {
$workers{$timekey}{'frame'}->packForget;
$shash{ $workers{$timekey}{'setnum'} }{'go'} = 0;
$shash{ $workers{$timekey}{'setnum'} }{'frame_open'} = 0;
push @ready, $workers{$timekey}{'setnum'};
if((scalar @ready) == $numworkers)
{ }
$workers{$timekey} = ();
delete $workers{$timekey};
});
$workers{$timekey}{'label1'} = $actives{$setnum}{'label1'};
$workers{$timekey}{'label1'}->configure(
-textvariable => \$shash{$setnum}{'progress'},
);
$workers{$timekey}{'label2'} = $actives{$setnum}{'label2'};
$workers{$timekey}{'label3'} = $actives{$setnum}{'label3'};
$workers{$timekey}{'label3'}->configure(-text => $timekey);
$shash{$setnum}{'go'} = 1;
$shash{$setnum}{'frame_open'} = 1;
#--------end of get_file sub--------------------------
}
##################################################################
sub work{
my $dthread = shift;
$|++;
while(1){
if($shash{$dthread}{'die'} == 1){ goto END };
if ( $shash{$dthread}{'go'} == 1 ){
eval( system( $shash{$dthread}{'data'} ) );
foreach my $num (1..100){
$shash{$dthread}{'progress'} = $num;
print "\t" x $dthread,"$dthread->$num\n";
select(undef,undef,undef, .5);
if($shash{$dthread}{'go'} == 0){last}
if($shash{$dthread}{'die'} == 1){ goto END };
}
$shash{$dthread}{'go'} = 0; #turn off self before returning
}else
{ sleep 1 }
}
END:
}
#####################################################################
| [reply] [Watch: Dir/Any] [d/l] |
|
|
Re: Threads and TCL DeleteInterpProc
by InfiniteSilence (Curate) on Jun 12, 2014 at 16:39 UTC
|
| [reply] [Watch: Dir/Any] |
|
the comments are in french ;-) all my code :
#!/usr/bin/perl
######################################################################
+#########
# Auteur : X H
# But : voir le perldoc ...
# ATTENTION : ne pas oublier de rajouter perl devant le nom du script
+pour que les paramètres soient pris en compte
######################################################################
+#########
use warnings;
use strict;
use Data::Dumper;
use Encode; # pour les problèmes d'accent
use Tkx;
use threads;
# http://perl.mines-albi.fr/DocFr/perlthrtut.html
use Thread::Semaphore;
my $semaphore = Thread::Semaphore->new(5); # Crée un sémaphore avec le
+ compteur initialisé à cinq
my @lst_log = (
'sqlload_agents.log',
'sqlload_seg_gestion.log',
# ...
'sqlload_uch.log',
'sqlload_uop.log'
);
# les variables génériques, pour horodater le fichier :
my ($jour, $mois, $annee) = (localtime(time() - (60 * 60 * 24)))[3, 4,
+ 5];
my $date_veille = sprintf("%d%02d%02d",(1900+$annee), ($mois+1), $jour
+);
my ($day, $mon, $year, $hour, $min, $sec) = (localtime)[3, 4, 5, 2, 1,
+ 0];
my $date_fic = sprintf("%d%02d%02d",(1900+$year), ($mon+1), $day);
my $date_mois = sprintf("%d%02d",(1900+$year), ($mon+1));
# sélection du répertoire de version pour stockage des fichiers
my $rep_fichiers = Tkx::tk___chooseDirectory( -title => "Sélection du
+répertoire de la version SPOT IF.",);
exit 9 unless ($rep_fichiers);
# $rep_fichiers = encode( "iso-8859-1",$rep_fichiers);
my $rep_jour = encode( "iso-8859-1","$rep_fichiers/$date_fic");
if (-d $rep_jour) {
$rep_jour = Tkx::tk___chooseDirectory( -title => "Selection du rep
+ertoire ou deposer les fichiers PROD du jour.",);
} else {
# print LOG "Creation du repertoire $rep_jour.\n";
mkdir $rep_jour or die "Probleme creation repertoire $rep_jour E/S
+: $!\n";
my $rep_tmp = "$rep_jour/CSV";
mkdir $rep_tmp or die "Probleme creation repertoire $rep_tmp E/S:
+$!\n";
$rep_tmp = encode( "iso-8859-1","$rep_fichiers/$date_fic/".decode(
+"utf8", "XML Générés"));
# $rep_tmp = "$rep_jour/XML Générés";
mkdir $rep_tmp or die "Probleme creation repertoire $rep_tmp E/S:
+$!\n";
$rep_tmp = encode( "iso-8859-1","$rep_fichiers/$date_fic/".decode(
+"utf8", "Logs Préparateur"));
# $rep_tmp = "$rep_jour/Logs Préparateur";
mkdir $rep_tmp or die "Probleme creation repertoire $rep_tmp E/S:
+$!\n";
}
# attente de l'apparition du fichier
Tkx::tk___messageBox(-message => "Le fichier ARMEN SPO_$date_veille*_T
+.tar.gz est il présent dans le répertoire distant ?\n",
-icon => "question", -title => "Fichier SPO_$dat
+e_veille*_T.Tar.GZ");
# récupération du fichier ARMEN .Tar.GZ dans le répertoire <Date du jo
+ur>.
# my $thr = threads->new(\&recup_fic, 'SPO_*_T.tar.gz', '/transfert/re
+ception', $rep_jour, 'ARMEN');
# si le fichier est déjà archivé
my $thr1 = threads->new(\&recup_fic, 'SPO_*_T.tar.gz', "/transfert/rec
+eption/DIFARMEN_$date_fic", $rep_jour, 'ARMEN');
# $thr1->detach; # A partir de maintenant, nous nous désintéressons
+ officiellement du thread
$thr1->join;
my $choix = Tkx::tk___messageBox( -message => "Faut il recuperer le fi
+chier INITSE : SPOT_MAXIMO_$date_mois*.tar.gz ?\n",
-type => "yesno", -icon => "questi
+on", -title => "Fichier SPOT_MAXIMO_$date_mois*_T.Tar.GZ");
# récupération du fichier INITSE .Tar.GZ dans le répertoire <Date du j
+our>.
if($choix eq 'yes') {
print "recuperation INITSE\n";
my $thr = threads->new(\&recup_fic, 'SPOT_MAXIMO_*_T.tar.gz', '/tr
+ansfert/reception', $rep_jour, 'INITSE');
# si le fichier est déjà archivé
# my $thr = threads->new(\&recup_fic, 'SPOT_MAXIMO_*_T.tar.gz', "/
+transfert/reception/INITSE_$date_fic", $rep_jour, 'INITSE');
$thr->detach; # A partir de maintenant, nous nous désintéresson
+s officiellement du thread
# } else {
}
$choix = Tkx::tk___messageBox( -message => "Faut il recuperer le fichi
+er MOA : MOA1_$date_fic*.zip ?\n",
-type => "yesno", -icon => "questi
+on", -title => "Fichier MOA1_$date_fic*.Zip");
# récupération du fichier MOA .Zip dans le répertoire <Date du jour>.
if($choix eq 'yes') {
print "recuperation MOA\n";
my $thr = threads->new(\&recup_fic, 'MOA1_*.zip', '/transfert/rece
+ption', $rep_jour, 'MOA');
# si le fichier est déjà archivé
# my $thr = threads->new(\&recup_fic, 'MOA1_*.zip', "/transfert/re
+ception/MOA1_$date_fic", $rep_jour, 'MOA');
$thr->detach; # A partir de maintenant, nous nous désintéresson
+s officiellement du thread
# } else {
}
$choix = Tkx::tk___messageBox( -message => "Faut il recuperer le fichi
+er NINIV : RMDOGNPM_$date_fic*.zip ?\n",
-type => "yesno", -icon => "questi
+on", -title => "Fichier RMDOGNPM_$date_fic*.Zip");
# récupération du fichier NINIV .Zip dans le répertoire <Date du jour>
+.
if($choix eq 'yes') {
print "recuperation NINIV\n";
my $thr = threads->new(\&recup_fic, 'RMDOGNPM_*.zip', '/transfert/
+reception', $rep_jour, 'NINIV');
# si le fichier est déjà archivé
# my $thr = threads->new(\&recup_fic, 'RMDOGNPM_*.zip', "/transfer
+t/reception/NINIV_$date_fic", $rep_jour, 'NINIV');
$thr->detach; # A partir de maintenant, nous nous désintéresson
+s officiellement du thread
# } else {
}
$choix = Tkx::tk___messageBox( -message => "Faut il recuperer le fichi
+er RESEAU : RMDOGCSEG_$date_veille*.zip ?\n",
-type => "yesno", -icon => "questi
+on", -title => "Fichier RMDOGCSEG_$date_veille*.Zip");
# récupération du fichier RESEAU .Zip dans le répertoire <Date du jour
+>.
if($choix eq 'yes') {
print "recuperation RESEAU\n";
my $thr = threads->new(\&recup_fic, 'RMDOGCSEG_*.zip', '/transfert
+/reception', $rep_jour, 'RESEAU');
# si le fichier est déjà archivé
# my $thr = threads->new(\&recup_fic, 'RMDOGCSEG_*.zip', "/transfe
+rt/reception/RESEAU_$date_fic", $rep_jour, 'RESEAU');
$thr->detach; # A partir de maintenant, nous nous désintéresson
+s officiellement du thread
# } else {
}
$choix = Tkx::tk___messageBox( -message => "Faut il recuperer les fich
+iers SIRH : SPO.GES.N.*.zip SPO.REF.N.*.zip ?\n",
-type => "yesno", -icon => "questi
+on", -title => "Fichiers SPO.GES.N.*.Zip SPO.REF.N.*.Zip");
# récupération du fichier SIRH .Zip dans le répertoire <Date du jour>.
if($choix eq 'yes') {
my $rep_tmp = "$rep_jour/SIRH";
mkdir $rep_tmp or die "Probleme creation repertoire $rep_tmp E/S:
+$!\n";
print "recuperation SIRH GES\n";
# my $thrA = threads->new(\&recup_fic, 'SPO.GES.N.*.ZIP', '/transf
+ert/reception', $rep_tmp, 'SIRH GES');
# si le fichier est déjà archivé
my $thrA = threads->new(\&recup_fic, 'SPO.GES.N.*.ZIP', "/transfer
+t/reception/SIRH_$date_fic", $rep_tmp, 'SIRH GES');
print "recuperation SIRH REF\n";
# my $thrB = threads->new(\&recup_fic, 'SPO.REF.N.*.ZIP', '/transf
+ert/reception', $rep_tmp, 'SIRH REF');
# si le fichier est déjà archivé
my $thrB = threads->new(\&recup_fic, 'SPO.REF.N.*.ZIP', "/transfer
+t/reception/SIRH_$date_fic", $rep_tmp, 'SIRH REF');
foreach my $thr (threads->list) {
print "Tread $thr, ", $thr->tid, "\n";
# Ne pas rejoindre le thread principal ni nous-mêmes
if ($thr->tid && !threads::equal($thr, threads->self)) {
my @tempo = $thr->join;
print "Tread $thr join :<", join('><', @tempo), ">\n";
}
}
# print "fin de boucle Threads.\n";
# } else {
}
print "debut\n";
# attente de l'apparition des fichiers
Tkx::tk___messageBox(-message => "Les fichier T_*.csv sont ils présent
+s dans le répertoire distant ?\n",
-icon => "question", -title => "Fichiers T_*.CSV
+");
# récupération des fichiers CSV dans le répertoire du même nom.
my $thr2 = threads->new(\&recup_fic, 'T_*.csv', '/transfert/reception'
+, "$rep_jour/CSV", 'CSV');
$thr2->detach; # A partir de maintenant, nous nous désintéressons o
+fficiellement du thread
# attente de l'apparition des fichiers
Tkx::tk___messageBox(-message => "Les fichier *.xml sont ils présents
+dans le répertoire distant ?\n",
-icon => "question", -title => "Fichiers *.XML")
+;
# récupération des fichiers XML dans le répertoire du même nom.
my $thr3 = threads->new(\&recup_fic, "\*$date_fic\*\.xml", '/transfert
+/emission', encode( "iso-8859-1","$rep_fichiers/$date_fic/".decode("u
+tf8", "XML Générés")), 'XML');
$thr3->detach; # A partir de maintenant, nous nous désintéressons o
+fficiellement du thread
# récupération des fichiers BAD dans le répertoire LOG.
my $thr4 = threads->new(\&recup_fic, '*.bad', '/traces/spotimp/loader'
+, encode( "iso-8859-1","$rep_fichiers/$date_fic/".decode("utf8", "Log
+s Préparateur")), 'BAD');
$thr4->detach; # A partir de maintenant, nous nous désintéressons o
+fficiellement du thread
# récupération des fichiers LOG dans le répertoire du même nom.
for (@lst_log) {
my $thr = threads->new(\&recup_fic, $_, '/traces/spotimp/loader',
+encode( "iso-8859-1","$rep_fichiers/$date_fic/".decode("utf8", "Logs
+Préparateur")), 'LOG');
}
foreach my $thr (threads->list) {
# Ne pas rejoindre le thread principal ni nous-mêmes
if ($thr->tid && !threads::equal($thr, threads->self)) {
$thr->join;
}
}
=head1 NAME
IF_recup_quotidien.pl
=head1 SYNOPSIS
Interactive mode:
perl IF_recup_quotidien.pl
=head1 DESCRIPTION
Il s'agit d'automatiser la création des répertoire et la récupération
+quotidienne des fichiers de PROD pour SPOT IF.
=head1 ALGORITHME
choix du répertoire de version de SPOT IF.
création du répertoire <Date du jour> et des répertoires CSV, XML, Log
+s préparateurs dans ce répertoire créé.
si besoin, récupération des fichiers DIFARMEN, INITSE, MOA1, NINIV, RE
+SEAU, SIRH d'extension .Tar.GZ ou .Zip dans le répertoire <Date du jo
+ur>.
récupération des fichiers CSV dans le répertoire du même nom.
récupération des fichiers XML dans le répertoire du même nom.
récupération des fichiers BAD dans le répertoire des Logs.
récupération des fichiers LOG dans le répertoire du même nom.
=head1 AUTEUR
Xavier HERVIEU, beginner in Perl.
=cut
sub recup_fic{
# récupération des paramètres
my ($fic, $source, $rep, $cas) = @_;
$semaphore->down;
print "Semaphore $cas avant:", Dumper($semaphore);
print "fichier '$fic' dans '$source' vers '$rep'.\n";
# transfert via pscp de PUTTY du ou des fichiers
`C:/MCOBOX/pscp -sftp -pw <password> <login>\@<IP ADDRESS>:$source/$fi
+c "$rep/"` ;
$semaphore->up;
print "Semaphore $cas apres:", Dumper($semaphore);
}
| [reply] [Watch: Dir/Any] [d/l] |
Re: Threads and TCL DeleteInterpProc
by Anonymous Monk on Jun 12, 2014 at 23:44 UTC
|
| [reply] [Watch: Dir/Any] |
|
| [reply] [Watch: Dir/Any] |
|
A question for you, how far does your program go before the Tcl error shows up? Devel::Trace
Reminds me of Re^3: TKX and closing windows (bug) ..
L'anana ne parlais pas .... so this is the way I'd structure the program to avoid any Tkx noise .... I don't see an use for Thread::Semaphore
As you can see, the more well named subs you have, the less comments you need
See also Ask - ask your users about stuff / ask-introduction.pod
You can use utf8 to signal to perl that your file is written in utf8, so you don't have to decode("utf8" all over the place
Also see Win32::Unicode::Native since I assume you're on win32 ... for unicode version of mkdir/open... so you don't have to encode("iso-8859-1" ...
Also, if you still need to encode("iso-8859-1" .... don't do it all over the place (repetition hurts your fingers), do it in one helper subroutine, say in recup_fic or MyMkdir ...
I would also consider my $answer = YesNo( "question", "title" ); and ReadThis( $msg, $title ); ... although Info( $msg, $title ); sounds good .... there is a Ask::Tk, a Ask::Tkx should be only a few tweaks to that
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
|
|
|
While I'm working on some code, take a look at these, I believe they deal with same problem (not enough subs, too many comments, pattern for using threads, que, gui toolkit) ... Re: Win32::GUI window freezing, even with threading. (win32-gui-tk-thread-dequeue.pl, Thread::Queue::popnow/push) + Re^4: Win32::GUI window freezing, even with threading. (Wrong solution), Re: Tk: Creating label in hash, Re: perl Tk thread help, Re: error on file open, Re^4: Query the height of Tk::Text widget with word wrap
| [reply] [Watch: Dir/Any] |
|
|