perl tk text not showing in textarea 1

[yourkeylady]

I'm new to perl tk as of today.

I'm trying to output a download progress report that shows files downloaded, size, etc.

Is this code to insert text correct?
my $txt = $mw -> Text( -wrap=>'word', -width=> 50,-height=> 20) -> pack();

$txt->insert('end',"\nFetching the files, size is 5mb.");

Its all placed within more code with buttons and a progress bar. Everything shows fine, except the text is not visible when I call insert.

Thanks
Tricia

 

[PaulTEG]

This is just a straw clutch, but why the \n at the start of the text?

Paul
------------------------------------
Spend an hour a week on CPAN, helps cure all known programming ailments ;-)

 

[Kirsle]

You have to update the Tk windows every single time something new happens. Under normal circumstances, MainLoop will do this for you, but if you're doing other stuff (i.e. downloading things), it blocks the Perl code for a while and the window can't be updated.

Show us your whole code and we'll be able to help you more.

 

[yourkeylady]

I took out

#!perl
# this file is excecutable from the command line and compiled with perl2exe
# it shows a dialog box that allows the user to stop the download , or executes a setup file
# TO DO:
# learn perl TK and use a progress script that outputs the size of the file
# or simply checks the connection periodically to make sure the download is  not interuppted
# and if it is   restarts the download
# maybe use Net::FTP to restart the download
# put the downloads into a user ftp location on the site beadboard.info

use strict;
$0 = $^X unless ( $^X =~ m%(^|[/\\])(perl)|(perl.exe)$%i );
my ($program_dir) = $0 =~ m%^(.*)[/\\]%;
$program_dir ||= ".";

# for use while testing
$program_dir = "C:/Program Files/Apache Group/Apache2/htdocs/composer/addons";

chdir($program_dir);

#necessary for  perl2exe
#perl2exe_include File::Path
#perl2exe_include LWP::Simple
#perl2exe_include File::Copy
#perl2exe_info CompanyName=Microwebber.com
#perl2exe_info FileDescription=LWP update BeadBoard
#perl2exe_info FileVersion='end'.0.0
#perl2exe_info InternalName=LWP updateApplication.exe
#perl2exe_info LegalCopyright=Microwebber.com 2006
#perl2exe_info OriginalFilename=updateApplication.exe
#perl2exe_info ProductName=LWP updateApplication
#perl2exe_info ProductVersion='end'.0.0

my $base = $program_dir;
$base =~ s/(.*)addons.*/$1/;

unless ( -e "$base/addons" ) {
    print STDOUT qq~file location is incorrect $base/addons~;
}

# for debugging purposes
#my@dirs = split(m~/~,$base) ;
#my$dir = '';
#for(my$i=0;$i<@dirs;$i++){
#$dir .= $dirs[$i]."/";
#if(-e $dir){
#print STDOUT "exists $dir\n";
#}  else{
#exit(0);
#}
#}
#exit(0);
#}

use LWP::Simple;
use File::Path;
use File::Copy;
use Tk;

#use Tk::ProgressBar;
my $mw = new MainWindow;

 my$percent_done;
 my$progress = $mw->ProgressBar(
     -width => 200,
     -length => 20,
     -anchor => 's',
     -from => 0,
     -to => 100,
     -blocks => 10,
     -colors => [0, 'green', 50, 'yellow' , 80, 'red'],
     -variable => \$percent_done
 );
 my$position = 1;
   $progress->value($position);

my $frm_name = $mw->Frame();
my $install_button = $mw->Button( -text => "Install Now", -command => \&install_now );
my $cancel = $mw->Button( -text => "Cancel", -command => \&cancel_button );
my $textarea = $mw->Frame();    #Creating Another Frame
my $txt   = $textarea->Text( -width => 40, -height => 10 );
my $srl_y = $textarea->Scrollbar( -orient => 'v', -command => [ yview => $txt ] );
my $srl_x = $textarea->Scrollbar( -orient => 'h', -command => [ xview => $txt ] );
$txt->configure(
    -yscrollcommand => [ 'set', $srl_y ],
    -xscrollcommand => [ 'set', $srl_x ]
);

$install_button->grid( -row => 1, -column => 1 );
$cancel->grid( -row         => 1, -column => 2 );
$frm_name->grid( -row       => 1, -column => 1, -columnspan => 2 );

$txt->grid( -row      => 1, -column => 1 );
$srl_y->grid( -row    => 1, -column => 2, -sticky => "ns" );
$srl_x->grid( -row    => 2, -column => 1, -sticky => "ew" );
$textarea->grid( -row => 4, -column => 1, -columnspan => 2 );
$progress->grid( -row => 5, -column => 1, -columnspan => 2 );

MainLoop;
##################  functions
sub install_now {
    print "\ncalling server_fetch";
    &server_fetch();
}

sub cancel_button {
    my $response = $mw->messageBox(
        -message => "Are you sure you don't want to install the update?",
        -type    => 'yesno',
        -icon    => 'question'
    );
    print "\nresponse" . $response;

    if ( $response eq "Yes" ) {

        # don't write the files
        print "\nresponseexit(0)";
        exit(0);
    }
}

