Hi
Thanx for all your help. With the time diffrence I only get the
reply's in the moring. Thanx a lot for the group's help.
Charlene
On Wed, 30 Jun 2004 08:12:00 +0200, [EMAIL PROTECTED] (Charlene
Gentle) wrote:
>Thanx for the help Zentara. Here are a part of my code. I know that
>I'm doning stuff the long way so if anyone could show me a shorter
way
>it will be helpfull. I wanted to put the sub's that I call into one
but
>how? The progress "meter" have to show that it is still busy
scanning
>the file, as soon as it is done and the file is closed, and the
output
>have been given the meter should stop. I don't want the user to
close
>the program before the job is done.
>
>Thanx
>
>>Hi
>>
>>My program works thru long lists of word. How can I show the user
>that
>>it is still busy and when it is done. Is there a progressmeter that
>I
>>can insert into the while loop. To have a perl/tk interface for the
>>user.
Hi...Ok I think I figured it out, without having any test files.
Below is the code.
What I did was go into your do_while sub and first count the total
lines by looping thru the filehandles, then I rewound the filehandles
to the beginning so they could be processed. Then as you process them,
I increment the progressbar by ( 100 / $linetotal ).
It seems to work, but I don't know what you are doing for sure.
In my testing, I create the test error file, then click each checkbox
and select a txt file. Then click the toets button.
Also I added a few select(undef,undef,undef,.01) statements
to slow down the files for testing. You can remove them for your
big files.
#!/usr/bin/perl
use Tk;
use IO::File;
use diagnostics;
use warnings;
use Tk::Balloon;
# added these lines
use Fcntl qw(:seek);
use Tk::ProgressBar;
my $linetotal = 0;
my $progressbar;
#
use vars qw(@c @bs @cb_value @i $sfile_val $newline @bt);
my $sfile = "";
my $file = "";
my $FILE0 = "";
my $FILE1 = "";
my $FILE2 = "";
my $FILE3 = "";
my $FILE4 = "";
my $FILE5 = "";
my $FILE6 = "";
# MAINWINDOW
my $main = new MainWindow();
drawInterface();
Tk::MainLoop();
# INTERFACE FOR USER <BUTTONS, CHECKBOX, ETC>
sub drawInterface {
$main->title("Check For Errors");
$main->configure( -background => 'gray' );
$main->geometry("300x300");
# MAAK FRAMES
my $opsFrm = $main->Frame( -background => 'gray' )->pack( -side =>
'top' );
my $keuseFrm = $main->Frame( -background => 'gray' );
my $opbtFrm =
$main->Frame( -background => 'gray' )->pack( -side => 'bottom'
);
# MAAK KEUSE VIR DIE SAVE LEER
$main->Label(
-text => "Create a file to save errors to",
-background => 'gray',
-font => "Helvetica -15 bold"
)->pack();
$main->configure( -background => 'gray' );
$main->Button(
-text => 'Create',
-width => 7,
-height => 1,
-command => sub { \&do_save($main) }
)->pack( -pady => 3 );
# KEUSE BY TIPE LEERS
my $keuse = $keuseFrm->Label(
-text => "Maak 'n keuse",
-font => "Helvetica -15 bold"
)->pack( -side => 'top', -pady => 20 );
$keuse->configure( -background => 'gray' );
$keuseFrm->pack( -side => 'top', -fill => 'x' );
# CHECKBOX VIR LEERS WAT GEKIES WORD
$c[0] = $keuseFrm->Checkbutton(
-variable => \$cb_value[0],
-offvalue => 0,
-onvalue => 1,
-text => "Dialects Upper",
-background => 'gray',
-command => sub {
if ( $cb_value[0] == 1 ) {
&do_get( $main, $c[0] = 0 );
}
}
)->pack( -side => 'top', -anchor => 'w', -padx => 20 );
$c[1] = $keuseFrm->Checkbutton(
-variable => \$cb_value[1],
-offvalue => 0,
-onvalue => 1,
-text => "Dialects Lower",
-background => 'gray',
-command => sub {
if ( $cb_value[1] == 1 ) {
&do_get( $main, $c[1] = 1 );
}
}
)->pack( -side => 'top', -anchor => 'w', -padx => 20 );
$c[2] = $keuseFrm->Checkbutton(
-variable => \$cb_value[2],
-offvalue => 0,
-onvalue => 1,
-text => "Coffensive Upper",
-background => 'gray',
-command => sub {
if ( $cb_value[2] == 1 ) {
&do_get( $main, $c[2] = 2 );
}
}
)->pack( -side => 'top', -anchor => 'w', -padx => 20 );
#DOEN EN EXIT BUTTONS
$bt[0] = $opbtFrm->Button(
-text => 'Toets',
-width => 8,
-height => 1,
-command => sub { &do_while }
)->pack( -side => 'left' );
$bt[1] = $opbtFrm->Button(
-text => 'Exit',
-width => 8,
-height => 1,
-command => sub { exit }
)->pack( -side => 'right' );
}
# SKEP FILE
sub processfile {
my $retval = 0;
if ( open SFILE, "> $sfile" ) {
print SFILE "\n" if ($newline);
close(SFILE);
}
return $sfile;
}
# SAVE FILE WAT GESKEP IS
sub do_save {
my ($save) = @_;
my @types = (
[ "Text files", [qw/.txt .doc/] ],
[ "Text files", "", "TEXT" ],
[ "All files", "*" ]
);
$sfile = $main->getSaveFile(
-filetypes => [EMAIL PROTECTED],
-initialfile => 'test',
-defaultextension => '.txt'
);
print qq{You chose to save as "$sfile"\n};
processfile();
}
# KRY FILE GEBRUIK GAAN WORD
sub do_get {
my ( $get, $get1 ) = @_;
my @types = (
[ "Text files", [qw/.txt .doc/] ],
[ "Text files", "", "TEXT" ],
[ "All files", "*" ]
);
$file = $main->getOpenFile(
-filetypes => [EMAIL PROTECTED],
-defaultextension => '.txt'
);
print qq{"jy het $file "\n};
&kyk( $file, $get1 );
}
# SIT DIE OOP GEMAAKTE LEER IN SY PLEK
sub kyk {
my ( $kyk, $kyk1 ) = @_;
SWITCH: {
if ( $kyk1 == 0 ) {
$FILE0 = $file;
print qq{" file0 = $FILE0 "\n};
my $op0 = $FILE0;
open( FILE0, "<$op0" ) or die "$!: $op0\n yap0";
return $FILE0;
last SWITCH;
}
if ( $kyk1 == 1 ) {
$FILE1 = $file;
print qq{" file1 = $FILE1 "\n};
my $op1 = $FILE1;
open( FILE1, "<$op1" ) or die "$!: $op1\n yap1";
return $FILE1;
last SWITCH;
}
if ( $kyk1 == 2 ) {
$FILE2 = $file;
print qq{" file2 = $FILE2 "\n};
my $op2 = $FILE2;
open( FILE2, "<$op2" ) or die "$!: $op2\n yap2";
return $FILE2;
last SWITCH;
}
}
&do_while($file);
}
sub do_while {
#count lines and rewind
while(<FILE0>){$linetotal++}
seek FILE0, 0, SEEK_SET or die "Cannot rewind file: $!";
while(<FILE1>){$linetotal++}
seek FILE1, 0, SEEK_SET or die "Cannot rewind file: $!";
while(<FILE2>){$linetotal++}
seek FILE2, 0, SEEK_SET or die "Cannot rewind file: $!";
print "$linetotal\n";
$progressbar = $main->ProgressBar(
-length => 200, # Actually width
-width => 20, # Actually height
-gap => 0,
-value => 0,
-colors => [0, 'pink'],
)->pack(-pady => 5, -padx => 5);
while (<FILE0>) {
my $line = $_;
chomp($line);
do_opt0($line);
if ( $line ne $token ) {
print SFILE "$token";
}
$progressbar->value($progressbar->value + (100/$linetotal) );
$main->update;
select(undef,undef,undef,.01);
}
while (<FILE1>) {
my $line = $_;
chomp($line);
do_opt1($line);
if ( $line ne $token ) {
print SFILE "$token";
}
$progressbar->value($progressbar->value + (100/$linetotal) );
$main->update;
select(undef,undef,undef,.01);
}
while (<FILE2>) {
my $line = $_;
chomp($line);
do_opt2($line);
if ( $line ne $token ) {
print SFILE "$token";
}
$progressbar->value($progressbar->value + (100/$linetotal) );
$main->update;
select(undef,undef,undef,.01);
}
}
# OPTIONS WAT GEMAAK IS ??????????
sub do_opt0 {
my $op0 ||= 0;
my $class;
my $print = 0;
my $word = $_[0];
my $sfil = $sfile;
$op0 = $FILE0;
print " $sfile ";
open( SFILE, ">>$sfil" ) or die "$!: $sfil\n";
if ( $word =~ /^(.*)(\s)(.*)/ ) {
$token = "$word\t\t\t$op0\n";
return $token;
} #spasies
if ( $word =~ /^(.*)(\n)(\n)(.*)/ ) {
$token = "$word\t\t\t$op0\n";
return $token;
} #dubbel enters
if ( $word =~ /^([a-z]+)([A-Z]+)([a-z]+)/ ) {
$token = "$word\t\t\t$op0\n";
return $token;
} #kleinHOOFklein
if ( $word =~ /^([A-Z])(.*)/ ) {
$token = "$word\t\t\t$op0\n";
return $token;
} #HOOF
if ( $word =~ /^((.*)[\?|\!|\#|\_|\.](.*))/ ) {
$token = "$word\t\t\t$op0\n";
return $token;
} #vraagteken,#uitroepteken,#underscore,#iets,#iets
if ( $word =~ /^('-')(.*)/ ) {
$token = "$word\t\t\t$op0\n";
return $token;
} #koppelteken aan begin van woord
if ( $word =~ /^(.*)('-')$/ ) {
$token = "$word\t\t\t$op0\n";
return $token;
} #koppelteken aan einde van woord
if ( $word =~
/^(.*)(\@|\\|\/|\{|\}|\=|\+|\*|\&|\^|\:|\;|\<|\>|\(|\)|\`|\~|\%|\"|\,)(.*)$/
)
{
$token = "$word\t\t\t$op0\n";
return $token;
} #weird leestekens
}
sub do_opt1 {
my $op0 ||= 0;
my $class;
my $print = 0;
my $word = $_[0];
my $sfil = $sfile;
$op1 = $FILE1;
print " $sfile ";
open( SFILE, ">>$sfil" ) or die "$!: $sfil\n";
if ( $word =~ /^(.*)(\s)(.*)/ ) {
$token = "$word\t\t\t$op1\n";
return $token;
} #spasies
if ( $word =~ /^(.*)(\n)(\n)(.*)/ ) {
$token = "$word\t\t\t$op1\n";
return $token;
} #dubbel enters
if ( $word =~ /^([a-z]+)([A-Z]+)([a-z]+)/ ) {
$token = "$word\t\t\t$op1\n";
return $token;
} #kleinHOOFklein
if ( $word =~ /^([A-Z])(.*)/ ) {
$token = "$word\t\t\t$op1\n";
return $token;
} #HOOF
if ( $word =~ /^((.*)[\?|\!|\#|\_|\.](.*))/ ) {
$token = "$word\t\t\t$op1\n";
return $token;
} #vraagteken,#uitroepteken,#underscore,#iets,#iets
if ( $word =~ /^('-')(.*)/ ) {
$token = "$word\t\t\t$op1\n";
return $token;
} #koppelteken aan begin van woord
if ( $word =~ /^(.*)('-')$/ ) {
$token = "$word\t\t\t$op1\n";
return $token;
} #koppelteken aan einde van woord
if ( $word =~
/^(.*)(\@|\\|\/|\{|\}|\=|\+|\*|\&|\^|\:|\;|\<|\>|\(|\)|\`|\~|\%|\"|\,)(.*)$/
)
{
$token = "$word\t\t\t$op1\n";
return $token;
} #weird leestekens
}
sub do_opt2 {
my $op0 ||= 0;
my $class;
my $print = 0;
my $word = $_[0];
my $sfil = $sfile;
$op2 = $FILE2;
print " $sfile ";
open( SFILE, ">>$sfil" ) or die "$!: $sfil\n";
if ( $word =~ /^(.*)(\s)(.*)/ ) {
$token = "$word\t\t\t$op2\n";
return $token;
} #spasies
if ( $word =~ /^(.*)(\n)(\n)(.*)/ ) {
$token = "$word\t\t\t$op2\n";
return $token;
} #dubbel enters
if ( $word =~ /^([a-z]+)([A-Z]+)([a-z]+)/ ) {
$token = "$word\t\t\t$op2\n";
return $token;
} #kleinHOOFklein
if ( $word =~ /^([A-Z])(.*)/ ) {
$token = "$word\t\t\t$op2\n";
return $token;
} #HOOF
if ( $word =~ /^((.*)[\?|\!|\#|\_|\.](.*))/ ) {
$token = "$word\t\t\t$op2\n";
return $token;
} #vraagteken,#uitroepteken,#underscore,#iets,#iets
if ( $word =~ /^('-')(.*)/ ) {
$token = "$word\t\t\t$op2\n";
return $token;
} #koppelteken aan begin van woord
if ( $word =~ /^(.*)('-')$/ ) {
$token = "$word\t\t\t$op2\n";
return $token;
} #koppelteken aan einde van woord
if ( $word =~
/^(.*)(\@|\\|\/|\{|\}|\=|\+|\*|\&|\^|\:|\;|\<|\>|\(|\)|\`|\~|\%|\"|\,)(.*)$/
)
{
$token = "$word\t\t\t$op2\n";
return $token;
} #weird leestekens
}
close(SFILE);
close(FILE0);
close(FILE1);
close(FILE2);
# SPASIE
sub do_spasie { }
# DUBBLE ENTRIES
sub do_ent { }
# KLEINHOOFKLEIN
sub do_khk { }
# HOOF
sub do_hoof { }
# KLEIN
sub do_klein { }
# VREEMDE
sub do_vr { }
# KOPPEL TEKEN BEGIN
sub do_kopb { }
# KOPPELTEKEN EINDE
sub do_kope { }
# WEIRD LEESTEKENS
sub do_weird { }
__END__
--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
