| Description: | Another app to preview your pop3 headers. This one is all mouse oriented. Middle Click on entry to view headers, Click to select, Right Click to mark for deletion. You can select multiple msgs with Shift-Click. All the deletes are done at once, since Net::POP3 only does deletes when it exits. For those who don't care about pop3, this is a nice simple example of using an "indicator" on an HList. UPDATE: Fixed an array dereference problem UPDATE2: I realized that I was downloading the headers twice, once to get the From and Subject, then again if you wanted to view the headers. So this update, puts all the headers into a hash so you don't need to retreive them again. Also fixed the X pixmap. |
#!/usr/bin/perl -w
use warnings;
use strict;
use Net::POP3;
use Tk;
use Tk::HList;
use Tk::ErrorDialog;
my $ServerName = "mail.fefifo.net";
my $UserName = "greengiant";
my $Password = "beans";
my %messages;
#update2
my %headers; #hash to store headers so they are
#only downloaded once
my $messcheck = '';
my $pop3;
my $from;
my $subject;
my $size;
my $delbutton;
my $connectbutton;
my $indicator = <<"EOD";
/* XPM */
static char * pixmap[] = {
/* width height num_colors chars_per_pixel */
" 16 12 3 1 ",
/* colors */
" s None c None",
". c black",
"X c red",
/* pixels */
"XXXX........XXXX",
".XXXX......XXXX.",
"..XXXX....XXXX..",
"...XXXX..XXXX...",
"....XXXXXXXX....",
".....XXXXXX.....",
".....XXXXXX.....",
"....XXXXXXXX....",
"...XXXX..XXXX...",
"..XXXX....XXXX..",
".XXXX......XXXX.",
"XXXX........XXXX"};
EOD
my $mw = MainWindow->new();
$mw->geometry('800x700+100+15');
my $delindicator = $mw->Pixmap(-data => $indicator);
$mw->bind('<Control-c>', [\&do_quit] );
$mw->bind('<ButtonRelease-3>', \&del_select);
$mw->bind('<ButtonPress-2>', \&browseThis);
my $frame = $mw->Frame(-bg => 'black')->pack(-fill => 'x');
$frame->Label(-bg =>'black', -fg => 'green',
-text=> "Click to select, shift-click selects multi,
Right Click to mark for delete,
Middle Click to view headers")
->pack(-side=>'left',-padx=>10);
$frame->Button(-text=>'Exit', -bg => 'yellow',
-command => [ \&do_quit ],
)->pack(-side => 'right');
$delbutton = $frame->Button(-text=>'Do Delete', -bg => 'red',
-state => 'disabled',
-command => [\&do_delete]
)->pack(-side => 'left');
$connectbutton = $frame->Button(-text=>'Connect', -bg => 'lightgreen',
-command => [\&check_pop],
)->pack(-side => 'right', -padx=> 40);
my $h = $mw->Scrolled( 'HList',
-indicator => 1,
-columns => 1,
-takefocus => 1,
-indent=> 20,
-background => 'steelblue',
-foreground =>'snow',
-selectmode => 'multiple',
-selectforeground => 'pink',
-selectbackground => 'black',
)->pack(-side => 'top', -anchor => "n",-fill=>'both',-e
+xpand=>1);
my $text = $mw->Scrolled('Text',-scrollbars=>'se', -bg => 'lightyellow
+',
)->pack(-side => 'bottom',-fill=>'both', -expand=
+>1);
MainLoop;
######################################################################
+#
sub check_pop{
while (my ($key, $value) = each %headers) {
delete $headers{$key}; # clean out old headers
}
$h->delete('all');
$h->update;
$text->delete('1.0','end');
$text->update;
$pop3 = Net::POP3->new($ServerName)||die("Couldn't log on to server\n"
+);
my $num_messages = $pop3->login($UserName, $Password)||die("Bad userna
+me or password\n");
my $messages = $pop3->list();
if ($num_messages == 0){ &no_messages; return }
$connectbutton->configure(-state => 'disabled');
foreach my $msg_id(keys %{$messages}) {
my @header =(); #array for headerlines
my @top = (); #array for top of messagebody
my $messref = $pop3->top($msg_id,10);
$size = $pop3->list($msg_id);
while(1){
my $line = shift @$messref;
last if $line =~ /^\s*$/;
push(@header,$line);
}
#check From
my($from) = grep(/^From:/io,@header);
chomp $from;
#check Subject
my ($subject) = grep(/^Subject:/io,@header);
chomp $subject;
my $messtring = "$msg_id $from \n\t$subject $size";
$h->add($msg_id, -text=>$messtring, -data => $msg_id );
$h->update;
$headers{$msg_id} = \@header;
}
$delbutton->configure(-state => 'normal');
}
##########################################################
sub do_quit{ if(ref $pop3 =~ /Net::POP3/){$pop3->quit}
Tk::exit;
}
###########################################################
+
sub browseThis{
print chr(07);
my @msgs = $h->info('selection');
my $msg = $msgs[0];
#update2 changes
#my $messref = $pop3->top($msg,10); #bad getting twice
$text->delete('1.0','end');
#$text->insert('end', @$messref);
$text->insert('end', @{$headers{$msg}});
}
#############################################################
sub del_select{
my @sels = $h->info('selection');
foreach my $ent (@sels){
if($h->indicator('exists',$ent)){$h->indicator('delete',$ent)}
else{
$h->indicator('create', $ent,
-itemtype => 'image',
-image => $delindicator,
);
}
}
}
############################################################
sub do_delete{
my $ent;
$text->delete('1.0','end');
$text->update;
foreach $ent ($h->info('children')){
if($h->indicator('exists',$ent)){
$pop3->delete($ent);
$h->delete('entry',$ent);
$text->insert('end', "DELETING $ent\n");
$text->update;
}
}
$pop3->quit; #needed to actually delete
$connectbutton->configure(-state => 'normal');
}
#######################################################
sub no_messages{
$text->delete('1.0','end');
for(1..5){
$text->insert('end', "NO NEW MESSAGES\n");
}
print chr(07);
}
__END__
|
|
| comment on Tk-POP3-previewer Download Code | |
|---|---|
| Re: Tk-POP3-previewer by Discipulus on May 06, 2004 at 08:16 UTC | |
ARRAY(0x2064544)??? cheers lorenzo | [reply] |
by zentara on May 06, 2004 at 15:42 UTC | |
sub browseThis{
print chr(07);
my @msgs = $h->info('selection');
my $msg = $msgs[0];
my $messref = $pop3->top($msg,10);
$text->delete('1.0','end');
####RIGHT HERE#################
#$text->insert('end', $messref);
$text->insert('end', @$messref);
}
Come to think of it, maybe I should change that, I never thought about it, because on my system, the $messref prints out as a string. I'm not really a human, but I play one on earth. flash japh | [reply] d/l code |
by mawe on May 06, 2004 at 16:17 UTC | |
I had the same problem as Discipulus on Linux (RedHat). Changed the code as you suggested, now it works. BTW: Greate code (zentara++) | [reply] |
by eserte on May 06, 2004 at 16:43 UTC | |
perl -MTk -e '$txt = tkinit->Text->pack; $txt->insert("end", [1,2,3]);
+MainLoop'
So to be portable: always write my($result) = $w->method instead of my $result = $w->method (e.g. for Tk::Listbox::curselection) and do not use the arrayref forms where it is possible (e.g. in Tk::Canvas::createLine).
| [reply] d/l code |
| Re: Tk-POP3-previewer by eserte on May 06, 2004 at 09:40 UTC | |
| [reply] |
| Re: Tk-POP3-previewer by zentara on May 06, 2004 at 18:16 UTC | |
I originally did it that way, so you could top a different amount if going for the headers, so as to grab the first few lines of the body. So if anyone wants to experiment with that aspect, thats what it was all about. Just change the 10 to a 20 to get more. I'm not really a human, but I play one on earth. flash japh | [reply] |