#!/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__
[download]