sub printLocks {
    if ( open( LOCKF, ">$base/lockUpdate.txt" ) ) {
        print LOCKF qq~1~;
        close(LOCKF);
    }
}

sub server_fetch {
    print qq~\nIn server_fetch~;
    $txt->insert( 'end', "\nFetching the files, size is approximately 5mb." );
    if ( open( LOG, ">$base/updateApplication.log" ) ) {
        &setTime();
    }
    else {
        $txt->insert( 'end', "\nError: cannot transfer update, $!" );

    }
    my $setup  = '';
    my $url    = qq~[URL unfurl="true"]http://anywhere.com/anyfile.com~;[/URL]
    my $return = get($url);
    unless ($return) {
        $txt->insert( 'end', "\nCannot load the files, connection test failed." );
        print LOG "\nCannot load the files, connection test failed.";
    }
    else {
        $txt->insert( 'end', "\nUpdating files, please wait..." );
        print LOG "\ncontinuing with the upgrade " . $return;
        print STDOUT "Updating";
    }
    my ( $version, $filesize ) = split ( /\|/, $return );
    if ($version) {
        my $url = $version;
        print LOG qq~\nDownloading $url~;
        my $content = get($url);
        if ($content) {
            print LOG qq~\nDownload complete~;
            # move all the old setup files to the addon directory
            if ( opendir( PRG, $base ) ) {
                while ( defined( $_ = readdir(PRG) ) ) {
                    if (/PBsetup/) {
                        if ( -e "$program_dir/$_" ) {
                            unlink("$program_dir/$_");
                        }
                        copy( "$base/$_", "$program_dir/$_" );
                        if ( -e "$base/$_" ) {
                            unlink("$base/$_");
                        }
                    }
                }
            }
            if ( open( UPDATE, ">$base/PBsetup.exe" ) ) {
                binmode(UPDATE);
                print LOG qq~\nWriting $base/PBsetup.exe~;
                $txt->insert( 'end', qq~\nWriting $base/PBsetup.exe~ );
                close(LOG);

                print UPDATE $content;
                exec("PBsetup.exe");
            }
            else {
                $txt->insert( 'end', "\nCannot write the setup file $base/PBsetup$version.exe.  $!"
                );
                print LOG "\nCannot write the setup file $base/PBsetup$version.exe.  $!";
            }
        }
    }
    else {
        print LOG "\nThere has been an error downloading the update.  Are you connected to the web?";
        print LOG "\nThere has been an error downloading the update.  Are you connected to the web?";
    }
}

sub setTime {
    my ( $sec, $min, $hour, $day, $mon, $year, $junk ) = gmtime( time() );
    $txt->insert( 'end', "\n$sec $min, $hour, $day, $mon, $year" );
    print LOG " $sec $min, $hour, $day, $mon, $year\n";
}

__END__

Thanks
Tricia

 

[yourkeylady]

I had to leave and couldn't finish my previous post, and I don't see an edit post button.

So I guess I need to learn how to update the window after making changes? If anyone has a premade script that would be nice to look at.

Thanks
Tricia

 

[Kirsle]

Okay, I see your problem and have a solution for ya.

So your server_fetch sub does a lot of stuff, some of which involves inserting stuff into the textarea.

As I mentioned in my previous post, Tk windows need to be refreshed in order to show any new changes to them. For a solution, add a $mw->update after each insert command... i.e.

sub server_fetch {
    print qq~\nIn server_fetch~;
    $txt->insert( 'end', "\nFetching the files, size is approximately 5mb." );
    [COLOR=blue]$mw->update;[/color]
    if ( open( LOG, ">$base/updateApplication.log" ) ) {
        &setTime();
    }
    else {
        $txt->insert( 'end', "\nError: cannot transfer update, $!" );
        [COLOR=blue]$mw->update;[/color]
    }

That should take care of the main problem (of the text not showing up).

I'd also advise you to put more $mw->update commands in other places in your subroutine, specifically before and after commands that take a while to complete. For instance, your LWP::Simple::get might take a while depending on server speeds and file sizes, so you might want to do this:

    if ($version) {
        my $url = $version;
        print LOG qq~\nDownloading $url~;
        [COLOR=blue]$mw->update;[/color]
        my $content = get($url);
        [COLOR=blue]$mw->update;[/color]
        if ($content) {

Not only does update() refresh the GUI to show new changes to it, it also stops it from "freezing". When any GUI stops being updated, it will stop responding, so that clicking on buttons on it or anything won't do anything, and sometimes Windows will even say "(Not Responding)" and such.

If your code is for you alone and you know your program is working just fine, you don't have to worry about it "freezing" like that, but if other people use your program they might think that your program isn't working because it freezes up and they might end-task it and stuff.

So, use update anywhere that you can, particularly around methods that take a little time. And if you can't help it much at all, at least have it write a message saying "Please wait" or something to alert the user that the program may stop responding for a short amount of time.

 

[yourkeylady]

Thanks for the help. I'm not sure why I didn't find the update method in the examples I was reading. It would be nice to get an ebook on perl tk. Also it would be nice to make or find a command line module that's reusable for downloading files. Then executes the file downloaded upon request.

Thanks
Tricia