Perl/tk Progress Bar advice needed 1

[rab54]

Hi gurus -

OK I have a small perl/tk gui front-end -

One of the options is to run an import on a mysql database -

I would like to show the user how far we have got with the insert .... I have set the ProgressBar widget up and it runs fine - but only with the default values

eg -

my $progress =
$mw->ProgressBar(-width => 30,
# -height => 2,
-length => 200,
-from => 0,
-to => 100,
# -anchor => 'e',
-blocks => 10,
-colors => [0, 'green', 30, 'blue' , 70, 'red'],
-variable => \$percent_done,
);

for ($percent_done=0; $percent_done <= 100; $percent_done +=5) {
$text = "$percent_done% done ...";
$mw->update;
sleep 1;

But I need the progress bar to reflect the values as it imports into the database (obviously it could be a small import or a very large one)

Hope I am not rambling too much -

Any pointers would be most welcome -

Cheers

Rab

 

[Rieekan]

What is the update code you have for your app? If it's a bunch of update statements being executed, you could create a subroutine to perform the update and include in that a percent increase for the progress bar. Something like the following:

sub db_update
{
    my ($dbh, $sql, $curr_percent, $increment, $mw) = @_;

    my $rc = $dbh->do($sql) or die "Update failed: $dbh->errst\n";

    my $percent_done = $curr_percent + $increment;

    my $text = "$percent_done% done";
    $mw->update;

    return $percent_done;  #Return the current Percentage done
}

my $mw;

my $progress =
  $mw->ProgressBar(-width => 30,
              #     -height => 2,
                   -length => 200,
                   -from => 0,
                   -to => 100,
           #        -anchor => 'e',
                   -blocks => 10,
                   -colors => [0, 'green', 30, 'blue' , 70, 'red'],
                   -variable => \$percent_done,
                   );

my $dbh = DBI->connect("dbi:odbc:database", "logon", "pass") or die "Cannot connect to database: $DBI::errstr\n";

my $sql = qq(update table set column = $column where id = $id);

my ($percent);
my $increment = 5; #number of updates you're going to make

$percent = db_update($dbh, $sql, $percent, $increment, $mw);

That might have some bugs in it, but I think you'll get the drift of what it's doing.

- Rieekan

 

[rab54]

cheers for the reply -

I have my 'thick' head on ;-) what is this line doing ...

$percent = db_update($dbh, $sql, $percent, $increment, $mw);

On top of that my original code has stopped working - doh !

thanks for your continued advice ....

Rab

 

[Rieekan]

Oh, sorry about that. Here's a breakdown of the line to help.

[ul]
[li]$percent is where I'm assigning the returned value of the sub routine db_update.[/li]
[li]db_update($dbh, $sql, $percent, $increment, $mw) is calling the sub-routine that will perform my database updates and also update the progress bar for the user to see[/li]
[li]$dbh, $sql, $percent, $increment, $mw are the five variables that are needed to be passed to the sub-routine so the updates to the database and TK Widget will occur[/li]
[/ul]

I must warn you that I don't use Perl/TK, so I could be missing code needed to perform the progress bar updates.

- Rieekan

 

[goBoating]

Here is an example of cycling through a simple loop with a corresponding progress bar. I hacked it out of an app I wrote to download my pics off of my digital camera.

'Hope this helps.

#!/usr/bin/perl
# a nearly trivial script to mount /mnt/camera on
# dev/ttyUSB1, create a target dir, and copy pics 
# from camera to dir.
# Note that mount stuff has been excised for brevity.
#---------------------------------------------------------------------
$| = 1;
use strict;
use Tk;
use Tk::Pane;
use Tk::ProgressBar;

my $message = 'Ready';
my $main = MainWindow->new();
$main->configure(-title=>'Camera 2 Disk', -background =>'blue');
$main->geometry('370x200+100+00');
my $label = $main->Label(-text =>"Digital Camera Tool\nCopy Images from Fuji FinePix to Disk",
            -relief => 'raised',
            -background =>'#42b4b4')
    ->pack(-side=>'top', -fill =>'both');

my $button_frame = $main->Frame(-relief=>'raised')
    ->pack(-side => 'top', -fill => 'x');
my $dump = $button_frame->Button(-text => 'Dump',
             -command => \&get_files)
    ->pack(-side =>'left', -anchor => 'w');

my $status_text = 'Ready';
my $status_label = $button_frame->Label(-textvariable =>\$status_text,
            -relief => 'raised',
            -background =>'grey77')
    ->pack(-side=>'left',-fill=>'both', -expand=>'1');

my $exit = $button_frame->Button(-text => 'Exit', -command => 'exit')
    ->pack(-side =>'right');

my $status = $main->Scrolled('Pane', -scrollbars => 'se', -relief => 'flat')
    ->pack(-side=>'top', -fill=>'both', -expand=>'y');
$status->Label(textvariable =>\$message,
            -relief => 'flat')
    ->pack(-side=>'top', -fill =>'both');

my $percent_done;
my $position = '0';
my $progress = $main->ProgressBar(-troughcolor => 'grey70',
        -width => 20,
        -length => 370,
        -anchor => 'w',
        -from => 0,
        -to => 100,
        -blocks => 0.1,
        -colors => [0, 'blue', 100],
    )->pack(-side=>'left', -fill=>'both');

$progress->value($position);

MainLoop();
#---------------------------------------------------------------------
sub get_files {
my $i;
while ($i <= 10 ) {
	$percent_done = int(($i/10) * 100);
	$progress->value($percent_done);
	$progress->update;
	$i++;
	sleep(1);
	$message = "Loop number $i.";
    }
}

'hope this helps

If you are new to Tek-Tips, please use descriptive titles, check the FAQs, and beware the evil typo.

 

[goBoating]

Oh yeah. Run it and click the 'Dump' button.

'hope this helps

If you are new to Tek-Tips, please use descriptive titles, check the FAQs, and beware the evil typo.

 

[rab54]

Cheers goBoating -

I will have a good look at this tomorrow !

Rab

 

[rab54]

Cheers goBoating -

Got it sorted ....

Have a look at my next TK:: question if you are in a good mood ;-)



Rab