# $Id: Get.pm,v 1.14 2002/04/11 07:46:02 muhri Exp $ # -*- perl -*- package Pronto::Get; use strict; use vars qw($acct $inter $called_from_get $status_dialog $uidl); use IO::Socket; use SelfLoader; $status_dialog = undef; my ( $account, $query, $sql, %filter, @row, $acctid, $mailsize, $div, $answer, $reportsize, $i, @test, $socket, $size, $count, $rawbody, $query2, $percent,$sql2, $header, $timeout ); 1; __DATA__ sub get { if (!$acct) { $acct = "all"; } if (!$inter) { $inter = 0; } # Touch lock file open(TMP,">$main::prefs{'MailDir'}/prontoget.running"); print TMP "$$\n"; close(TMP); # Is this an interactive session? (ie: do I draw a gtk status window?) if ($inter == 1 and $called_from_get == 1) { use Gtk; init Gtk; &init_sd; } elsif ($inter == 1 and $called_from_get == 0) { &init_sd; } chomp($acct); if (!$main::prefs{'POP3Verbose'}) { #lazy ass people who dont turn off $inter = 0; #thier autocheck } %filter = &Pronto::Data::Message::make_filter_hash(); if ($acct eq "all") { $sql = "select id, uname, friendly, descr, pop, pport, pass, dm, reply, type, dupecheck from accounts where include = 'y'"; } else { $sql = "select id, uname, friendly, descr, pop, pport, pass, dm, reply, type, dupecheck from accounts where id = $acct"; } $query=$main::conn->prepare($sql); $query->execute(); while (@row=$query->fetchrow_array()) { ($account->{'id'}, $account->{'uname'}, $account->{'friendly'},$account->{'desc'}, $account->{'srvr'}, $account->{'port'}, $account->{'pass'}, $account->{'dm'}, $account->{'reply'}, $account->{'type'},$account->{'dupecheck'}) = @row; if (!$account->{'type'}) { $account->{'type'} = "Pop3"; } if ($account->{'type'} eq "mbox") { &get_from_mbox(); } elsif ($account->{'type'} eq "Maildir") { &get_maildir(); } else { # pop 3 &get_pop3(); } } # tell pronto to refresh if its running. if(open(TMP,"<$main::prefs{'MailDir'}/pronto.running")) { my $proc = ; close(TMP); if(kill(0,$proc)) { kill('USR2',$proc); } } unlink("$main::prefs{'MailDir'}/prontoget.running"); if ($query) {$query->finish;} if ($query2) {$query2->finish;} if (defined $status_dialog) { $status_dialog->destroy; undef $status_dialog; } if ($called_from_get) { $main::conn->disconnect; } return; } sub get_pop3 { my (@deletelist, @fetchlist); # Arrays to contain items that are flagged to be removed or fetched from server. if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } if (!$main::prefs{'use_http_proxy'}) { unless (@test = gethostbyname($account->{'srvr'})){ if ($inter == 1) { &main::err_dialog(_("Mail Host Not Found:") . "\n\n$account->{'srvr'}", "y", _("POP3 Connect Error")); } else { print(_("Mail host not found: ") . "$account->{'srvr'}\n"); } return; } } if (defined $status_dialog) { $status_dialog->{'statuslabel'}->set_text(_("Checking account ") . $account->{'desc'}); $percent = 0; $status_dialog->{'progressbar'}->set_value($percent); $status_dialog->{'mailprogressbar'}->set_value($percent); $status_dialog->{'progressbar'}->configure(0,0,$percent); $status_dialog->{'mailprogressbar'}->configure(0,0,$percent); while (events_pending Gtk) { main_iteration Gtk; } } if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } if (!$main::prefs{'use_http_proxy'}) { $socket = IO::Socket::INET->new(PeerAddr => "$account->{'srvr'}", PeerPort => "$account->{'port'}", Proto => "tcp", Type => SOCK_STREAM) or return; } else { $socket = IO::Socket::INET->new(PeerAddr => $main::prefs{'Proxy'}, PeerPort => $main::prefs{'ProxyPort'}, Proto => "tcp", Type => SOCK_STREAM) or return; #die "Couldn't create socket $!\n"; print $socket "connect $account->{'srvr'}:$account->{'port'} http/1.0\r\n\r\n"; # $answer = <$socket>; my $string = <$socket>; chomp($string); my ($proxy_status) = (split (/ /, $string))[1]; if (int ($proxy_status / 100) != 2) { if ($inter == 1) { &main::err_dialog(_("Recieved bad status code \"$proxy_status\" from http-proxy while connecting to $account->{'srvr'}:$account->{'port'}"),"y",_("POP 3 Connect Error")); } else { print("Recieved bad status code \"$proxy_status\" from http-proxy while connecting to $account->{'srvr'}:$account->{'port'}\n"); } return; } my $test_int=0; while (!$test_int) { $string = <$socket>; if ($string eq "\n") { $test_int = 1; } } } $answer = <$socket>; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } # Need two things for APop to work my $loggedin = 0; if ( ($account->{'type'} eq 'APop') and # The account type is APop ($answer =~ /(<[\w\d\-\.]+\@[\w\d\-\.]+>)/) and # We have a key in the answer (eval { require Digest::MD5; import Digest::MD5 ('md5_hex'); 1; }) # We have Digest::MD5 installed ) { my $key = $1; my $pass = md5_hex ($key . $account->{'pass'}); print $socket "APOP $account->{'uname'} $pass\r\n"; my $answer = <$socket>; # Apop not successful fall back to normal authentication. # Maybe should alert here $loggedin = ($answer =~ /^\+OK/) ? 1 : 0; if (!$loggedin) { if ($inter == 1) { &main::err_dialog(_("Failed to authenticate APOP on server") . $account->{'srvr'} . _(" falling back to pop ")); } else { print(_("Failed to authenticate APOP on server") . $account->{'srvr'} . _(" falling back to pop\n")); } } } if (!$loggedin) { print $socket "USER $account->{'uname'}\r\n"; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } $answer = <$socket>; if (!$answer) { if ($inter == 1) { &main::err_dialog(_("No response from \"") . $account->{'srvr'} . "\".", "y", _("POP3 Connect Error")); } else { print(_("No response from ") . "$account->{'srvr'}\n"); } return; } elsif ($answer !~ /^\+OK/){ if ($inter == 1) { &main::err_dialog("Server \"" . $account->{'srvr'} . "\" said:\n\n" . $answer, "y", "POP3 Connect Error"); } else { print(_("Server ") . $account->{'srvr'} . "said:\n\n$answer\n"); } return; } print $socket "PASS $account->{'pass'}\r\n"; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } $answer = <$socket>; if ($answer !~ /^\+OK/){ if ($inter == 1) { &main::err_dialog(_("Server \"") . $account->{'srvr'} . "\" said:\n\n" . $answer, "y", _("POP3 Connect Error")); } else { print(_("Server ") . "$account->{'srvr'} said:\n\n$answer\n"); } return; } } print $socket "STAT\r\n"; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } $answer = <$socket>; $answer =~ /^\+OK (\d+) (\d+)/ and $count = $1; if ($count > 0) { print $socket "LIST\r\n"; $answer = <$socket>; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } if ($answer !~ /^\+OK/){ if ($inter == 1) { &main::err_dialog(_("Server \"") . $account->{'srvr'} . "\" said:\n\n" . $answer, "y", _("POP3 Connect Error")); } else { print(_("Server ")."$account->{'srvr'} said:\n\n$answer\n"); } return; } my @mails = (); my $i; while ($answer ne ".\n") { if ($answer =~ /(\d+) (\d+)/){ $mails[$1]->{'size'}=$2; $mails[$1]->{'getit'}='y'; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } } $answer = <$socket>; $answer =~ s/\r//g; $i++; } if (defined $status_dialog) { $status_dialog->{'progressbar'}->configure(0,0,$count); while (events_pending Gtk) { main_iteration Gtk; } } if (defined $account->{'dupecheck'} && $account->{'dupecheck'} eq 'y'){ # check for new mails # first check for UIDL support my $hastop=0; my $hasuidl=0; my @UIDLS; print $socket "UIDL\r\n"; $answer=<$socket>; if ($answer=~/^\+OK/){ $hasuidl=1; while ($answer ne ".\n"){ $answer=<$socket>; $answer=~s/\r//g; push(@UIDLS, $answer); } } else { # ...then check for TOP support print $socket "TOP 1 1\r\n"; $answer=<$socket>; if ($answer=~/^\+OK/){ $hastop=1; while ($answer ne ".\n"){ $answer=<$socket>; $answer=~s/\r//g; } } } if ($hastop==1){ # TOP support found. set statusbar... if (defined $status_dialog) { $status_dialog->{'progressbar'}->set_format_string("checking for new mails (TOP)"); while (events_pending Gtk) { main_iteration Gtk; } } for ($i=1;$i<=$count;$i++){ # let's check the mails print $socket "TOP $i 20\r\n"; $answer=<$socket>; $rawbody=""; $answer =~ /^\+OK/ or next; while ($answer ne ".\n"){ $answer=<$socket>; $answer=~s/\r//g; $rawbody=$rawbody.$answer; } ($header)=&main::parseHeader($rawbody); # okay, now lets check if the mail already exists my ($actionflag, $dupefound) = &main::checkForDupe($main::conn, $header->{'message-id'}, $account->{'id'}, $mails[$i]->{'size'}); if (defined $actionflag && $actionflag == 1){ push(@deletelist, $i); } elsif (defined $actionflag && $actionflag == 2) { push(@fetchlist, $i); } elsif (defined $actionflag && $actionflag == 3) { push(@fetchlist, $i); push(@deletelist, $i); } if (defined $dupefound){ $mails[$i]->{'getit'}='n'; } if (defined $status_dialog) { $status_dialog->{'progressbar'}->set_value($i); while (events_pending Gtk) { main_iteration Gtk; } } } # set account dupecheck to no, so it wont be checked in savemessage again $account->{'dupecheck'}='y'; $account->{'dupeworked'}='y'; } elsif($hasuidl==1) { # UIDL support found. set statusbar... if (defined $status_dialog) { $status_dialog->{'progressbar'}->set_format_string("checking for new mails (UIDL)"); while (events_pending Gtk) { main_iteration Gtk; } } my $hickup = 0; for my $msg_uidl (@UIDLS) { # let's check the mails my $i; ($i, $uidl) = split(/ /, $msg_uidl); $uidl =~ s/\n//g if ($uidl); if ($i =~ /^[0-9]/g){ $uidl = &main::uidlcleanup($uidl); # okay, now lets check if the mail already exists my ($actionflag, $dupefound) = &main::checkForDupeUIDL($main::conn, $uidl, $account->{'id'}, $mails[$i]->{'size'}); #print "doing $i -$actionflag-\n" if (defined $actionflag); if (defined $actionflag && $actionflag == 1){ push(@deletelist, $i); #print "nuking -$i-\n"; } elsif (defined $actionflag && $actionflag == 2) { push(@fetchlist, $i); } elsif (defined $actionflag && $actionflag == 3) { push(@fetchlist, $i); push(@deletelist, $i); } if (defined $dupefound){ $mails[$i]->{'getit'}='n'; } if (defined $status_dialog) { $status_dialog->{'progressbar'}->set_value($i); while (events_pending Gtk) { main_iteration Gtk; } } } if ($hickup==20) { # entertain the socket so it doesn't disconnect. print $socket "STAT\r\n"; $answer = <$socket>; $hickup=1; }; $hickup++; } # set account dupecheck to no, so it wont be checked in savemessage again $account->{'dupecheck'}='y'; $account->{'dupeworked'}='y'; } else { # no TOP support.. we have to check after the download $account->{'dupeworked'}='n'; } } # end dupecheck my ($error, $bigmessage); for( $i = 1; $i <= $count; $i++ ) { if (defined $status_dialog) { $percent = $i; $status_dialog->{'progressbar'}->set_value($percent); $status_dialog->{'progressbar'}->set_format_string("message %v of %u"); if ($mails[$i]->{'size'}>4096){ $div=1024; $status_dialog->{'mailprogressbar'}->set_format_string("downloaded %v of %u kb"); } else { $div=1; $status_dialog->{'mailprogressbar'}->set_format_string("downloaded %v of %u bytes"); } $status_dialog->{'mailprogressbar'}->configure(0,0,$mails[$i]->{'size'}/$div); while (events_pending Gtk) { main_iteration Gtk; } } # only get message if dupecheck is deactivated or the message is no dupe if (defined $account->{'dupecheck'} && (($account->{'dupecheck'} eq 'n') || ($account->{'dupecheck'} eq 'y' && $mails[$i]->{'getit'} eq 'y'))){ # my $uidl = ''; print $socket "UIDL $i\r\n"; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } $answer=<$socket>; if ($answer=~/^\+OK/){ $answer =~ /^\+OK (\d+) (.+)\r\n$/ and $uidl = $2; $uidl = "X-UIDL: $uidl\n"; } my $size = $mails[$i]->{'size'}; if($mails[$i]->{'size'} < ($main::prefs{'MaxFetchSize'} * 1000) || $main::prefs{'MaxFetchSize'} == 0) { print $socket "RETR $i\r\n"; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } $answer = <$socket>; $answer =~ /^\+OK/ or next; $answer = ""; $rawbody = ""; $mailsize=0; $error = undef; if ($size>4096) { if (-f "$main::prefs{'MailDir'}/big") { unlink("$main::prefs{'MailDir'}/big"); } open(BIG, ">>$main::prefs{'MailDir'}/big"); print BIG "From $main::prefs{'User'}" . &main::date_now . "\n"; print BIG $uidl; $bigmessage = 1; } while ($answer ne ".\n") { if ($size <4096) { $rawbody = $rawbody . $answer; } else { if ($answer =~ /^From /i) { $answer = ">".$answer; } print BIG $answer if $answer !~ /X-UIDL: /i; #trying to avoid having two X-UIDL's } $answer = <$socket> if (defined $socket); $mailsize+=length($answer); $answer =~ s/\r//g if ($answer); if (defined $status_dialog) { $status_dialog->{'mailprogressbar'}->set_value($mailsize/$div); while (events_pending Gtk) { main_iteration Gtk; } } } if (defined $bigmessage and $bigmessage == 1) { print BIG "\n"; close BIG; &main::import_from_mbox(undef, undef, undef, $main::conn, $main::prefs{'MailDir'}, "big", "get",$account->{'id'},$account->{'dm'}); $bigmessage = 0; $error="success"; unlink("$main::prefs{'MailDir'}/big"); } else { if($rawbody !~ /\nX-UIDL: /ig) { # If it does not find a X-UIDL it adds it on &main::wr_debug("$uidl"); $rawbody = $uidl . $rawbody; } if ($account->{'dm'} eq "y") { $error=&main::save_message($main::conn, $rawbody, \%filter, $account, undef, 0,$size); } else { $error=&main::save_message($main::conn, $rawbody, \%filter, $account, undef, 2,$size); } } } else { print $socket "TOP $i 30\r\n"; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } $answer=<$socket>; $rawbody=""; $answer =~ /^\+OK/ or next; while ($answer ne ".\n"){ $answer=<$socket>; $answer=~s/\r//g; $rawbody=$rawbody.$answer; } if($rawbody !~ /\nX-UIDL: /ig) { # If it does not find a X-UIDL it adds it on &main::wr_debug("$uidl"); $rawbody = $uidl . $rawbody; } my $size = int($mails[$i]->{'size'}/1000); $rawbody =~ s/\n\n/\n\n\nWarning: This message has not been fully downloaded. it is $size Kbytes.\n\n/; if ($account->{'dm'} eq "y") { $error=&main::save_message($main::conn, $rawbody, \%filter, $account, undef, 0,$size); } else { $error=&main::save_message($main::conn, $rawbody, \%filter, $account, undef, 1,$size); } } } elsif (defined $account->{'dupecheck'} && $mails[$i]->{'getit'} eq 'n'){ $error="success"; } else { $error=undef; }# end getmessage if ((defined $error) and ($account->{'dm'} eq "y")) { print $socket "DELE $i\r\n"; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } $answer = <$socket>; } } foreach $i (@fetchlist) { #&main::wr_debug("Fetching - $i, $uidl"); if (defined $status_dialog) { $percent = $i; $status_dialog->{'progressbar'}->set_value($percent); $status_dialog->{'progressbar'}->set_format_string("Fetching message %v of %u"); if ($mails[$i]->{'size'}>4096){ $div=1024; $status_dialog->{'mailprogressbar'}->set_format_string("downloaded %v of %u kb"); } else { $div=1; $status_dialog->{'mailprogressbar'}->set_format_string("downloaded %v of %u bytes"); } $status_dialog->{'mailprogressbar'}->configure(0,0,$mails[$i]->{'size'}/$div); while (events_pending Gtk) { main_iteration Gtk; } } print $socket "TOP $i 20\r\n"; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } $answer=<$socket> if ($socket); $rawbody=""; $answer = "" if ($answer =~ /^\+OK/); while ($answer ne ".\n"){ $answer=<$socket>; $answer=~s/\r//g if ($answer); $rawbody=$rawbody.$answer; } ($header)=&main::parseHeader($rawbody); print $socket "RETR $i\r\n"; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } $answer = <$socket> if ($socket); $answer = "" if ($answer =~ /^\+OK/); $rawbody = ""; $mailsize=0; $error = undef; if (-f "$main::prefs{'MailDir'}/ftmp") { unlink("$main::prefs{'MailDir'}/ftmp"); } open(BIG, ">>$main::prefs{'MailDir'}/ftmp"); print BIG "From $main::prefs{'User'}" . &main::date_now . "\n"; print BIG $uidl; $bigmessage = 1; while ($answer ne ".\n") { if ($answer =~ /^From /i) { $answer = ">".$answer; } print BIG $answer if $answer !~ /X-UIDL: /i; #trying to avoid having two X-UIDL's $answer = <$socket> if (defined $socket); $mailsize+=length($answer); $answer =~ s/\r//g if ($answer); if (defined $status_dialog) { $status_dialog->{'mailprogressbar'}->set_value($mailsize/$div); while (events_pending Gtk) { main_iteration Gtk; } } } print BIG "\n"; close BIG; my $fetchtempfile = "$main::prefs{'MailDir'}/ftmp"; $sql = "select id from messages where msgid = ?"; $query=$main::conn->prepare($sql); $query->execute($header->{'message-id'}); my ($id) = $query->fetchrow_array(); &Pronto::Data::Message::update_message_source($id,$fetchtempfile) if (defined $id); } foreach my $item (@deletelist) { &main::wr_debug("DELE $item\n"); print $socket "DELE $item\r\n"; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } $answer = <$socket>; } } print $socket "QUIT\r\n"; if (defined $status_dialog) { while (events_pending Gtk) { main_iteration Gtk; } } close($socket); return; } sub get_from_mbox { if (defined $status_dialog) { $status_dialog->{'mailprogressbar'}->hide; $status_dialog->{'statuslabel'}->set_text("Checking account $account->{'desc'}"); $percent = 0; $status_dialog->{'progressbar'}->set_value($percent); while (events_pending Gtk) { main_iteration Gtk; } } my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size)=stat $account->{'srvr'}; $size=$size/1024; if (defined $status_dialog) { $status_dialog->{'progressbar'}->configure(0,0,$size); $status_dialog->{'progressbar'}->set_format_string("Connecting..."); $status_dialog->{'mailprogressbar'}->hide; while (events_pending Gtk) { main_iteration Gtk; } } &main::read_from_mbox($main::conn, \%filter, $status_dialog, $account,$size); if (defined $status_dialog){ $status_dialog->{'mailprogressbar'}->show; while (events_pending Gtk) { main_iteration Gtk; } } } sub get_maildir { if ($account->{'srvr'} !~ /^(.*)\/$/){ $account->{'srvr'}.="/"; } unless (-e $account->{'srvr'} && -d $account->{'srvr'} && -e "$account->{'srvr'}new/" && -d "$account->{'srvr'}new/" && -e "$account->{'srvr'}cur/" && -d "$account->{'srvr'}cur/") { if ($inter == 1) { &main::err_dialog("Directory $account->{'srvr'} not found or not in Maildir format!","y"); } print (_("Directory ") . $account->{'srvr'} . _(" not found or not in Maildir format!\n")); return; } my (@maillist,$mailfile,$isdupe,$error,$div); if (defined $status_dialog) { $status_dialog->{'statuslabel'}->set_text("Checking account $account->{'desc'}"); $percent = 0; $status_dialog->{'progressbar'}->set_value($percent); $status_dialog->{'mailprogressbar'}->set_value($percent); $status_dialog->{'progressbar'}->configure(0,0,$percent); $status_dialog->{'mailprogressbar'}->configure(0,0,$percent); $status_dialog->{'progressbar'}->set_format_string("checking for new mails..."); while (events_pending Gtk) { main_iteration Gtk; } } # thanks to ish for that trick... my $tmpdir="$account->{'srvr'}new/"; opendir MAILDIR,$tmpdir; @maillist=grep !/^\.\.?$/, readdir(MAILDIR); closedir MAILDIR; if (scalar(@maillist)>0){ # okay, here we go, we have mails if (defined $status_dialog) { $status_dialog->{'progressbar'}->configure(0,0,scalar(@maillist)); while (events_pending Gtk) { main_iteration Gtk; } } # first set dupeworked, so dupes don't get checked in save_message again $account->{'dupeworked'}='y'; $i=1; foreach $mailfile (@maillist){ # read the file open MAIL, "<".$tmpdir.$mailfile; my (undef,undef,undef,undef,undef,undef,undef,$mailsize)=stat MAIL; if (defined $status_dialog) { $percent = $i; $status_dialog->{'progressbar'}->set_value($percent); $status_dialog->{'progressbar'}->set_format_string("message %v of %u"); if ($mailsize>4096){ $div=1024; $status_dialog->{'mailprogressbar'}->set_format_string("downloaded %v of %u kb"); } else { $div=1; $status_dialog->{'mailprogressbar'}->set_format_string("downloaded %v of %u bytes"); } $status_dialog->{'mailprogressbar'}->configure(0,0,$mailsize/$div); $status_dialog->{'mailprogressbar'}->set_value(0); while (events_pending Gtk) { main_iteration Gtk; } } $rawbody=""; while (my $line=){ $rawbody.=$line; if (defined $status_dialog) { $status_dialog->{'mailprogressbar'}->set_value(length($rawbody)/$div); while (events_pending Gtk) { main_iteration Gtk; } } } close MAIL; $isdupe='n'; # if dupecheck is defined, check for dupe if (defined $account->{'dupecheck'} && $account->{'dupecheck'} eq "y"){ my ($header)=&main::parseHeader($rawbody); if (defined &main::checkForDupe($main::conn, $header->{'message-id'}, $account->{'id'})){ $isdupe='y'; } } # save mail if it is no dupe if ($isdupe eq "n"){ $error=&main::save_message($main::conn, $rawbody, \%filter, $account); } if (defined $account->{'dm'} && $account->{'dm'} eq "y" && defined $error){ # if delete messages is active, and save_message is successful delete the message... unlink($tmpdir.$mailfile); } else { # move it to read mails rename($tmpdir.$mailfile, $account->{'srvr'}."cur/".$mailfile.":2,S"); } $i++; } } return; } sub init_sd { my ($sd_pbar, $sd_label, $sd_button, $sd_vbox); $status_dialog = new Gtk::Dialog; $status_dialog->signal_connect("destroy" => sub { $status_dialog->destroy; }); $status_dialog->signal_connect("delete_event" => sub { $status_dialog->destroy; }); $status_dialog->set_title(_("Transfering E-Mail...")); if ($main::prefs{'AutoCheckProgress'} == 0) { $status_dialog->position(-mouse); } $status_dialog->border_width(5); $sd_vbox=new Gtk::VBox(0,5); $sd_vbox->border_width(5); $status_dialog->vbox->pack_start($sd_vbox,1,1,0); $sd_vbox->show; $status_dialog->{'statuslabel'}=new Gtk::Label _("Logging On"); $status_dialog->{'statuslabel'}->set_alignment(0.5,0.5); $sd_vbox->pack_start($status_dialog->{'statuslabel'},0,1,0); $status_dialog->{'statuslabel'}->show; $status_dialog->{'progressbar'}=new Gtk::ProgressBar; $status_dialog->{'progressbar'}->set_usize(200,20); $status_dialog->{'progressbar'}->set_show_text(1); $status_dialog->{'progressbar'}->set_text_alignment(0.5,0.5); $status_dialog->{'progressbar'}->set_format_string("message %v of %u"); $status_dialog->{'progressbar'}->configure(0,0,0); $sd_vbox->pack_start($status_dialog->{'progressbar'},1,1,0); $status_dialog->{'progressbar'}->show; $status_dialog->{'mailprogressbar'}=new Gtk::ProgressBar; $status_dialog->{'mailprogressbar'}->set_usize(200,20); $status_dialog->{'mailprogressbar'}->set_show_text(1); $status_dialog->{'mailprogressbar'}->set_text_alignment(0.5,0.5); $status_dialog->{'mailprogressbar'}->set_format_string("downloaded %v of %u bytes"); $status_dialog->{'mailprogressbar'}->configure(0,0,0); $sd_vbox->pack_start($status_dialog->{'mailprogressbar'},1,1,0); $status_dialog->{'mailprogressbar'}->show; $sd_button=new Gtk::Button "Hide Status"; $sd_button->signal_connect("clicked" => sub { $status_dialog->destroy; }); $sd_button->can_default(1); $status_dialog->action_area->pack_start($sd_button,1,1,0); $sd_button->grab_default; $sd_button->show; $status_dialog->show; while (events_pending Gtk) { main_iteration Gtk; } return 1; } 1;