[EMAIL PROTECTED] (Andreas J. Koenig) wrote:
> Steve Traugott <[EMAIL PROTECTED] said:
>
> > I've got an API module for interacting with MH mail folders via a tied
> > hash -- it's attached for reference.
>
> > Question is name -- which of the following do folks prefer?
>
> > Mail::Tie::mh
> > Mail::TieMH
> > Tie::MH
> > ...any others?
>
> I'd say Mail::TieMH or Mail::MH. The latter because imho the fact that
> you are tie-ing does not really need to be reflected in the name.
Copying to Charles Hardin <[EMAIL PROTECTED]> due to his
intent to post Mail::NMH and his research into the (defunct?) Mail::MH
(http://www.xray.mpe.mpg.de/mailing-lists/modules/2000-09/msg00010.html).
Charles, I don't see Mail::NMH in your CPAN directory yet -- what's
its interface; tied or methods or what?
Other thoughts about this... What I'd really like to do is start
Mail::Tie::* as a tree of similarly tied interfaces to common
mailboxes -- i.e. Mail::Tie::mbox, Mail::Tie::IMAP, etc. The only
drawback I can see is that that might give people the impression that
I "own" Mail::Tie::*, when in fact I'd like nothing more than to
encourage others to add to the tree.
The thing most stopping me is the statement in
http://www.cpan.org/modules/00modlist.long.html that says "Please
avoid using more than one level of nesting for module names". Was the
intent of that to manage namespace "ownership", or is there some PAUSE
or CPAN management code which wants submissions to be two-level?
It would be a Good Thing if all of the Mail::Tie* or Mail::Tie::*
modules implemented tied hashes to mailboxes in the same way, such
that they could be interchangeable. Come to think of it, the
Mail::Broker module I'm writing next requires that. That would imply
some standard-setting needs to be done, which flops me back over into
needing to "own" Mail::Tie::* to some degree so that I can guide
a standard... Sigh. Thoughts, anyone?
Steve
package Mail::Tie::mh;
require 5.005_62;
use strict;
use warnings;
use Carp;
use Mail::Internet;
use File::Temp qw/ tempfile /;
require Exporter;
our @ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
# This allows declaration use Mail::Tie::mh ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
);
our $VERSION = '0.02';
=head1 NAME
Mail::Tie::mh - Tied hash interface for mh mail folders
=head1 SYNOPSIS
use Mail::Tie::mh;
tie (%inbox, 'Mail::Tie::mh', 'inbox');
# get list of all message IDs in folder
@messageIDs = keys (%inbox);
# fetch message by ID
$msg = $inbox{'[EMAIL PROTECTED]'};
=head1 DESCRIPTION
Mail::Tie::mh implements a tied hash interface to the mh folder
format.
=cut
sub TIEHASH
{
my ($class, $folder, $rargs) = @_;
my $self={};
$self->{'folder'} = $folder;
for(keys %$rargs)
{
$self->{$_} = $rargs->{$_};
}
bless $self, $class;
$self->{'unseen'} = 1 unless exists $self->{'unseen'};
chomp(my $path = `mhparam Path`);
die "can't find mh base directory" unless $path;
`mkdir -p $ENV{HOME}/$path/$folder`; # make sure folder exists
# BUG -- FIRSTKEY/NEXTKEY won't work if you do a packf after TIEHASH
open(SCAN, "scan +$folder -width 9999 -format '%(msg) %{message-id}' 2>/dev/null |")
|| die $!;
my ($num, $id);
while(<SCAN>)
{
chomp;
($num, $id) = split;
$self->id2num($id,$num);
$self->num2id($num,$id);
$self->{'firstnum'} = $num unless $self->{'firstnum'};
$self->{'lastnum'} = $num;
}
return $self;
}
sub FETCH
{
my ($self,$id) = @_;
chomp($id);
my $folder = $self->{'folder'};
my $cmd = "pick +$folder --message-id '$id' 2> /dev/null ";
# warn $cmd;
chomp(my $msgnum = `$cmd`);
# warn "\n\n$?\n\n";
# warn "$id $msgnum\n";
return undef if $? >> 8;
return undef unless $msgnum;
open(MSG, "show -nohead -noshowproc +$folder $msgnum |") || die $!;
# my $msg = join('',<MSG>);
my $msg = new Mail::Internet \*MSG;
return undef unless $msg;
chomp(my $testid = $msg->head->get('Message-Id'));
# warn "\n$id $testid\n";
return undef unless $id eq $testid;
$self->id2num($id,$msgnum);
$self->num2id($msgnum,$id);
if ($self->{'unseen'})
{
`mark +$folder $msgnum -seq unseen`;
die "cannot mark unseen: message $msgnum in folder $folder" if $? >> 8;
}
return $msg;
}
sub FIRSTKEY
{
my ($self) = @_;
my $id = $self->num2id($self->{'firstnum'});
return $id;
}
sub NEXTKEY
{
my ($self,$id) = @_;
chomp($id);
my $nextid;
for(my $num=$self->id2num($id) + 1; $num <= $self->{'lastnum'}; $num++)
{
# warn $num;
last if ($nextid = $self->num2id($num))
}
return $nextid;
}
sub EXISTS
{
my ($self,$id) = @_;
chomp($id);
return $self->FETCH($id);
}
# $h{'new'} to create new
# $h{$id} to overwrite
sub STORE
{
my ($self,$oldid,$msg) = @_;
my $oldmsg;
chomp($oldid);
chomp(my $newid = $msg->head->get('Message-Id'));
return undef unless $oldid eq $newid || $oldid eq 'new';
if ($self->EXISTS($newid))
{
return undef if $oldid eq 'new';
$oldmsg = $self->DELETE($newid);
}
my ($tmpfh, $tmpname) = tempfile();
print $tmpfh $msg->as_string();
close $tmpfh;
my $folder = $self->{'folder'};
`inc +$folder -silent -file $tmpname`;
die if $? >> 8;
unlink($tmpname) || die $!;
$msg = $self->FETCH($newid);
die unless $msg;
if ($self->{'unseen'})
{
my $msgnum = $self->id2num($newid);
`mark +$folder $msgnum -seq unseen`;
die "cannot mark unseen: message $msgnum in folder $folder" if $? >> 8;
}
return $oldmsg if $oldmsg;
return $msg;
}
sub DELETE
{
my ($self,$id) = @_;
chomp($id);
my $folder = $self->{'folder'};
my $msg = $self->FETCH($id);
return undef unless $msg;
my $num = $self->id2num($id);
die unless $num;
`rmm +$folder $num`;
die if $? >> 8;
$self->id2num($id,0);
$self->num2id($num,"");
return $msg;
}
sub num2id
{
my $self=shift;
my $num=shift;
my $id=shift;
chomp($id) if $id;
$self->{'num2id'}{$num} = $id if $id;
$id = $self->{'num2id'}{$num};
return $id;
}
sub id2num
{
my $self=shift;
my $id=shift;
my $num=shift;
chomp($id);
$self->{'id2num'}{$id} = $num if $num;
$num = $self->{'id2num'}{$id};
return $num;
}
=head1 AUTHOR
Steve Traugott, [EMAIL PROTECTED]
=head1 SEE ALSO
perltie(1)
=cut
1;
__END__
