File Coverage

blib/lib/Mail/Pegasus.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

#!/usr/bin/perl -w
#

package Mail::Pegasus;

require 5.005;

use strict;

use vars qw($VERSION);

#use IO::Scalar;
use Mail::Internet;

$VERSION=sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/);

my $debug = 0;
my $directory = undef;
my $heirarch = "HIERARCH.PM";

sub new
{
  my $self =  shift;
  my $this = {};
  my %arg = @_;

  $debug = (exists $arg{Debug} ? $arg{Debug} : 0 );
  $this->{heirarch} = (exists $arg{Heirarch} ? $arg{Heirarch} : "HIERARCH.PM" );
  $this->{directory} = (exists $arg{Directory} ? $arg{Directory} : undef );

  bless $this;

  &init($this);
  return $this;
}

sub init
{
  my $self = shift;

  my %folders=();
  my %parents=();
  my $parentrootid=1;
  my @parentroots=();
  my %ifolders=();

  $self->{'folders'} = \%ifolders;

  warn("Directory: $self->{directory}\n");
  if ((!defined($self->{directory})) || (! -d $self->{directory}))
  {
    warn("You must specify a valid directory!\n");
    return;
  }

  my $h = $self->{directory} . "/" . $self->{heirarch};
  if ((! -f $h) || (! -r $h))
  {
    warn("cannot read hierachy file!\n");
    return;
  }

  open(HFD,"<$h");
  while(!eof(HFD))
  {
    my @fields;
    my ($line, $n1, $n2, $folderid, $parent, $name);

    chomp($line=);
    $line =~ s/\r$//;
    printf("<<$line\n") if ($debug);
    @fields = split(/,/,$line);
    if (scalar @fields != 5)
    {
      warn("Can't parse line [$line]\n");
    }
    map($_ =~ s/^"//,@fields);
    map($_ =~ s/"$//,@fields);
    $n1 = $fields[0];
    $n2 = $fields[1];
    $folderid = $fields[2];
    $parent = $fields[3];
    $name = $fields[4];
    if ($folderid eq "")
    {
      warn("Found BLANK folder ID in line [$line]. Skipping\n");
      next;
    }
    if ($parent eq "")
    {
      if ($folderid =~ /:My mailbox$/)
      {
        $parent = "TOP00";
      } else {
        $parent = sprintf("TOP%.2d",$parentrootid++);
      }
      push(@parentroots,$parent);
    }
    printf(">>%s,%s,%s,%s,%s\n",$n1,$n2,$folderid,$parent,$name) if ($debug);

    if (exists($folders{$folderid}))
    {
      warn("Found duplicate folder ID $folderid\n");
    } else {
      $folders{$folderid} = {
                              'n1'      => $n1,
                              'n2'      => $n2,
                              'parent'  => $parent,
                              'name'    => $name,
                              'used'    => 0,
                            };
      printf("++%s->%s\n",$folderid, $parent) if ($debug);
      push(@{$parents{$parent}},$folderid);
    }
  }
  foreach my $parentroot (sort @parentroots)
  {
    &recursefolders(\%ifolders, \%parents, \%folders, $parentroot,$parentroot);
  }
  foreach my $ifolder (sort {length($a) <=> length($b)} keys %ifolders) {
    my $file = sprintf("%s/%s.PMM",$self->{directory},$ifolders{$ifolder});
    if (-f $file)
    {
      $ifolders{$ifolder} = $file;
    } else {
      $ifolders{$ifolder} = "";
    }
    printf("%s -> %s\n",$ifolder,$ifolders{$ifolder}) if ($debug);
  }
  close(FD);

  # INBOX is a special case and partly a hack.
  $ifolders{'INBOX'} = "INBOX";
  $self->{Folders} = \%ifolders;
}

sub recursefolders
{
  my $ifolders = shift;
  my $parents = shift;
  my $folders = shift;
  my($parent,$path) = @_;
  my($fpath,$folder);
  foreach my $folderid (@{$parents->{$parent}}) {
    $fpath = sprintf("%s|%s",$path,$folders->{$folderid}->{name});
    # printf(">>>%s\n",$fpath);
    if (exists($parents->{$folderid})) {
      &recursefolders($ifolders,$parents,$folders,$folderid,$fpath);
    } else {
      printf(">>>%s\n",$fpath) if ($debug);
      $fpath =~ s/^TOP\d{2}\|//;
      $fpath =~ s/^My mailbox\|//;
      $fpath =~ s/\|/\//g;
      $folderid =~ s/^[0-9A-F]+://;
      $folderid =~ s/^[0-9A-F]{4}://;
      $ifolders->{$fpath} = $folderid;
    }
  }
}

sub select_by_id
{
  my $self = shift;
  my $f = shift;
  my $result = undef;

  $self->{'Selected'} = undef;

  if ($f !~ /^\d+$/)
  {
    warn("You must specify a number!\n");
  } else {
    if (defined($self->{Folders}))
    {
      my $x = $self->{Folders};
      my $count = 1;
      my $fname;
      foreach my $fi (sort keys %$x)
      {
        $fname = $fi;
        last if ($count eq $f);
        $count++;
      }
      $f = $fname;
      warn("select(): selected->$f\n") if ($debug);
      &select($self, $f);
      $result = $self;
    }
  }
  return $result;
}

sub select
{
  my $self = shift;
  my $f = shift;
  my $result = undef;

  $self->{'Selected'} = undef;

  if ($f eq "")
  {
    warn("You must specify a folder name or number!\n");
  } else {
    if (defined($self->{Folders}))
    {
      my $x = $self->{Folders};

      if (defined($x->{$f}) && $x->{$f} ne "")
      {
        $self->{Selected} = $x->{$f};
        if ($f eq "INBOX")
        {
          build_inbox_hash($self);
        } else {
          build_folder_hash($self);
        }
        $result = $self;
      } else {
        warn("$f does not appear to exist!\n");
      }
    }
  }
  return $result;
}

sub list_folders
{
  my $self = shift;
  my $folder_array = [ ];

  foreach my $folder (sort keys %{$self->{Folders}})
  {
    push(@$folder_array, $folder);
  }
  warn("\@folder_array contains: \"" . join("\", \"", @$folder_array) . "\"\n") if ($debug);
  return $folder_array;
}

sub print_folders
{
  my $self = shift;
  my $count = 1;

  foreach my $folder (sort keys %{$self->{Folders}})
  {
    printf("%d. %s\n", $count, $folder);
    $count++;
  }
}

sub find_first_message
{
  my $self = shift;
  my $file;
  my $data;
  my $count = 0;
  my $ffile;

  if (!defined($self->{Selected}))
  {
    warn("No folder selected!\n");
    return undef;
  }
  $file = $self->{Selected};
  warn("find_first_message(): selected->$file\n") if ($debug);

  if (!-r $file)
  {
    die("Cannot Open File: $@");
  }

  $file =~ /^[\S+\/]*\/(\S+)\.PMM$/ && ($ffile = $1);

  open FOLDER, "$file";
  until ($data =~ /$ffile/ || eof FOLDER)
  {
    seek FOLDER, $count++, 0; # 0 = SEEK_SET
    read FOLDER, $data, length($ffile); # read until we find the folder name
  }
  warn("find_first_message(): Found filename [$ffile] at $count byte\n") if ($debug);
  $count += length($ffile);
  $count++;

  # this is a really bad hack, but it seems to work..
  until ($data =~ /R/ || eof FOLDER)
  {
    read FOLDER, $data, 1, $count++;
  }
  # $count now has the starting byte in the file of the first message
  close FOLDER;
  return $count;
}

sub get_message
{
  my $self = shift;
  my $id = shift;

  my $data = "";
  my $file = "";

  my $selected = $self->{Selected};
  if ($selected eq "INBOX")
  {
    $file = $self->{$selected}->{$id}->{File};
  } else {
    $file = $selected;
  }
  my $msg_start = $self->{$selected}->{$id}->{Start};
  my $msg_length = $self->{$selected}->{$id}->{Length};

  open FOLDER, "<$file";
  seek FOLDER, $msg_start, 0; # 0 = SEEK_SET
  read FOLDER, $data, $msg_length;
  close FOLDER;

  return $data;
}

sub message
{
  my $self = shift;
  my $id = shift;
  my $result = undef;

  my $message = get_message($self, $id);
  $result = new Mail::Internet [ $message =~ /(.*?\n)/g ];
  return $result;
}

sub head
{
  my $self = shift;
  my $id = shift;
  my $result = undef;

  $result = {message($self, $id)}->head();
  return $result;
}

sub body
{
  my $self = shift;
  my $id = shift;
  my $result = undef;

  $result = {message($self, $id)}->body();
  return $result;
}

sub get_message_status
{
  my $self = shift;
  my $id = shift;
  my $result = undef;

  my $message = get_message($self, $id);
  my $mail = new Mail::Internet [ $message =~ /(.*?\n)/g ];
  my $mail_headers = $mail->head();
  my $headers_ref = $mail_headers->header_hashref();
  # print Dumper($headersRef);
  if (defined($headers_ref->{'X-Pmflags'}))
  {
    $result = 1;
  }
  if (defined($headers_ref->{'X-PM-Placeholder'}))
  {
    $result = 0;
  }
  return $result;
}

sub find_message
{
  my $fh = shift;
  my $start = shift;

  my $msg = "";
  my $char = "";
  my $count = 1;
  my $eof = sprintf("%c", 26);

  seek $fh, $start, 0; # 0 = SEEK_SET
  until(eof $fh)
  {
    read $fh, $char, 4096; # average message size is less than 4k
    my $pos = index $char, $eof;
    # warn ("$count -> $pos\n") if ($debug);
    if ($pos > 0)
    {
      $count += $pos;
      last;
    } else {
      $count += 4096;
    }
  }

  # reset and read message
  seek $fh, $start, 0; # 0 = SEEK_SET
  read $fh, $msg, $count;

  return ($msg,$count);
}

sub build_inbox_hash
{
  my $self = shift;
  my $current_folder = "INBOX";
  my $id = 0;
  my $directory = $self->{directory};

  warn("Building hash for $current_folder ($directory)\n") if ($debug);

  opendir DIR, "$directory" or return undef;

  foreach my $file (readdir(DIR))
  {
    if ($file =~ /\.CNM/ && -f "$directory/$file")
    {
      my $folder_info_ref = {};
      my $size = -s "$directory/$file";
      warn("build_inbox_hash: Adding: $directory/$file ($size bytes)\n") if ($debug);
      $self->{$current_folder}->{$id} = $folder_info_ref;
      $self->{$current_folder}->{$id}->{'Start'} = 0;
      $self->{$current_folder}->{$id}->{'Length'} = $size;
      $self->{$current_folder}->{$id}->{'File'} = "$directory/$file";
      $id++;
    }
  }
  closedir DIR;
}

sub build_folder_hash
{
  my $self = shift;
  my $current_folder = $self->{'Selected'};
  my $id = 0;

  warn("Building hash for folder: $self->{'Selected'}\n") if ($debug);
  $self->{FirstMsg} = find_first_message($self);
  $self->{MessageStart} = $self->{FirstMsg};
  warn("First Message Header found at: $self->{FirstMsg}\n") if ($debug);
  open FOLDER, "<$current_folder";
  seek FOLDER, $self->{FirstMsg}, 0; # 0 = SEEK_SET
  until(eof FOLDER)
  {
    my $folder_info_ref = {};
    my ($message, $record_length) = find_message(\*FOLDER, $self->{MessageStart});

    $self->{$current_folder}->{$id} = $folder_info_ref;
    $self->{$current_folder}->{$id}->{'Start'} = $self->{MessageStart};
    $self->{$current_folder}->{$id}->{'Length'} = ($record_length-1);

    $self->{MessageStart} += $record_length;
    $id++;
  }
  close FOLDER;
}

sub messages
{
  my $self = shift;
  my $id = 0;

  if (!defined($self->{Selected}))
  {
    warn("No folder selected!\n");
  } else {
    my $file = $self->{Selected};
    foreach my $f (sort keys %{$self->{Folders}})
    {
      if ($file eq $self->{Folders}->{$f})
      {
        print "Folder: $f\n" if ($debug);
        last;
      }
    }

    until(!defined($self->{$self->{'Selected'}}->{$id}))
    {
      $id++;
    }
  }
  return $id;
}

sub list_messages
{
  my $self = shift;
  my $result = undef;
  my $id = 0;
  my $ret = 0;

  my $data;
  my $date;
  my $subject;

  if (!defined($self->{Selected}))
  {
    warn("No folder selected!\n");
  } else {
    $ret = 1;
    my $file = $self->{Selected};
    foreach my $f (sort keys %{$self->{Folders}})
    {
      #print "Folder: $self->{Folders}->{$f}\n";
      if ($file eq $self->{Folders}->{$f})
      {
        print "Folder: $f\n";
        last;
      }
    }

    until(!defined($self->{$self->{'Selected'}}->{$id}))
    {
      my $message = get_message($self, $id);
      # print("Message:\n" . $message . "\n");
      my $mail = new Mail::Internet [ $message =~ /(.*?\n)/g ];
      my $mail_headers = $mail->head();
      my $headers_ref = $mail_headers->header_hashref();
      if (defined($headers_ref->{'Date'}))
      {
        $date = join(", ", @{$headers_ref->{'Date'}});
        chomp($date);
        $date =~ s/\(\S+\)//g;
      } else {
        $date = "No Date Header!";
      }
      if (defined($headers_ref->{'Subject'}))
      {
        $subject = join("", @{$headers_ref->{'Subject'}});
        $subject =~ s/\n//g;
        chomp($subject);
      } else {
        $subject = "[No Subject]";
      }
      printf("ID: $id \tDate: $date \tSubject: $subject\n");
      $id++;
    }
  }
  return $ret;
}

1;

__END__