[MacPerl] Introduction - and a mailbox viewer program

[Ken Williams <ken@forum.swarthmore.edu>]

Hi folks,

I'm pretty new to this list, so I thought I'd preface this post with a
bit of an introduction: "hi".  I'm not new to Perl or the Mac, or even
MacPerl really, just the MacPerl mailing list.  I've been hanging out
on the mod_perl mailing lists and stuff.

Anyway, on to the main point.  I've got a little script here that I bet
someone might find useful (once it's finished, anyway =).  It's a
mailbox viewer, meaning it opens a Unix-style mailbox file (which is
now Eudora, etc. store their mail), shows you a table-of-contents, and
lets you view, search, or whatever.  The idea is that it's just a
lightweight Perl app that can be used to complement a real mail program
- I'd use it mainly to revisit mail that I've offloaded into archive
mailbox files.  My mail program (Mailsmith) doesn't really like having
too many messages in its "active" mailbox at once.

The program isn't complete yet - so far it properly reads the mailbox
file and paints a table-of-contents window, but the entries in it
aren't clickable, and it doesn't scroll, etc.  The mailbox parsing code
is pretty buff, it runs fast and is quite memory-efficient.  That part
has gone through about 4 revisions. =)

I'm posting in case someone out there is interested in this code,
and/or might want to extend it into something actually useful.  I
certainly have no plans to ever charge money for such a thing - I just
think it's kind of fun to build, and might be a nice addition to the
free mail tools out there for the Mac.

I'm particularly non-familiar with the Mac-specific parts of the script
- how to properly open the windows, how to do file selection (nav
services available?), etc.  Any corrections or improvements in this
area are most welcome, as well as pointers to good resources where I
can learn.

By the way, Chris, you might notice some similarity to the MP3 player
script you posted a while back - I used that as a starting point for
this.
---------------------------------------------------------------------


use strict;
use File::Basename;
use Mac::Events;
use Mac::Files;
use Mac::Fonts;
use Mac::Movies;
use Mac::QuickDraw;
use Mac::Windows;
use Mac::Events qw(@Event $CurrentEvent);
use Mac::Menus;
use Mac::StandardFile;
my($win, $file, $curr, @messages, $tottime, $oldEdit, $oldFile, $oldEditor,
   $newMenu, $newEdit, $newFile, $OK, $QUIT);
local *FILE;

MacPerl::Quit(1);
#Change Menu Bar
$oldEdit   = GetMenuHandle(130);
$oldFile   = GetMenuHandle(129);
$oldEditor = GetMenuHandle(133);
$newMenu   = new_menu();
$newEdit   = $$newMenu[0]->{menu};
$newFile   = $$newMenu[1]->{menu};
change_menu_bar();
DisableItem($newEdit, 1);
DisableItem($newEdit, 2);
DisableItem($newEdit, 3);
DisableItem($newEdit, 4);

until ($QUIT) {
    make_window();
    start_mailfile($file);
    WaitNextEvent while ($win->window && draw_window() && !$OK);
    $win->dispose if defined $win;
    @messages = ();
    $OK = 0;
}

sub make_window {
    my ($x1, $y1, $x2, $y2) = (100, 100, 700, 400);

    my $bounds = Rect->new($x1, $y1, $x1 + $x2, $y1 + $y2);
    $win = MacWindow->new($bounds, "Mail Viewer", 1, documentProc, 1);
    $win->sethook( redraw => \&draw_window );
    #$win->sethook( drawgrowicon => sub {0} );

    SetPort($win->window);

    END {
        $win->dispose if defined $win;
    }
}

sub start_mailfile {
    if (get_mailbox($file)) {
        get_mailbox_list($file);
        #$win->new_movie($movie, Rect->new(0, 108, $x2, $y2));
    }
}

sub get_mailbox {
    $file = shift || ask_for_file();
    return unless $file;
    SetWTitle($win->window, basename($file));

    close FILE;
    unless (open FILE, $file) {
        warn "Can't open $file: $!";
        quit();
        return;
    }
    return 1;
}

sub draw_window {
    my($front, $back) = (GetForeColor(), GetBackColor());
    my @pos = (10,55,155,255);

    TextFont(geneva());
    TextSize(9);
    TextFace(bold());
      MoveTo($pos[1], 15);
      DrawString("Date");
      MoveTo($pos[2], 15);
      DrawString("From");
      MoveTo($pos[3], 15);
      DrawString("Subject");
    TextSize(9);
    TextFace(normal());

    my $x = 15;
    foreach (@messages) {
        $x += 15;
        MoveTo($pos[0], $x);
        DrawString("$_->{location}:");
        MoveTo($pos[1], $x);
        DrawString("$_->{'Received'}");
        MoveTo($pos[2], $x);
        DrawString("$_->{'From'}");
        MoveTo($pos[3], $x);
        DrawString("$_->{'Subject'}");
    }

    1;
}

sub get_mailbox_list {
    # This routine scans the mbox file and fills up the @messages array.
    seek FILE, 0, 0;
    @messages = ();

    # The goals here: don't read huge portions of the file into memory at once.
    # We go line-by-line in the body of the message, but read the headers in one
    # big slurp.  The assumption is that the headers are never unreasonably long,
    # which is pretty much true.  The body might contain large attachments, though,
    # so we have to read it line-by-line unless we want the wrath of the memory manager.
    my $i = 0;
    while (<FILE>) {
        if (/^From /) {
            local $/ = ''; # Paragraph mode - gobble up the headers
            $_ = <FILE>;
            while (/^(From|Received|Subject|Date): (.*?)\n(?!\t)/smg) {
                $messages[$i]{$1} = $2 unless exists $messages[$i]{$1};
                # If we cared, we could also replace \n\t with a space
            }
            $messages[$i]{'location'} = tell(FILE) - length();
            $i++;
        }
    }


#    # This version is more complicated.
#    my $in_header = 0;
#    my $line;
#    my $i = -1;
#    while (<FILE>) {
#        if ($in_header) {
#            if (/^\t/) {
#                $line .= $_;
#                next;
#            }
#            
#            if (defined $line  and  $line =~ /^(From|Received|Subject|Date): (.*)/s) {
#                # We're still in the header
#                $messages[$i]{$1} = $2 unless exists $messages[$i]{$1};
#                
#            } elsif (length() == 1) {
#                # print "End of header at line $.\n";
#                $in_header = 0;
#                $line = '';
#            }
#            $line = $_;
#        } else {
#            if (/^From /) {
#                $messages[++$i]{'location'} = tell(FILE) - length();
#                $in_header = 1;
#            }
#        }
#    }
    
    foreach my $msg (@messages) {
        $msg->{Date} =~ /\w{3}, (\d+) (\w{3}) (\d{4}) (\S)/;
        $msg->{From} = &parse_fromline($msg->{From});
        $msg->{Received} = &parse_received($msg->{Received});
    }
    
    1;
}

sub date_regex {'(?:\w\w\w,)?\s+ (\d+)\s+  (\w\w\w)\s+  (\d\d\d\d)\s+ (\d\d:\d\d:\d\d)'}

sub format_date {
    # XXX Doesn't deal with the time zone shift yet.
    my ($day, $mon, $year, $time) = @_;
    my $i = 1;
    my %trans = map {$_, $i++} 
                    qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    return "$trans{$mon}/$day/$year $time";
}

sub parse_received {
    # Extract date & time from the Received header
    my $header = shift;
#    print $header;
    my @result;
    return &format_date(@result) if @result = $header =~ /;\s+@{[date_regex]}/ox;
    return "(none)";
}

sub parse_date {
    # Extract date & time from the Date header
    my $header = shift;
    my @result;
    return &format_date(@result) if @result = $header =~ /:\s+@{[date_regex]}/ox;
    return "(none)";
}

sub parse_fromline {
  local $_ = shift;

  return $1    if  /\S+ \((.+)\)/;             # user@host.org (Bob User)
  return $1    if  /^\s*"?([^<"]*)"?\s*<.*>/;  # Bob User <user@host.org>
  return $1    if  /^\s*(\S*\@\S*)\s*$/;       # user@host.org

  return "<???>";  # Give up
}



sub ask_for_file {
    my $lfile = StandardGetFile(sub {0}, 0);
    return unless $lfile->sfGood;
    $lfile->sfFile;
}
sub change_menu_bar {
    DeleteMenu(133);
    DeleteMenu(130);
    DeleteMenu(129);
    InsertMenu $newEdit, 133;
    InsertMenu $newFile, 2048;
    DrawMenuBar()
}

sub restore_menu_bar {
    DeleteMenu(2048);
    DeleteMenu(2049);
    InsertMenu($oldEdit,   133);
    InsertMenu($oldFile,   130);
    InsertMenu($oldEditor, 134);
    DrawMenuBar()
}
sub new_menu {
    my $newEdit = MacMenu->new (
        2048, 'Edit', (
            ['Cut',   \&edit_menu, 'X'],
            ['Copy',  \&edit_menu, 'C'],
            ['Paste', \&edit_menu, 'V'],
            ['Clear', \&edit_menu,  ''],
        )
    );
    my $newFile = MacMenu->new (
        2049, 'File', (
            ['OpenS', \&file_menu, 'O'],
            [],
            ['Close', \&file_menu, 'W'],
            [],
            ['Quit', \&file_menu, 'Q'],
        )
    );
    [$newEdit, $newFile]
}

sub edit_menu {
    my ($menu, $item) = @_;
    return 1
}

sub file_menu {
    my ($menu, $item) = @_;
    if ($menu == 2049) {
        if    ($item == 1)                { $OK = 1; $file = ''; } # Open
        elsif ($item == 3 or $item == 5)  { quit() } # Close or Quit
    }
}
sub quit {
    $OK = 1;
    $QUIT = 1;
}
END {
    restore_menu_bar();
    $win->dispose if defined $win;
    DisposeMenu($newEdit) if defined $newEdit;
    DisposeMenu($newFile) if defined $newFile;
}

__END__

  -------------------                            -------------------
  Ken Williams                             Last Bastion of Euclidity
  ken@forum.swarthmore.edu                            The Math Forum



===== Want to unsubscribe from this list?
===== Send mail with body "unsubscribe" to macperl-request@macperl.org