diff --git a/Mail-Box-0.5/Box/Threads.pm b/Mail-Box-0.5/Box/Threads.pm deleted file mode 100644 index e1bcbcb..0000000 --- a/Mail-Box-0.5/Box/Threads.pm +++ /dev/null @@ -1,430 +0,0 @@ - -package Mail::Box::Threads; - -use strict; -use v5.6.0; -our $VERSION = v0.5; - -use Mail::Box::Message; - -=head1 NAME - -Mail::Box::Threads - maintain threads within a folder - -=head1 SYNOPSIS - - my Mail::Box $folder = ...; - foreach my $thread ($folder->threads) - { $thread->print; - } - -=head1 DESCRIPTION - -Read Mail::Box::Manager and Mail::Box first. The manual also describes -package Mail::Box::Thread, which is one thread. - -This module maintains an easily accessable structure containing information -about threads. Each thread is maintained while a folder is open. -The structure consists of message, and a list of replies. A reply can -be a single message or a thread by itself. - -=head1 PUBLIC INTERFACE - -=over 4 - -=item new ARGS - -The construction of a Mail::Box::Threads accepts the following options: - -=over 4 - -=item * dummy_type => CLASS - -Of which class are dummy messages? Usually, this needs to be the -C of the folder prepended with C<::Dummy>. This will also -be the default. - -=back - -=cut - -sub init($) -{ my ($self, $args) = @_; - - $self->registerHeaders(qw/message-id in-reply-to references/); - - $self->{MBT_dummy_type} = $args->{dummy_type} - || $self->{MB_message_type} . '::Dummy'; - - $self; -} - -#------------------------------------------- - -=item messageWithId MESSAGE-ID [MESSAGE] - -Returns (and first sets) the message which has a certain id. - -=cut - -sub messageWithId($;$) -{ my ($self, $msgid) = (shift,shift); - @_ ? ($self->{MBT_ids}{$msgid} = shift) : $self->{MBT_ids}{$msgid}; -} - -#------------------------------------------- - -=item allMessageIDs - -Returns a list of I messages/message-ids in the folder, including -those which are to be deleted. - -Example: - my @ids = grep {not $_->deleted} - $folder->allMessageIDs; - -=cut - -sub allMessageIDs() { keys %{shift->{MBT_ids}} } - -#------------------------------------------- - -=item addToThread MESSAGE - -Add a message to a discussion-thread. It does not matter whether you -have done this before (although this information should not conflict -with the thread-information found till now). - -=cut - -sub addToThread($) -{ my ($self, $message) = @_; - my $msgid = $message->messageID; - my $replies = $message->in_reply_to; - - $self->follows($replies, $msgid) if $replies; - - my @refs = $message->references; - push @refs, $msgid; - - my $start = shift @refs; - $self->registerThread($start) unless $replies; - - while(my $child = shift @refs) - { $self->unregisterThread($child) if $self->isThreadStart($child); - $self->follows($start, $child); - $start = $child; - } - - $self; -} - -#------------------------------------------- - -=item follows MESSAGE, MESSAGE - -Register a follow-up from message to the other. - -Example: - $folder->follows($question, $answer); - -=cut - -sub follows($$) -{ my ($self, $parent, $child) = @_; - -#warn "$parent follows $child"; - $self->messageWithId($parent, $self->{MBT_dummy_type}->new($parent)) - unless $self->messageWithId($parent); - - $self->messageWithId($parent)->addFollowUp($child); - $self; -} - -#------------------------------------------- - -=item registerThread MESSAGE|MESSAGE-ID - -=item unregisterThread MESSAGE|MESSAGE-ID - -Register/Unregister a message or message-id to be (not to be) the start of -a thread. This does not mean that the message is the top of a thread for -sure, because not all mail-packages are careful in handling references. -Call C to reduce the discrepancies in threads further. - -=cut - -sub registerThread($) -{ my ($self, $message) = @_; - my $id; - if(ref $message && $message->isa('Mail::Box::Message')) - { $id = $message->messageID; - } - else - { $id = $message; - $message = $self->messageWithId($id); - } - -#print "register $id\n"; - $self->{MBT_threads}{$id} = $message; -} - -sub unregisterThread($) -{ my ($self, $thread) = @_; - $thread = $thread->messageID - if ref $thread && $thread->isa('Mail::Box::Message'); - -print "unregister $thread\n"; - delete $self->{MBT_threads}{$thread}; -} - -#------------------------------------------- - -=item lintThreads - -Improve the quality of thread discovery. Running lint-ing might be -time-consuming, so is only run on explicit request. You do not have -to re-run lint once you have read the file: all further modifications -to the folder will maintain correct threads. - -Example: - my $folder = Mail::Box::File->new->lintThreads; - -=cut - -sub lintThreads() -{ my Mail::Box $self = shift; - - # Try to relate messages based on - # Subject - # Sender-Receiver - # Content - # ... to be implemented ... - - $self; -} - -#------------------------------------------- - -=item isThreadStart MESSAGE|MESSAGE-ID - -Check whether the message is registered as being a start for threads. - -Example: - if($folder->isThreadStart($folder->message(3)) {...}; - -=cut - -sub isThreadStart($) -{ my ($self, $id) = @_; - - $id = $id->messageID - if ref $id && $id->isa('Mail::Box::Message'); - - exists $self->{MBT_threads}{$id}; -} - -#------------------------------------------- - -=item threads - -Returns a list of all threads discovered so far. - -Example: - print $_->nrMessages foreach $folder->threads; - -=cut - -sub threads() { values %{shift->{MBT_threads}} } - -### -### Mail::Box::Thread -### - -#------------------------------------------- - -=back - -=head1 Mail::Box::Thread - -A thread implements a linked list of messages which are a logical -sequence. There are two sides to threads: primarly the relations between -messages, and secondary the way they are presented on the screen. - -=cut - -package Mail::Box::Thread; -use Carp; - -sub new(@) { (bless {}, shift)->init(@_) } - -sub init($) -{ my $self = shift; - $self->{MBT_followups} = []; - $self; -} - -sub folder() -{ confess "Extentions of a thread shall implement the folder() method."; -} - - -#------------------------------------------- - -=item addFollowUp MESSAGE | MESSAGE-ID - -=item addFollowUps [MESSAGE | MESSAGE-ID]* - -Add one/multiple messages or message-ids to the list of messages which -are send as follow-up on this message. This information is used to -recognize descussion threads. Duplicates are ignored. - -Example: - $message1->addFollowUp($message2); - $message1->addFollowUp($message2->messageID); - -=cut - -sub addFollowUp($) -{ my Mail::Box::Message $self = shift; - - my $followup = shift; - $followup = $followup->messageID - if ref $followup && $followup->isa('Mail::Box::Message'); - - push @{$self->{MBT_followups}}, $followup - unless grep {$_ eq $followup} @{$self->{MBT_followups}}; - - $self; -} - -sub addFollowUps($) -{ my $self = shift; - $self->addFollowUp($_) foreach @_; - $self; -} - -#------------------------------------------- - -=item followUps - -Return the whole list of follow-ups. - -Examples: - my @replies = $message->followUps; - print scalar $message->followUps, " replies.\n"; - -=cut - -sub followUps() -{ my $self = shift; - - if(wantarray) - { return exists $self->{MBT_followups} - ? @{$self->{MBT_followups}} - : () - } - else { return exists $self->{MBT_followups} - ? scalar @{$self->{MBT_followups}} - : 0 - } -} - - -#------------------------------------------- - -=item subThreads - -Return the subThreads of this thread. - -=cut - -sub subThreads() -{ my $self = shift; - my $folder = $self->folder; - $self->{MBT_subthreads} - = [ map {$folder->messageWithId($_)} $self->followUps ] - unless exists $self->{MBT_subthreads}; - - @{$self->{MBT_subthreads}}; -} - -#------------------------------------------- - -=item recurseThread CODE-REF - -Execute a function for all sub-threads. - -=cut - -sub recurseThread($) -{ my ($self, $code) = @_; - $_->recurseThread($code) foreach $self->subThreads; - $code->($self); - $self; -} - -#------------------------------------------- - -=item totalSize - -Sum the size of all the messages in the thread. - -=cut - -sub totalSize() -{ my $self = shift; - my $total = 0; - $self->recurseThread( sub {$total += shift->size} ); - $total; -} - -#------------------------------------------- - -=item nrMessages - -Number of messages in this thread. - -=cut - -sub nrMessages() -{ my $self = shift; - my $total = 0; - $self->recurseThread( sub {$total++} ); - $total; -} - -#------------------------------------------- - -=item ids - -Collect all the ids in this thread. - -Examples: - $newfolder->addMessages($folder->ids($thread->ids)); - $folder->delete($thread->ids); - -=cut - -sub ids() -{ my $self = shift; - my @ids; - $self->recurseThread( sub {push @ids, shift->messageID} ); - @ids; -} - -#------------------------------------------- - -=head1 AUTHOR - -Mark Overmeer (F). -All rights reserved. This program is free software; you can redistribute -it and/or modify it under the same terms as Perl itself. - -=head1 VERSION - -This code is alpha, version 0.5 - -=cut - -1; diff --git a/Mail-Box-0.5/t/3mh1w.t b/Mail-Box-0.5/t/3mh1w.t deleted file mode 100644 index ce5fa32..0000000 --- a/Mail-Box-0.5/t/3mh1w.t +++ /dev/null @@ -1,143 +0,0 @@ - -# -# Test writing (and reading) of MH folders. -# - -use Test; -use File::Compare; -use File::Copy; -use lib '..'; -use strict; - -use Mail::Box::MH; -use Mail::Box::Mbox; - -BEGIN {plan tests => 10} - -my $orig = 't/mbox.src'; -my $src = 't/mh.src'; - -sub clean_dir($); -sub clean_dir($) -{ my $dir = shift; - opendir DIR, $dir or return; - - foreach (map { "$dir/$_" } grep !/^\.\.?$/, readdir DIR) - { if(-d) { clean_dir $_ } - else { unlink $_ } - } - - closedir DIR; - rmdir $dir; -} - -sub unpack_file($$) -{ my ($file, $dir) = @_; - clean_dir($dir); - - mkdir $dir; - my $count = 1; - - open FILE, $file or die; - open OUT, '/dev/null'; - - while() - { if( /^From / ) - { close OUT; - open OUT, '>', "$dir/".$count++ or die; - $count++ if $count==13; # skip 13 for test - next; # from line not included in file. - } - print OUT; - } - - close OUT; - close FILE; -} - -# -# Unpack the file-folder. -# - -unpack_file($orig, $src); - -ok(Mail::Box::MH->foundIn($src)); - -my $folder = new Mail::Box::MH - ( folder => $src - , lock_method => 'NONE' - , lazy_extract => 'ALWAYS' - , access => 'rw' - , keep_index => 1 - ); - -ok(defined $folder); - -# We skipped message number 13 in the production, but that shouldn't -# distrub things. - -ok($folder->messages==45); - -# Test lazy extract. - -my $parsed = 0; -foreach ($folder->messages) -{ $parsed++ if $_->isParsed; -} -ok($parsed==0); - -# Test subjects -# This shouldn't cause any parsings: we do lazy extract, but Mail::Box -# will always take the `Subject' header for us. - -my @subjects = map { chomp; $_ } - map {$_->head->get('subject') || '' } - $folder->messages; - -$parsed = 0; -foreach ($folder->messages) -{ $parsed++ if $_->isParsed; -} -ok($parsed==0); - -# -# The subjects must be the same as from the original Mail::Box::Mbox -# There are some differences with new-lines at the end of headerlines -# - -my $mbox = Mail::Box::Mbox->new - ( folder => $orig - , lock_method => 'NONE' - , access => 'r' - ); - -my @fsubjects = map { chomp; $_ } - map {$_->head->get('subject') || ''} - $mbox->messages; - -my (%subjects); -$subjects{$_}++ foreach @subjects; -$subjects{$_}-- foreach @fsubjects; - -my $missed = 0; -foreach (keys %subjects) -{ $missed++ if $subjects{$_}; - warn "Still left: $_ ($subjects{$_}x)\n" if $subjects{$_}; -} -ok(!$missed); - -# -# Check if we can load a body. -# - -my $msg3 = $folder->message(3); -ok(not $msg3->isParsed); - -my $body = $msg3->body; -ok(defined $body); -ok(@$body==43); # check expected number of lines in message 3. -ok($msg3->isParsed); - -$folder->write; - -clean_dir $src; diff --git a/Mail-Box-0.5/Box.pm b/Mail-Box-0.6/Box.pm similarity index 87% rename from Mail-Box-0.5/Box.pm rename to Mail-Box-0.6/Box.pm index 3b6650d..f6fdb0c 100644 --- a/Mail-Box-0.5/Box.pm +++ b/Mail-Box-0.6/Box.pm @@ -1,7 +1,7 @@ package Mail::Box; -$VERSION = '0.5'; +$VERSION = '0.6'; use strict; use v5.6.0; @@ -232,30 +232,15 @@ Examples: The Mail::Box::Message manual-page has more on this subject. -=item * take_headers => REF-ARRAY-OF-REGEXPS|REGEXPS|'ALL'|'REAL' +=item * take_headers => ARRAY-REGEXPS|REGEXP|'ALL'|'REAL'|'DELAY' When messages are not parsed (as controlled by the C parameter), -and hence stay in their respective files, some header-lines are still to be +and hence stay in their respective folders, some header-lines are still to be taken: for instance you still want access to the subject-field to be able to print an index. -If you know your application needs some header-fields frequently, you -add them to the default list of fields which are already taken by the -folder-implementation. No problem if you specify the same name twice. - -You can specify a regular expression, although you cannot use parentheses -in them which do count. The expressions will be matched always on the -whole field. So C will only match lines starting with C. -You can not used C, but may say C. - -If you specify too few fields, then all messages will get parsed to -get the field you missed when you scanned the folder first. When you -specify too many fields, your program will consume more memory. - -There are two special constants. With C you get all header-lines -from the message (same as pattern C<.*>) and C will cause headers -to be read into a real MIME::Header structure (to be more precise: the -type you specify with C.) +See C below, for a detailed explanation. Please try +to avoid calling that method when you can do with using this option. Examples: $folder->new( take_headers => 'ALL'); @@ -372,32 +357,87 @@ sub clone(@) =item registeredHeaders -See the C option of C. -The C method can be used to specify more header-lines to -be taken when scanning through a folder. Its counterpart -C returns: +See the C option of C, which is the prefered way +to specify which way the header should be treated. Try to avoiding +C directly. + +The C method can be used to specify more header-lines +to be taken when scanning through a folder. Its counterpart +C returns the current setting. + +If you know your application needs some header-fields frequently, you +add them to the default list of fields which are already taken by the +folder-implementation. No problem if you specify the same name twice. + +If you specify too few field-names, then all messages will get parsed +(read from file into memory) to get the field-data you missed. When you +specify too many fields, your program will consume considerable more memory. + +You can specify a regular expression, although you cannot use parentheses +in them which do count. The expressions will be matched always on the +whole field. So C will only match lines starting with C. +You can not used C, but may say C. + +There are three special constants. With C you get all header-lines +from the message (same as pattern C<.*>) and C will cause headers +to be read into a real MIME::Header structure (to be more precise: the +type you specify with C.) + +Some folder-types (like MH) support C, where headers are to taken +at all, until a line from the header is required. This is useful for +folders where each message has to be read from a seperate source. In +this case, we would like to delay even that contact as long as possible. =over 4 =item * 'ALL' to indicate that all headers should be taken. -=item * 'REAL' to indicated that all headers should be taken and translated into a real MIME::Header. +=item * 'REAL' + +indicates that all headers should be taken and translated into a +real MIME::Header. + +=item * 'DELAY' + +requests for no header at all, unless we accidentally stumble on them. This +is default (and only usefull) for all folder-types which store their +messages in seperate files. Mail::Box will try to avoid opening those +files with maximum effort. + +In case you need header-lines, and at the same time want to avoid access +to each file when a folder is opened (for instance, if you want to read +e-mail in threads), consider using index-files. Read the manual-page of +the folder-type you need on whether those is supported for that specific +type. -=item * a list over lowercased regular expressions which sprecify the header-line to be taken. +=item * a list of regular expressions + +which specify the header-lines to be taken. =back +Examples: + $folder->registerHeaders('ALL'); + $folder->registerHeaders('Subject', 'X-Folder-.*'); + =cut sub registerHeaders(@) { my $self = shift; - if(grep {$_ eq 'ALL' || $_ eq '^.*$'} @_) - { $self->{MB_take_headers} = 'ALL'; - } - elsif(grep {$_ eq 'REAL'} @_) + if(grep {$_ eq 'REAL'} @_) { $self->{MB_take_headers} = 'REAL'; } + elsif(grep {$_ eq 'DELAY'} @_) + { $self->{MB_take_headers} = 'DELAY'; + } + elsif(exists $self->{MB_take_headers} && !ref $self->{MB_take_headers}) + { # Already an important constant defined: no change to be made. + } + elsif(grep {$_ eq 'ALL' || $_ eq '^.*$'} @_) + { $self->{MB_take_headers} = 'ALL'; + } + elsif(exists $self->{take_headers} && !ref $self->{take_headers}) { # Detected a REAL or ALL before. Don't need to register more. } @@ -689,6 +729,40 @@ sub message(;$) :lvalue #------------------------------------------- +=item messageID MESSAGE-ID [,MESSAGE] + +Returns the message in this folder with the specified MESSAGE-ID. This +method returns a not-parsed, parsed, or dummy message. With the second +MESSAGE argument, the value is first set. + +=cut + +sub messageID($;$) +{ my ($self, $msgid) = (shift, shift); + + return $self->{MB_msgid}{$msgid} unless @_; + + # Define message. + my $message = shift; + + # If the message-id was already found in a dummy, then the information + # from the dummy has to be copied into the real message. + + my $found = $self->{MB_msgid}{$msgid}; + if($found && $found->isDummy) + { # Copy information from dummy message into the real message. + $message->addFollowUps($found->followUps); + } + elsif($found && $found ne $message) + { $found->delete(1); + } + + # Store the message in the message-id index. + $self->{MB_msgid}{$msgid} = $message; +} + +#------------------------------------------- + =item messages Returns all messages which are I scheduled to be deleted. In @@ -742,7 +816,9 @@ Returns a list of I messages in the folder, including those which are to be deleted. Examples: - foreach ($folder->allMessages) {...} + foreach my $msg ($folder->allMessages) + { $msg->print; + } my $total_size = $folder->allMessages; =cut @@ -751,6 +827,25 @@ sub allMessages() { @{shift->{MB_messages}} } #------------------------------------------- +=item allMessageIDs + +Returns a list of I message-ids in the folder, including +those which are to be deleted. + +For some folder-types (like MH), this method may cause all message-files +to be read. See their respective manual-pages. + +Examples: + foreach my $id ($folder->allMessageIDs) + { $folder->messageID($id)->print; + } + +=cut + +sub allMessageIDs() { keys %{shift->{MB_msgid}} } + +#------------------------------------------- + =item addMessage MESSAGE =item addMessages MESSAGE [, MESSAGE, ...] @@ -767,30 +862,15 @@ Examples: =cut sub addMessage($) -{ my $self = shift; - my $msg = shift || return $self; +{ my $self = shift; + my $message = shift or return $self; - # Be sure that the message is of the correct type. - $msg = $self->coerce($msg); - my $msgid = $msg->messageID; + push @{$self->{MB_messages}}, $message; - my $found = $self->messageWithId($msgid); - if($found && $found->isDummy) - { # Copy information from dummy message into the real message. - $msg->addFollowUps($found->followUps); - } - elsif($found) - { # Detecting the same message for the second time. We ignore - # this one. - return $self; - } - - $self->messageWithId($msgid, $msg); + push @{$self->{MB_alive}}, $message + unless $message->deleted || !exists $self->{MB_alive}; - push @{$self->{MB_messages}}, $msg; - push @{$self->{MB_alive}}, $msg unless $msg->deleted; - - $self->addToThread($msg); + $message->seqnr( @{$self->{MB_messages}} -1); $self; } @@ -864,27 +944,16 @@ sub coerce($) # Be sure that the message is loaded, before it is converted # to a new type. - $message->can('play_dead_parrot_sketch'); - # If we get the primitive Mail::Internet type, then we first upgrade - # into a MIME::Entity. It is disappointing that that class does not - # have an init() method. I need to copy some code from the instance - # method (new) for MIME::Entity. Hope that never changes... + # Convert to the right type for this mailbox. + $self->{MB_message_type}->coerce + ( $self, $message + , @{$self->{MB_message_opts}} + , modified => 1 + ); - if(ref $message eq 'Mail::Internet') - { $message->{ME_Parts} = []; # stolen code. - } - - # Reinitialize the message, but with the options as specified by the - # creation of this folder, not the folder where the message came from. - - bless ($message, $self->{MB_message_type}) - ->init(@{$self->{MB_message_opts}}); - - $message->folder($self); - $message->modified(1); - $message; + $self; } #------------------------------------------- @@ -1110,7 +1179,7 @@ it and/or modify it under the same terms as Perl itself. =head1 VERSION -This code is alpha, version 0.5 +This code is alpha, version 0.6 =cut diff --git a/Mail-Box-0.5/Box/Index.pm b/Mail-Box-0.6/Box/Index.pm similarity index 98% rename from Mail-Box-0.5/Box/Index.pm rename to Mail-Box-0.6/Box/Index.pm index 610a7be..e7a8300 100644 --- a/Mail-Box-0.5/Box/Index.pm +++ b/Mail-Box-0.6/Box/Index.pm @@ -3,7 +3,7 @@ use strict; use v5.6.0; package Mail::Box::Index; -our $VERSION = v0.5; +our $VERSION = v0.6; use FileHandle; use File::Copy; @@ -157,7 +157,7 @@ it and/or modify it under the same terms as Perl itself. =head1 VERSION -This code is alpha, version 0.5 +This code is alpha, version 0.6 =cut diff --git a/Mail-Box-0.5/Box/Locker.pm b/Mail-Box-0.6/Box/Locker.pm similarity index 99% rename from Mail-Box-0.5/Box/Locker.pm rename to Mail-Box-0.6/Box/Locker.pm index bedc77e..30b292f 100644 --- a/Mail-Box-0.5/Box/Locker.pm +++ b/Mail-Box-0.6/Box/Locker.pm @@ -3,7 +3,7 @@ package Mail::Box::Locker; use strict; use v5.6.0; -our $VERSION = v0.5; +our $VERSION = v0.6; use Fcntl qw/:DEFAULT :flock/; use IO::File; @@ -512,7 +512,7 @@ it and/or modify it under the same terms as Perl itself. =head1 VERSION -This code is alpha, version 0.5 +This code is alpha, version 0.6 =cut diff --git a/Mail-Box-0.5/Box/MH.pm b/Mail-Box-0.6/Box/MH.pm similarity index 59% rename from Mail-Box-0.5/Box/MH.pm rename to Mail-Box-0.6/Box/MH.pm index 9072333..1a41bcb 100644 --- a/Mail-Box-0.5/Box/MH.pm +++ b/Mail-Box-0.6/Box/MH.pm @@ -7,7 +7,7 @@ use Mail::Box; use Mail::Box::Index; our @ISA = qw/Mail::Box Mail::Box::Index/; -our $VERSION = v0.5; +our $VERSION = v0.6; use Mail::Box; @@ -25,46 +25,157 @@ Mail::Box::MH - Handle folders with a file per message. =head1 DESCRIPTION -Mail::Box::MH extends Mail::Box and Mail::Box::Index to implements +Mail::Box::MH extends Mail::Box and Mail::Box::Index to implement MH-type folders. This manual-page describes Mail::Box::MH and -Mail::Box::MH::* packages. Read Mail::Box::Manager and Mail::Box first. +Mail::Box::MH::* packages. Read Mail::Box::Manager for the general +overview, Mail::Box for understanding mailboxes, and Mail::Box::Message +about how messages are used, first. -Handle file-based folders, where each folder is represented by a -directory, and each message by a file in that directory. Messages -are numbered. +The explanation is complicated, but for normal use you should bother +yourself with all details. Skip the manual-page to C. -The name of a folder may be an absolute or relative path. You can also -preceed the foldername by C<=>, which means that it is relative to the -I as specified at C. +=head2 How MH-folders work -=head2 Delayed loading +MH-type folders use a directory to store the messages of one folder. Each +message is stored in a seperate file. This seems useful, because changes +in a folder change only a few of these small files, in contrast with +file-based folders where changes in a folder cause rewrites of huge +folder-files. + +However, MH-based folders perform very bad if you need header-information +of all messages. For instance, if you want to have full knowledge about +all message-threads (see Mail::Box::Threads) in the folder, it requires +to read all header-lines in all message-files. And usually, reading in +threads is desired. + +So, each message is written in a seperate file. The file-names are +numbers, which count from C<1>. Next to these message-files, a +directory may contain a file named C<.mh_sequences>, storing labels which +relate to the messages. Furthermore, a folder-directory may contain +sub-directories, which are seen as sub-folders. + +=head2 Implementation + +This implementation supports the C<.mh-sequences> file and sub-folders. +Next to this, considerable effort it made to avoid reading each message-file. +This should boost performance of the Mail::Box module over other +Perl-modules which are able to read folders. Folder-types which store their messages each in one file, together in one directory, are bad for performance. Consider that you want to know -the subjects of all messages. +the subjects of all messages, while browser through a folder with your +mail-reading client. This would cause all message-files to be read. -Mail::Box::MH has two ways to try improve performance. If you specify -C as option to the folder creation method C, then -all header-lines of all messages will be written into the specified -index-file (one file per folder). +Mail::Box::MH has two ways to try improve performance. You can use +an index-file, and use on delay-loading. The combination performs even +better. Both are explained in the next sections. -If you do not use an index-file, then the only thing what the opening -of a folder does is invertoring which message-files exists. Nothing -else. For any request to any message, that message will be -autoloaded. -If the first request is for a header-line, then only the header is parsed, -and the message still left in the file. For anything else, the whole -message is parsed. +=head2 An index-file + +If you specify C as option to the folder creation method +C, then all header-lines of all messages from the folder which +have been read once, will also be written into one dedicated index-file +(one file per folder). The default filename is C<.index> + +However, index-files are not supported by any other reader which supports +MH (as far as I know). If you read the folders with such I client, it +will not cause unrecoverable conflicts with this index-file, but at most +be bad for performance. + +If you do not (want to) use an index-file, then delay-loading may +save your day. + +=head2 Delayed loading + +The delay-loading mechanism of messages tries to be as lazy as possible. +When the folder is opened, none of the message-files will be read. If +there is an index-file, those headers will be taken. The labels will +be read from the <.mh-sequences>. But from the messages, only the +filenames are scanned. + +Not before any header-line (or any other action on a message) is used, +the message is read. This is done using Perl's AUTOLOADing, and is +transparent to users. If the first thing you ask for is a header-line, +then C and C determine what how far this +message is parsed: into a Mail::Box::MH::NotParsed or a +Mail::Box::MH::Message. The index-file is farmost best performing, but also in the second case, -performance can be ok. When you have opened a huge folder, only a few -of those folders will be presented on the screen as index. To present -the index we need the subject, hence we need to load the header of these -messages. When you scroll through the index, header after header is -parsed. -If you want to read you messages in threads, you have a serious -performance problem: threads can only be displayed if all message -headers were read. In this case, you should use an index-file. +performance can be ok. When a mail-client opens a huge folder, only a few +of the messages will be displayed on the screen as folder-list. Only from +the visible messages, header-lines like `Subject' are needed, so +the AUTOLOAD automatically reads those message-files. Other messages +will only be read from file when they appear in the viewport. + +=head2 Message State Transition + +The user of a folder gets it hand on a message-object, and is not bothered +with the actual data which is stored in the object at that moment. As +implementor of a mail-package, you might be. + +For trained eyes only: + + read() !lazy && !DELAY + -------> +----------------------------------> Mail::Box:: + | MH::Message + | lazy && !DELAY && !index ^ + +--------------. | + | \ \ NotParsed load | + | \ `-> NotReadHead ------>-'| + | REAL \ | + | \ | + | index v NotParsed load | + +------------------> MIME::Head ------->-'| + | ^ | + | | | + | |load_head | + | | | + | DELAY && !index NotParsed load | + +------------------> -------->--' + + + ,-------------------------+---. + | ALL | | regexps && taken + v | | + NotParsed head() get() / / + NotReadHead --------> ------->+---' + \ \ \ + \ other() \ other() \regexps && !taken + \ \ \ + \ \ \ load Mail::Box:: + `----->----+---------+---------> MH::Message + + ,---------------. + | | + v | + NotParsed head() | + MIME::Head -------->--' + \ Mail::Box:: + `------------------------> MH::Message + + + load_head NotParsed + ,----------> MIME::Head + / + NotParsed head() / lazy + --------->+ + \ !lazy + \ + `-----------> Mail::Box:: + load MH::Message + +Terms: C refers to the evaluation of the C option. The +C and C are triggers to the C mothods. All +terms like C refer to method-calls. The C is true if there +is an index-file kept, and the message-header found in there seems still +valid (see the C option of C). + +Finally, C, C, C (default), and C refer to +values of the C option of C. Notice that +C on C is more important than C. + +Hm... not that easy... Happily, the implementation takes fewer lines than +the documentation. =head1 PUBLIC INTERFACE @@ -87,11 +198,11 @@ see below, but first the full list. index_filename Mail::Box::Index foldername.'/.index' keep_index Mail::Box::Index 0 labels_filename Mail::Box::MH foldername.'/.mh_sequence' - lazy_extract Mail::Box 10kb + lazy_extract Mail::Box 10000 (10kB) lockfile Mail::Box::Locker foldername.'/.lock' lock_method Mail::Box::Locker 'dotlock' - lock_timeout Mail::Box::Locker 1 hour - lock_wait Mail::Box::Locker 10 seconds + lock_timeout Mail::Box::Locker 3600 (1 hour) + lock_wait Mail::Box::Locker 10 (seconds) manager Mail::Box undef message_type Mail::Box 'Mail::Box::MH::Message' notreadhead_type Mail::Box 'Mail::Box::Message::NotReadHead' @@ -99,7 +210,7 @@ see below, but first the full list. realhead_type Mail::Box 'MIME::Head' remove_when_empty Mail::Box 1 save_on_exit Mail::Box 1 - take_headers Mail::Box + take_headers Mail::Box 'DELAY' Mail::Box::Tie MH specific options: @@ -127,6 +238,7 @@ sub init($) $args->{notreadhead_type} ||= 'Mail::Box::Message::NotReadHead'; $args->{keep_index} ||= 0; $args->{folderdir} ||= $default_folder_dir; + $args->{take_headers} ||= 'DELAY'; $self->Mail::Box::init($args); @@ -158,12 +270,7 @@ sub init($) ); } - if($args->{keep_index}) - { $self->registerHeaders('REAL'); - } - else - { $self->registerHeaders( qw/status x-status/ ); - } + $self->registerHeaders( qw/status x-status/ ); # Check if we can write to the folder, if we need to. @@ -211,16 +318,13 @@ sub readMessages() if(ref $mode) { # If the user specified a list of fields, we prepare a regexp # which can match thid really fast. - $expect = [ keys %$mode ]; + $self->{MB_expect} = [ keys %$mode ]; $mode = 'SOME'; $take = '^(' . join('|', @$expect) . ')\:\s*(.*)$'; - $take_headers = qr/$take/i; + $self->{MB_header_scan} = qr/$take/i; } - # Prepare the parser. - - my $parser = $self->parser; - my $delayed = 0; + $self->{MB_header_mode} = $mode; # Select the messages from the directory (folder) # Each message is a file, where a sequence-number is @@ -229,9 +333,9 @@ sub readMessages() my $dirname = $self->dirname; opendir DIR, $dirname or return; - my @messages = grep { -f "$dirname/$_" && -r _ } - sort {$a <=> $b} - grep /^\d+$/, readdir DIR; + my @msgnrs = grep { -f "$dirname/$_" && -r _ } + sort {$a <=> $b} + grep /^\d+$/, readdir DIR; closedir DIR; # Retreive the information from the index-file if that @@ -243,105 +347,141 @@ sub readMessages() my $index_age = -M $self->indexFilename if @index; my %index = map { (scalar $_->get('x-mailbox-filename'), $_) } @index; - foreach my $msgnr (@messages) + foreach my $msgnr (@msgnrs) { my $msgfile = "$dirname/$msgnr"; my $head; - $head = $index{$msgfile} + $head = $index{$msgfile} if exists $index{$msgfile} && -M $msgfile >= $index_age; my $size = -s $msgfile; - - my @options = - ( filename => $msgfile - , size => $size - , msgnr => $msgnr - , labels => $labels[$msgnr] || undef + undef $head if $head && $head->get('x-mailbox-size') != $size; + + # First, we create a cheap structure, with minimal information. + my $message = $self->{MB_notparsed_type}->new + ( head => $head + , upgrade_to => $self->{MB_message_type} + , filename => $msgfile + , size => $size + , msgnr => $msgnr + , labels => $labels[$msgnr] || undef ); - # - # Read one message. - # + $self->addMessage($message) if $message; + } - local $_; # protect global $_ - open MESSAGE, '<', $msgfile or return; + $self->{MB_source_mtime} = (stat $dirname)[9]; + $self->{MB_highest_msgnr} = $msgnrs[-1]; + $self->{MB_delayed_loads} = $#msgnrs; + $self->{MB_last_untouched} = $#msgnrs; - # Read the header. + if($mode eq 'DELAY') + { # Delay everything. + } + elsif($mode eq 'SOME' || $mode eq 'REAL') + { # Trigger load of header, or whole. + $self->readMessage($_) foreach 0..$#msgnrs; + } - my @header; - local $_; - while() - { push @header, $_; - last if /^\r?\n$/; - } - $self->unfoldHeaders(\@header); - - my $message; - if(not $self->lazyExtract(\@header, undef, $size)) - { # - # Take the message immediately. - # - - # Read the body, too. For performance, this is added to the - # header array. - push @header, ; - - $message = $self->{MB_message_type}->new - ( message => $parser->parse_data(\@header) - , @options - ); - } - elsif($mode eq 'SOME' || $mode eq 'ALL') - { # - # Create delay-loaded message with some fields. - # - - # Get all header lines for fast access. - my $header = $self->{MB_notreadhead_type}->new(expect => $expect); - - if($mode eq 'SOME') - { foreach (@header) - { $header->setField($1, $2) if $_ =~ $take_headers; - } - } - else { $header->setField(split ':', $_, 2) foreach @header } + $self; +} + +#------------------------------------------- - $message = $self->{MB_notparsed_type}->new - ( head => $header - , @options - ); +=item readMessage MESSAGE-NR [, BOOL] - $delayed++; - } - else - { # - # Create a real header structure, but not yet the body. - # +Read one message from its file. This method is automatically triggered +by the AUTOLOAD mechanism, so will usually not be called explicitly. - $message = $self->{MB_notparsed_type}->new - ( head => MIME::Head->new(\@header)->unfold - , @options - ); +Although the name of the method seems to imply that also the message +body is read, this might not be true. If BOOL is true (default false), +the body is certainly read. Otherwise, it depends on the content of the +folder's C and C flags. + +=cut - $delayed++; - } +sub readMessage($;$) +{ my ($self, $msgnr, $force_read_all) = @_; + my $message = $self->{MB_messages}[$msgnr]; + my $mode = $self->{MB_header_mode}; + my $head = $message->{MB_head}; + local $_; # protect global $_ - $message->statusToLabels->XstatusToLabels; - $self->addMessage($message) if $message; + open MESSAGE, '<', $message->filename or return; + + # Read the header. + my @header; + while() + { last if /^\r?\n$/; + push @header, $_; + } + $self->unfoldHeaders(\@header); - close MESSAGE; + if($force_read_all || !$self->lazyExtract(\@header, undef, $message->size)) + { # Take the message immediately. + push @header, "\r\n", ; + $message->load($self->{MB_message_type}, \@header); + } + elsif($mode eq 'SOME' || $mode eq 'ALL') + { # Keep a delay-loaded message with some fields. + my $header = $self->{MB_notreadhead_type} + ->new(expect => $self->{MB_expect}); + my $take_headers = $self->{MB_header_scan}; + + if($mode eq 'SOME') + { foreach (@header) + { $header->setField($1, $2) if $_ =~ $take_headers; + } + } + else { $header->setField(split ':', $_, 2) foreach @header } + + $message->{MBM_head} = $header; + } + else + { # Create a real header structure, but not yet the body. + $message->{MBM_head} = MIME::Head->new(\@header)->unfold; } - # Release the folder. + close MESSAGE; - $self->{MB_source_mtime} = (stat $dirname)[9]; - $self->{MB_delayed_loads} = $delayed; - $self->{MB_highest_msgnr} = $messages[-1]; + --$self->{MB_last_untouched} + if $message->seqnr == $self->{MB_last_untouched}; + $message->head_init; + + $self->messageID($message->messageID, $message) + ->statusToLabels->XstatusToLabels; +} + +#------------------------------------------- + +=item addMessage MESSAGE + +Add a message to the MH-folder. + +=cut + +sub addMessage($) +{ my ($self, $message) = @_; + + $self->coerce($message); + if($message->headIsRead) + { # Do not add the same message twice. + my $msgid = $message->messageID; + my $found = $self->messageID($msgid); + return $self if $found && !$found->isDummy; + $self->messageID($msgid, $message); + } + else + { $message->folder($self); + } + + # The message is accepted. + $self->Mail::Box::addMessage($message); $self; } - + #------------------------------------------- =item write @@ -429,6 +569,24 @@ sub writeMessages() 1; } + +#------------------------------------------- + +=item readAllHeaders + +Force all messages to be read at least till their header information +is known. The exact status reached depends on the C +of C, as described above. + +=cut + +sub readAllHeaders() +{ my $self = shift; + my $nrmsgs = $self->allMessages; + $self->readMessage($_, 0) foreach 0..$nrmsgs-1; + $self; +} + #------------------------------------------- =item appendMessages LIST-OF-OPTIONS @@ -549,6 +707,51 @@ sub highestMessageNumber() #------------------------------------------- +=item messageID MESSAGE-ID [,MESSAGE] + +Returns the message with the specified MESSAGE-ID. If also a MESSAGE +is specified, the relationship between ID and MESSAGE will be stored +first. + +Be warned, that if the message is not read at all (C set +to C), each message of the folder will be parsed, at least to get +its header. The headers are read from back to front in the folder. + +=cut + +sub messageID($;$) +{ my ($self, $msgid, $message) = @_; + $self->Mail::Box::messageID($msgid, $message) if $message; + +use Carp; +confess join(';', %$self), "\n" unless defined $self->{MB_last_untouched}; + + # Trigger autoload until the message-id appears. + $self->message($self->{MB_last_untouched}--)->head + while $self->{MB_last_untouched} >= 0 + && !exists $self->{MB_msgid}{$msgid}; + + return $self->{MB_msgid}{$msgid}; +} + +#------------------------------------------- + +=item allMessageIDs + +Returns a list of I message-ids in the folder, including +those which are to be deleted. + +Be warned that this will cause all message-headers to be read from +their files, if that was not done before. This penalty can be +avoided keeping an index-file. See the C option of +C. + +=cut + +sub allMessageIDs() { shift->readAllHeaders->Mail::Box::allMessageIDs } + +#------------------------------------------- + =back =head2 Manage message labels @@ -875,13 +1078,29 @@ This object contains methods which are part of as well delay-loaded Messages in directory-based folders use the following extra options for creation: +=over 4 + +=item * filename => FILENAME + +The file where the message is stored in. + +=back + =cut sub init($) { my ($self, $args) = @_; - $self->{MBM_filename} = $args->{filename}; - $self->{MBM_msgnr} = $args->{msgnr}; + $self->{MBM_filename} = $args->{filename}; + $self; +} + +my $unreg_msgid = time; + +sub head_init() +{ my $self = shift; + my $msgid = $self->head->get('message-id') || 'mh-'.$unreg_msgid++; + $self->{MBM_messageID} = $msgid; $self; } @@ -966,16 +1185,17 @@ sub filename() { shift->{MBM_filename} } #------------------------------------------- -=item messageNr +=item headIsRead -Returns the number of the message as is used in its filename. MH-folders -do put each message is a seperate file. The files are numbers, but there -may some numbers missing. +Checks if the head of the message is read. This is true for fully +parsed messages and messages where the header was accessed once. =cut -sub messageNr() { shift->{MBM_msgnr} } - +sub headIsRead() +{ my $self = shift; + $self->isParsed || exists $self->{MBM_head}; +} ### ### Mail::Box::MH::Message @@ -1007,6 +1227,43 @@ sub init($) $self; } +#------------------------------------------- + +=item coerce FOLDER, MESSAGE [,OPTIONS] + +(Class method) +Coerce a MESSAGE into a Mail::Box::MH::Message, ready to be stored in +FOLDER. When any message is offered to be stored in the mailbox, it +first should have all fields which are specific for MH-folders. + +The coerced message is returned on success, else C. + +Example: + my $mh = Mail::Box::MH->new(...); + my $message = Mail::Box::Mbox::Message->new(...); + Mail::Box::MH::Message->coerce($mh, $message); + # Now $message is ready to be stored in $mh. + +However, you can better use + $mh->coerce($message); +which will call coerce on the right message type for sure. + +=cut + +sub coerce($$) +{ my ($class, $folder, $message) = (shift, shift, shift); + return $message if $message->isa($class); + + Mail::Box::Message->coerce($folder, $message, @_) or return; + + # When I know more what I can save from other types of messages, later, + # that information will be extracted here, and transfered into arguments + # for Runtime->init. + + (bless $message, $class)->Mail::Box::Mbox::Message::Runtime::init; +} + + ### ### Mail::Box::MH::Message::NotParsed ### @@ -1041,41 +1298,60 @@ sub init(@) #------------------------------------------- -=item load +=item load CLASS [, ARRAY-OF-LINES] This method is called by the autoloader then the data of the message is required. If you specified C for the C option for C, you did have a MIME::Head in your hands, however this will be destroyed when the whole message is loaded. +If an array of lines is provided, that is parsed as message. Otherwise, +the file of the message is opened and parsed. + =cut -sub load($) -{ my ($self, $class) = @_; +sub load($;$) +{ my ($self, $class) = (shift, shift); - my $folder = $self->folder; - my $filename = $self->filename; + my $folder = $self->folder; + my $new; - unless(open FILE, '<', $filename) - { warn "Cannot find folder $folder message $filename anymore.\n"; - return $self; + if(@_) + { $new = $folder->parser->parse_data(shift); } + else + { my $filename = $self->filename; - my $message = $folder->parser->parse(\*FILE); - $message->head->unfold; + unless(open FILE, '<', $filename) + { warn "Cannot find folder $folder message $filename anymore.\n"; + return $self; + } + $new = $folder->parser->parse(\*FILE); + close FILE; + } + my $args = { message => $new }; $folder->{MB_delayed_loads}--; + (bless $self, $class)->delayedInit($args); +} + +#------------------------------------------- + +=item head - my $args = { message => $message }; +Get the head of the message. This may return immediately, because the +head is already read. However, when we do not have a header yet, we +read the message. At this moment, the C option of C +comes into action: will we read the whole message now, or only the header? - # I try to pass the change on, back to the caller. The calling - # routine has a handle to the non-parsed message structure. We - # may succeed in replacing that by the next assignment. - # When the tric fails, it costs some performance, because autoloading - # will continue to be called. However, in that method, the retry - # is detected and will immediately returns the right object. +=cut - $_[0] = (bless $self, $class)->delayedInit($args); +sub head() +{ my $self = shift; + return $self->{MBM_head} if exists $self->{MBM_head}; + $self->folder->readMessage($self->seqnr); + $self->head; + $self->head; } =back @@ -1088,7 +1364,7 @@ it and/or modify it under the same terms as Perl itself. =head1 VERSION -This code is alpha, version 0.5 +This code is alpha, version 0.6 =cut diff --git a/Mail-Box-0.5/Box/Manager.pm b/Mail-Box-0.6/Box/Manager.pm similarity index 99% rename from Mail-Box-0.5/Box/Manager.pm rename to Mail-Box-0.6/Box/Manager.pm index 897e143..0e302b1 100644 --- a/Mail-Box-0.5/Box/Manager.pm +++ b/Mail-Box-0.6/Box/Manager.pm @@ -3,7 +3,7 @@ package Mail::Box::Manager; use strict; use v5.6.0; -our $VERSION = v0.5; +our $VERSION = v0.6; use Mail::Box; @@ -446,7 +446,7 @@ it and/or modify it under the same terms as Perl itself. =head1 VERSION -This code is alpha, version 0.5 +This code is alpha, version 0.6 =cut diff --git a/Mail-Box-0.5/Box/Mbox.pm b/Mail-Box-0.6/Box/Mbox.pm similarity index 83% rename from Mail-Box-0.5/Box/Mbox.pm rename to Mail-Box-0.6/Box/Mbox.pm index a4e2fac..949f113 100644 --- a/Mail-Box-0.5/Box/Mbox.pm +++ b/Mail-Box-0.6/Box/Mbox.pm @@ -4,7 +4,7 @@ use v5.6.0; package Mail::Box::Mbox; our @ISA = 'Mail::Box'; -our $VERSION = v0.5; +our $VERSION = v0.6; use Mail::Box; @@ -38,6 +38,55 @@ The name of a folder may be an absolute or relative path. You can also preceed the foldername by C<=>, which means that it is relative to the I as specified at C. +=head2 Message State Transition + +The user of a folder gets it hand on a message-object, and is not bothered +with the actual data which is stored in the object at that moment. As +implementor of a mail-package, you might be. + +For trained eyes only: + + read() !lazy + -------> +----------------------------------> Mail::Box:: + | MH::Message + | ^ + | | + | NotParsed load | + | ALL ,-----> NotReadHead ------>-'| + | lazy / | + `--------->+ | + \ NotParsed load | + REAL `-----> MIME::Head ------->-' + + + ,-------------------------+---. + | ALL | | regexps && taken + v | | + NotParsed head() get() / / + NotReadHead --------> ------->+---' + \ \ \ + \ other() \ other() \regexps && !taken + \ \ \ + \ \ \ load Mail::Box:: + `----->----+---------+---------> MBox::Message + + ,---------------. + | | + v | + NotParsed head() | + MIME::Head -------->--' + \ Mail::Box:: + `------------------------> MBox::Message + + +Terms: C refers to the evaluation of the C option. The +C and C are triggers to the C mothods. All +terms like C refer to method-calls. Finally, C, C, +and C (default) refer to values of the C option +of C. + +Hm... not that easy... but relatively simple compared to MH-folder messages. + =head1 PUBLIC INTERFACE =over 4 @@ -230,6 +279,8 @@ sub readMessages(@) # The only thing to do when the line fits is to lowercase the fieldname. my $mode = $self->registeredHeaders; + $mode = 'REAL' if $mode eq 'DELAY'; + my ($expect, $take, $take_headers); if(ref $mode) @@ -317,7 +368,8 @@ sub readMessages(@) else { $header->setField(split ':', $_, 2) foreach @header } $message = $self->{MB_notparsed_type}->new - ( head => $header + ( head => $header + , upgrade_to => $self->{MB_message_type} , @options ); $header->message($message); @@ -330,7 +382,8 @@ sub readMessages(@) # $message = $self->{MB_notparsed_type}->new - ( head => MIME::Head->new(\@header)->unfold + ( head => MIME::Head->new(\@header)->unfold + , upgrade_to => $self->{MB_message_type} , @options ); @@ -391,6 +444,30 @@ sub writeMessages() #------------------------------------------- +=item addMessage MESSAGE + +Add a message to the Mbox-folder. If you specify a message with an +id which is already in the folder, the message will be ignored. + +=cut + +sub addMessage($) +{ my ($self, $message) = @_; + $self->coerce($message); + + # Do not add the same message twice. + my $msgid = $message->messageID; + my $found = $self->messageID($msgid); + return $self if $found && !$found->isDummy; + + # The message is accepted. + $self->Mail::Box::addMessage($message); + $self->messageID($msgid, $message); + $self; +} + +#------------------------------------------- + =item appendMessages LIST-OF-OPTIONS (Class method) Append one or more messages to this folder. See @@ -652,10 +729,19 @@ this line, but this is just how things were invented... =cut +my $unreg_msgid = time; + sub init($) { my ($self, $args) = @_; $self->{MBM_from_line} = $args->{from}; $self->{MBM_begin} = $args->{begin}; + + unless(exists $args->{messageID}) + { my $msgid = $self->head->get('message-id'); + $args->{messageID} = $1 if $msgid && $msgid =~ m/\<(.*?)\>/; + } + $self->{MBM_messageID} = $args->{messageID} || 'mbox-'.$unreg_msgid++; + delete @$args{ qw/from begin/ }; $self; @@ -770,32 +856,37 @@ sub init($) #------------------------------------------- -=item coerce MESSAGE +=item coerce FOLDER, MESSAGE [,OPTIONS] + +(Class method) Coerce a MESSAGE into a Mail::Box::Mbox::Message. When +any message is offered to be stored in a mbox FOLDER, it first should have +all fields which are specific for Mbox-folders. -(Class method) -Coerce a message into a Mail::Box::Mbox::Message. When any message -is offered to be stored in the mailbox, it first should have all -fields which are specific for Mbox-folders (especially the special -C line. +The coerced message is returned on success, else C. Example: - my $mh = Mail::Box::MH::Message->new(...); - my $Mbox = Mail::Box::Mbox::Message->coerce($mh); + my $inbox = Mail::Box::Mbox->new(...); + my $mh = Mail::Box::MH::Message->new(...); + Mail::Box::Mbox::Message->coerce($inbox, $mh); + # Now, the $mh is ready to be included in $inbox. + +However, you can better use + $inbox->coerce($mh); +which will call the right coerce() for sure. =cut -sub coerce($) -{ my ($class, $message) = @_; +sub coerce($$) +{ my ($class, $folder, $message) = (shift, shift, shift); return $message if $message->isa($class); - Mail::Box::Message->coerce($message); + Mail::Box::Message->coerce($folder, $message, @_) or return; # When I know more what I can save from other types of messages, later, # that information will be extracted here, and transfered into arguments # for Runtime->init. - bless $message, $class; - $message->Mail::Box::Mbox::Message::Runtime::init; + (bless $message, $class)->Mail::Box::Mbox::Message::Runtime::init; } ### @@ -852,11 +943,15 @@ sub load($) $folder->fileClose unless $was_open; my $message = $folder->parser->parse($if); + + # A pitty that we have to copy data now... + @$self{ keys %$message } = values %$message; + my $args = { message => $message }; $folder->{MB_delayed_loads}--; - $_[0] = (bless $self, $class)->delayedInit($args); + (bless $self, $class)->delayedInit($args); } =back @@ -869,7 +964,7 @@ it and/or modify it under the same terms as Perl itself. =head1 VERSION -This code is alpha, version 0.5 +This code is alpha, version 0.6 =cut diff --git a/Mail-Box-0.5/Box/Message.pm b/Mail-Box-0.6/Box/Message.pm similarity index 92% rename from Mail-Box-0.5/Box/Message.pm rename to Mail-Box-0.6/Box/Message.pm index 0721b0a..ff246e9 100644 --- a/Mail-Box-0.5/Box/Message.pm +++ b/Mail-Box-0.6/Box/Message.pm @@ -237,13 +237,7 @@ my $unreg_msgid = time; sub init($) { my ($self, $args) = @_; - unless(exists $args->{messageID}) - { my $msgid = $self->head->get('message-id'); - $args->{messageID} = $1 if $msgid && $msgid =~ m/\<(.*?)\>/; - } - $self->{MBM_size} = $args->{size} || 0; - $self->{MBM_messageID} = $args->{messageID} || $unreg_msgid++; $self->{MBM_deleted} = $args->{deleted} || 0; $self->{MBM_modified} = $args->{modified} || 0; $self->folder($args->{folder}) if $args->{folder}; @@ -387,6 +381,19 @@ sub deleted(;$) #------------------------------------------- +=item seqnr [INTEGER] + +Get (add set) the number of this message is the current folder. + +=cut + +sub seqnr(;$) +{ my $self = shift; + @_ ? $self->{MBM_seqnr} = shift : $self->{MBM_seqnr}; +} + +#------------------------------------------- + =back =head2 Label management @@ -615,12 +622,58 @@ sub delayedInit($) my $message = $args->{message} || return $self; @$self{ keys %$message } = values %$message; + $self->head->unfold; $self; } sub isParsed() { 1 } +#------------------------------------------- + +=item coerce FOLDER, MESSAGE [,OPTIONS] + +(Class method) Coerce a MESSAGE into a Mail::Box::Message. This method +is automatically called if you add a strange message-type to a FOLDER. +You usually do not need to call this yourself. + +The coerced message is returned on success, else C. + +Example: + my $folder = Mail::Box::Mbox->new; + my $entity = MIME::Entity->new(...); + Mail::Box::MBox::Message->coerce($inbox, $entity); + # now $entity is a Mail::Box::Mbox::Message + +It better to use + $folder->coerce($entity); +which does exacty the same, by calling coerce in the right package. + +=cut + +sub coerce($$@) +{ my ($class, $folder, $message, %args) = @_; + return $message if $message->isa($class); + + # If we get the primitive Mail::Internet type, then we first upgrade + # into a MIME::Entity. It is disappointing that that class does not + # have an init() method. I need to copy some code from the instance + # method (new) for MIME::Entity. Hope that never changes... + + if(ref $message eq 'Mail::Internet') + { $message->{ME_Parts} = []; # stolen code. + } + + # Re-initialize the message, but with the options as specified by the + # creation of this folder, not the folder where the message came from. + + (bless $message, $class)->init(\%args) or return; + + $message->folder($folder); + $message->Mail::Box::Message::Runtime::init(\%args); +} + + #------------------------------------------- =item body @@ -818,7 +871,7 @@ type of the object. =item new ARGS -Create a not parsed message. The message can have a C, +Create a not-parsed message. The message can have a C, which means that only a few of the header-lines are kept, or a real MIME::Head to start with. @@ -827,8 +880,12 @@ real MIME::Head to start with. sub init($) { my ($self, $args) = @_; - my $head = $self->{MBM_head} = $args->{head}; - $head->message($self) if $head->can('message'); + if(my $head = $args->{head}) + { $self->{MBM_head} = $head; + $head->message($self) if $head->can('message'); + } + + $self->{MBM_upgrade_to} = $args->{upgrade_to}; $self->Mail::Box::Message::Runtime::init($args); $self->Mail::Box::Thread::init($args); @@ -853,31 +910,11 @@ otherwise read the message twice. our $AUTOLOAD; sub AUTOLOAD -{ my $self = $_[0]; - -#warn "Autoload on message $AUTOLOAD.\n"; - # Try to avoid double reading caused by old handles to the un-parsed - # message info. - - my $folder = $self->folder; - my $public = $folder->messageWithId($self->messageID); - if($public->isParsed) - { # autoload message which is already parsed, but caller - # does not have the right handle yet. - $_[0] = $public; - } - else - { # Autoloading is still required. - $_[0] = $public = $self->load($folder->{MB_message_type}); - $folder->messageWithId($self->messageID, $public); - } - - (my $call = $AUTOLOAD) - =~ s/$folder->{MB_notparsed_type}/$folder->{MB_message_type}/; +{ my $self = shift; + (my $call = $AUTOLOAD) =~ s/.*\:\://; + my $public = $self->load($self->{MBM_upgrade_to}); - shift; no strict 'refs'; -# goto $public->$call(@_); $public->$call(@_); } @@ -980,7 +1017,7 @@ sub get($;$) # The header-line was not captured, so we need to load the # whole message to look for the field. $AUTOLOAD = (ref $self).'::get'; - goto $self->AUTOLOAD($tag, $index); + return $self->AUTOLOAD($tag, $index); } elsif(ref $self->{$tag}) { return wantarray && !defined $index @@ -1078,8 +1115,9 @@ sub AUTOLOAD { my $self = $_[0]; (my $method = $AUTOLOAD) =~ s/.*\:\://; -#warn "Load!! for $AUTOLOAD\n"; - my $head = $self->{MBM_message}->load->head; + my $message = $self->{MBM_message}; + $message->body; # Trigger message loading. + my $head = $message->head; $_[0] = $head; # try to infuence the handle which the caller # has in its hands. @@ -1101,7 +1139,7 @@ it and/or modify it under the same terms as Perl itself. =head1 VERSION -This code is alpha, version 0.5 +This code is alpha, version 0.6 =cut diff --git a/Mail-Box-0.6/Box/Threads.pm b/Mail-Box-0.6/Box/Threads.pm new file mode 100644 index 0000000..053284d --- /dev/null +++ b/Mail-Box-0.6/Box/Threads.pm @@ -0,0 +1,511 @@ + +package Mail::Box::Threads; + +use strict; +use v5.6.0; +our $VERSION = v0.6; + +use Mail::Box::Message; + +=head1 NAME + +Mail::Box::Threads - maintain threads within a folder + +=head1 SYNOPSIS + + my Mail::Box $folder = ...; + foreach my $thread ($folder->threads) + { $thread->print; + } + +=head1 DESCRIPTION + +Read Mail::Box::Manager and Mail::Box first. The manual also describes +package Mail::Box::Thread, which is one thread. + +A (message-)I is a message, with the messages which followed in +reply on that message. And the messages with replied the messages +which replied the original message. And so on. Some threads are only +one message (never replied to), some threads are very long. + +=head2 How it works + +This module implements thread-detection on a folder. Messages created +by the better mailers will include C and C +lines, which are used to figure out how messages are related. If you +prefer a better thread detection, then you can ask for it, but there +may be a serious performance hit (depends on the type of folder used). + +In this object, we take special care not to cause unnessesary parsing +(loading) of messages. Threads will only be detected on command, and +by default only the message headers are used. + +=head2 How to use it + +With C you get the start-messages of each detected threads. +When that message was not found in the folder (not saved or already +removed), you get a message of the dummy-type. These thread descriptions +are in perfect state: all messages are included somewhere. + +However, to be able to detect all threads it is required to have the +headers of all messages, which is very slow for some types of folders. +For interactive mail-readers, it is prefered to detect threads only +on messages which are in the viewport of the user. This may be sloppy +in some situations, but everything is preferable over reading an MH +mailbox with 10k e-mails to read only the most recent messages. + +=head1 PUBLIC INTERFACE + +=over 4 + +=item new ARGS + +Mail::Box::Threads is sub-classed by Mail::Box itself. This object is +not meant to be instantiated itself: do not call C on it (you'll +see it even fails because there is no C!). + +The construction of thread administration accepts the following options: + +=over 4 + +=item * dummy_type => CLASS + +Of which class are dummy messages? Usually, this needs to be the +C of the folder prepended with C<::Dummy>. This will also +be the default. + +=item * thread_body => BOOL + +May thread-detection be based on the content of a message? This has +a serious performance implication when there are many messages without +C and C headers in the folder, because it +will cause many messages to be parsed. + +NOT USED YET. Defaults to TRUE. + +=back + +=cut + +sub init($) +{ my ($self, $args) = @_; + + $self->registerHeaders(qw/message-id in-reply-to references/); + + $self->{MBT_dummy_type} = $args->{dummy_type} + || $self->{MB_message_type} . '::Dummy'; + $self->{MBT_thread_body} = $args->{thread_body} || 1; + + $self; +} + +#------------------------------------------- + +=item createDummy MESSAGE-ID + +Create a dummy message for this folder. The dummy is a place-holder +in a thread description to represent a message which is not found in +the folder (yet). + +=cut + +sub createDummy($) +{ my ($self, $msgid) = @_; + my $dummy = $self->{MBT_dummy_type}->new($msgid); + $self->messageID($msgid, $dummy); +} + +#------------------------------------------- + +=item detectThread MESSAGE + +Based on a message, and facts from previously detected threads, try +to build solid knowledge about the thread where this message is in. + +=cut + +sub detectThread($) +{ my ($self, $message) = @_; + + # First register this message to become part of the threads. + # Maybe, this message-id has been seen before, and a dummy is + # place-holding. Copy the information from the dummy into + # this message. + + my $msgid = $message->messageID; + my $replies = $message->in_reply_to; + my @refs = $message->references; + + + # If a dummy was holding information for this message-id, we have + # to take the information stored in it. + + my $dummy = $self->messageID($msgid); + if($dummy && $dummy->isa($self->{MBT_dummy_type})) + { $message->followedBy($dummy->followUps); + $message->follows($dummy->repliedTo); + } + $self->messageID($msgid, $message); + + + # This message might be a thread-start, when no threading + # information was found. + + $self->registerThread($message) + unless $replies || @refs; + + + # Handle the `In-Reply-To' message header. + # This is the most secure relationship. + + if($replies) + { $message->follows($replies, 'REPLY'); + delete $self->{MBT_threads}{$msgid}; # am reply, so not a start. + my $from = $self->messageID($replies) || $self->createDummy($replies); + $from->followedBy($msgid); + } + + + # Handle the `References' message header. + # The (ordered) list of message-IDs give an impression where this + # message resides in the thread. There is a little less certainty + # that the list is correctly ordered and correctly maintained. + + if(@refs) + { push @refs, $msgid; + my $start = shift @refs; + my $from = $self->messageID($start) || $self->createDummy($start); + $self->registerThread($from); + + while(my $child = shift @refs) + { my $to = $self->messageID($child) || $self->createDummy($child); + $to->follows($start, 'REFERENCE'); + delete $self->{MBT_threads}{$child}; + $from->followedBy($child); + ($start, $from) = ($child, $to); + } + } + + $self; +} + +#------------------------------------------- + +=item registerThread MESSAGE|MESSAGE-ID + +Register the message as start of a thread. + +=cut + +sub registerThread($) +{ my ($self, $message) = @_; + return $self if $self->repliedTo; + my $msgid = ref $message ? $message->messageID : $message; + $self->{MBT_threads}{$msgid} = $message; + $self; +} + +#------------------------------------------- + +=item allThreads + +Returns all messages which start a thread. The list may contain dummy +messages, and messages which are scheduled for deletion. + +To be able to return all threads, thread construction on each +message is performed first, which may be slow for some folder-types +because is will enforce parsing of message-bodies. + +=cut + +sub allTheads() +{ my $self = shift; + $_->detectThread foreach $self->allMessages; + $self->knownThreads; +} + +#------------------------------------------- + +=item knownThreads + +Return the list of all messages which are known to be the start of +a thread. Threads are detected based on explicitly calling +C with a messages from the folder. + +=cut + +sub knownThreads() { keys %{shift->{MBT_threads}} } + +### +### Mail::Box::Thread +### + +package Mail::Box::Thread; +use Carp; + +#------------------------------------------- + +=back + +=head1 Mail::Box::Thread + +A thread implements a list of messages which are related. The main +object described in the manual-page is the thread-manager, which is +part of a Mail::Box. The Mail::Box::Thread is sub-classed by a +Mail::Box::Message; each message is part of a thread. + +=over 4 + +=item new ARGS + +The instatiation of a thread is done by its subclasses. You will not +call this method by yourself (it is even not implemented). + +In the current implementation, there are no options added to the +Mail::Box::Message's object creation. + +=cut + +sub init($) +{ my $self = shift; + $self->{MBT_followups} = []; + $self; +} + +sub folder() +{ confess "Extentions of a thread shall implement the folder() method."; +} + +#------------------------------------------- + +=item myThread + +Returns the first message in the thread where this message is part +of. This may be this message itself. This also may return any other +message in the folder. Even a dummy message can be returned, when the +first message in the thread was not stored in the folder. + +Example: + my $start = $folder->message(42)->myThread; + +=cut + +sub myThread() +{ my $self = shift; + exists $self->{MBT_parent} ? $self->{MBT_parent}->myThread : $self; +} + +#------------------------------------------- + +=item repliedTo + +Returns the message where this one is a reply to. In SCALAR context, this +will return the MESSAGE which was replied to by this one. This message +object may be a dummy message. In case the message seems to be the +first message of a thread, the value C is returned. + +In LIST context, this method also returns how sure these are messages +are related. When extended thread discovery in enabled, then some +magic is applied to relate messages. In LIST context, the first +returned argment is a MESSAGE, and the second a STRING constant. +Values for the STRING may be: + +=over 4 + +=item * REPLY + +This relation was directly derived from an `in-reply-to' message header +field. The relation is very sure. + +=item * REFERENCE + +This relation is based on information found in a `Reference' message +header field. One message may reference a list of messages which +precede it in the thread. Let's hope they are stored in the right +order. + +=item * GUESS + +The relation is a big guess, of undetermined type. + +=back + +More constants may be added later. + +Examples: + my $question = $answer->repliedTo; + my ($question, $quality) = $answer->repliedTo; + if($question && $quality eq 'REPLY') { ... }; + +=cut + +sub repliedTo +{ my $self = shift; + + $self->detectThread + unless exists $self->{MBT_parent}; + + return wantarray + ? ($self->{MBT_parent}, $self->{MBT_quality}) + : $self->{MBT_parent}; +} + +#------------------------------------------- + +=item follows MESSAGE, STRING + +Register that the specified MESSAGE is a reply on this message, where +the quality of the relation is specified by the constant STRING. The +relation may be specified more than once, but there can be only one. +Once a reply (STRING equals C) is detected, that value will be +kept. + +=cut + +sub follows($$) +{ my ($self, $message, $how) = @_; + + unless(exists $self->{MBT_parent} && $self->{MBT_quality} eq 'REPLY') + { $self->{MBT_parent} = $message->messageID; + $self->{MBT_quality} = $how; + } + $self; +} + +#------------------------------------------- + +=item followedBy [MESSAGE-ID|MESSAGE, ...] + +Register that the MESSAGEs (or MESSAGE-IDs) are follow-ups to this message. +There may be more than one of these follow-ups which are not related to +each-other in any other way than sharing the same parent. + +If the same relation is defined more than ones, this will not cause +duplication of information. + +=cut + +sub followedBy(@) +{ my $self = shift; + + return $self unless @_; + unless(exists $self->{MBT_followUps}) + { $self->{MBT_followUps} = [ map {ref $_ ? $_->messageID : $_} @_ ]; + return $self; + } + + foreach my $follow (@_) + { my $followid = ref $follow ? $follow->messageID : $follow; + push @{$self->{MBT_followUps}}, $followid + unless grep {$followid eq $_} @{$self->{MBT_followUps}}; + } + + $self; +} + +#------------------------------------------- + +=item followUps + +Returns the list of follow-ups to this message. This list +contains parsed, not-parsed, and dummy messages. C +returns MESSAGE-objects, while C returns the IDs +only. + +=cut + +sub followUps() +{ my $self = shift; + map {$self->{msgid}{$_}} @{$self->{MBT_followUps}}; +} + +sub followUpIDs() { @{shift->{MBT_followUps}} } + +#------------------------------------------- + +=back + +=head2 Actions on whole threads + +Some conveniance methods are added to threads, to simplify retreiving +knowledge from it. + +=over 4 + +=item recurseThread CODE-REF + +Execute a function for all sub-threads. + +=cut + +sub recurseThread($) +{ my ($self, $code) = @_; + $_->recurseThread($code) foreach $self->subThreads; + $code->($self); + $self; +} + +#------------------------------------------- + +=item totalSize + +Sum the size of all the messages in the thread. + +=cut + +sub totalSize() +{ my $self = shift; + my $total = 0; + $self->recurseThread( sub {$total += shift->size} ); + $total; +} + +#------------------------------------------- + +=item nrMessages + +Number of messages in this thread. + +=cut + +sub nrMessages() +{ my $self = shift; + my $total = 0; + $self->recurseThread( sub {$total++} ); + $total; +} + +#------------------------------------------- + +=item ids + +Collect all the ids in this thread. + +Examples: + $newfolder->addMessages($folder->ids($thread->ids)); + $folder->delete($thread->ids); + +=cut + +sub ids() +{ my $self = shift; + my @ids; + $self->recurseThread( sub {push @ids, shift->messageID} ); + @ids; +} + +#------------------------------------------- + +=head1 AUTHOR + +Mark Overmeer (F). +All rights reserved. This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +=head1 VERSION + +This code is alpha, version 0.6 + +=cut + +1; diff --git a/Mail-Box-0.5/Box/Tie.pm b/Mail-Box-0.6/Box/Tie.pm similarity index 98% rename from Mail-Box-0.5/Box/Tie.pm rename to Mail-Box-0.6/Box/Tie.pm index 36ebfdf..ec76ae1 100644 --- a/Mail-Box-0.5/Box/Tie.pm +++ b/Mail-Box-0.6/Box/Tie.pm @@ -4,7 +4,7 @@ package Mail::Box::Tie; use strict; use v5.6.0; -our $VERSION = '0.5'; +our $VERSION = '0.6'; =head1 NAME @@ -129,7 +129,7 @@ it and/or modify it under the same terms as Perl itself. =head1 VERSION -This code is alpha, version 0.5 +This code is alpha, version 0.6 =cut diff --git a/Mail-Box-0.5/ChangeLog b/Mail-Box-0.6/ChangeLog similarity index 51% rename from Mail-Box-0.5/ChangeLog rename to Mail-Box-0.6/ChangeLog index 8c1ac8f..05b8b21 100644 --- a/Mail-Box-0.5/ChangeLog +++ b/Mail-Box-0.6/ChangeLog @@ -52,7 +52,37 @@ Mark Overmeer Mail/Box/Manager.pm Mail/Box.pm -version 0.5: Thu Jan 4 11:07:09 CET 2001 + +version 0.5: Thu Jan 4 11:14:05 CET 2001 + * Installation fixes. + +version 0.6: Thu Jan 4 22:44:30 CET 2001 Mark Overmeer - * Installation fix: had to remove `our' before $VERSION. + * Simplified autoloading (a lot) The reference to the object + does not change anymore when a message is converted from an + Mail::Box::Message::NotParsed into a Mail::Box::Message. + + * Stricter treatment of coercions with coerce(). + + * Reimplementation of Threads to be as lazy as possible. + Not Tested Yet!!! + Mail/Box/Treads.pm + + * MH folders are even more lazy than they were: by default nothing + at all is read. Only access of any header-line will cause a + read in a file. + + * Added `DELAY' option to Mail::Box::new(take_headers) + + * Added a message state transition diagram (which is really + complicated for MH folders) and much more other documentation + improvements + + * Added large number of tests (about 40), which all succeed ;) + + Nearly all files got changed, although I managed to keep the method + interface rather stable: (by the way: this is still an alpha release!) + Mail/Box/Mbox.pm + Mail/Box/MH.pm + Mail/Box/Message.pm diff --git a/Mail-Box-0.5/MANIFEST b/Mail-Box-0.6/MANIFEST similarity index 85% rename from Mail-Box-0.5/MANIFEST rename to Mail-Box-0.6/MANIFEST index ee69749..fa69a0c 100644 --- a/Mail-Box-0.5/MANIFEST +++ b/Mail-Box-0.6/MANIFEST @@ -1,8 +1,11 @@ +t/Tools.pm t/2mbox1r.t t/2mbox2w.t t/2mbox3d.t t/2mbox4a.t -t/3mh1w.t +t/3mh1r.t +t/3mh2w.t +t/3mh3a.t t/7mgr.t t/8tie.t t/9lock.t diff --git a/Mail-Box-0.5/Makefile.PL b/Mail-Box-0.6/Makefile.PL similarity index 100% rename from Mail-Box-0.5/Makefile.PL rename to Mail-Box-0.6/Makefile.PL diff --git a/Mail-Box-0.5/README b/Mail-Box-0.6/README similarity index 100% rename from Mail-Box-0.5/README rename to Mail-Box-0.6/README diff --git a/Mail-Box-0.5/TODO b/Mail-Box-0.6/TODO similarity index 95% rename from Mail-Box-0.5/TODO rename to Mail-Box-0.6/TODO index 94e424e..90b5dc9 100644 --- a/Mail-Box-0.5/TODO +++ b/Mail-Box-0.6/TODO @@ -14,9 +14,8 @@ TO BE TESTED (and improved): nfs-lock sub-folders delete folders - appending to unopened folders TO BE IMPLEMENTED: Thread lint extracting large message-parts into persistent external files - + Many more folder-types diff --git a/Mail-Box-0.5/t/2mbox1r.t b/Mail-Box-0.6/t/2mbox1r.t old mode 100644 new mode 100755 similarity index 96% rename from Mail-Box-0.5/t/2mbox1r.t rename to Mail-Box-0.6/t/2mbox1r.t index e41f4d0..a427479 --- a/Mail-Box-0.5/t/2mbox1r.t +++ b/Mail-Box-0.6/t/2mbox1r.t @@ -1,4 +1,4 @@ - +#!/usr/local/bin/perl -w # # Test reading of mbox folders. # diff --git a/Mail-Box-0.5/t/2mbox2w.t b/Mail-Box-0.6/t/2mbox2w.t old mode 100644 new mode 100755 similarity index 98% rename from Mail-Box-0.5/t/2mbox2w.t rename to Mail-Box-0.6/t/2mbox2w.t index 413a62d..f63780b --- a/Mail-Box-0.5/t/2mbox2w.t +++ b/Mail-Box-0.6/t/2mbox2w.t @@ -1,3 +1,4 @@ +#!/usr/local/bin/perl -w # # Test writing of mbox folders. diff --git a/Mail-Box-0.5/t/2mbox3d.t b/Mail-Box-0.6/t/2mbox3d.t old mode 100644 new mode 100755 similarity index 96% rename from Mail-Box-0.5/t/2mbox3d.t rename to Mail-Box-0.6/t/2mbox3d.t index cc89981..f82bfb8 --- a/Mail-Box-0.5/t/2mbox3d.t +++ b/Mail-Box-0.6/t/2mbox3d.t @@ -1,3 +1,4 @@ +#!/usr/local/bin/perl -w # # Test delay-loading on mbox folders. @@ -98,7 +99,7 @@ ok($message->isa('MIME::Entity')); ok(!defined $message->head->get('xyz')); ok(not $folder->message(2)->isParsed); -ok(defined $folder->message(2)->get('x-mailer')); +ok(defined $folder->message(2)->head->get('x-mailer')); ok($folder->message(2)->isParsed); unlink $src; diff --git a/Mail-Box-0.5/t/2mbox4a.t b/Mail-Box-0.6/t/2mbox4a.t old mode 100644 new mode 100755 similarity index 98% rename from Mail-Box-0.5/t/2mbox4a.t rename to Mail-Box-0.6/t/2mbox4a.t index b53a1f9..57b88aa --- a/Mail-Box-0.5/t/2mbox4a.t +++ b/Mail-Box-0.6/t/2mbox4a.t @@ -1,3 +1,4 @@ +#!/usr/local/bin/perl -w # # Test appending messages on Mbox folders. @@ -12,7 +13,6 @@ use strict; use Mail::Box::Manager; BEGIN {plan tests => 6} -#exit 0; # # We will work with a copy of the original to avoid that we write diff --git a/Mail-Box-0.6/t/3mh1r.t b/Mail-Box-0.6/t/3mh1r.t new file mode 100755 index 0000000..2fe67b5 --- /dev/null +++ b/Mail-Box-0.6/t/3mh1r.t @@ -0,0 +1,187 @@ +#!/usr/local/bin/perl -w + +# +# Test reading of MH folders. +# + +use Test; +use File::Compare; +use File::Copy; +use lib '..', 't'; +use strict; + +use Mail::Box::MH; +use Mail::Box::Mbox; + +use Tools; + +BEGIN {plan tests => 26} + +my $orig = 't/mbox.src'; +my $src = 't/mh.src'; + +unpack_mbox($orig, $src); + +ok(Mail::Box::MH->foundIn($src)); + +my $folder = new Mail::Box::MH + ( folder => $src + , lock_method => 'NONE' + , lazy_extract => 'ALWAYS' + , access => 'rw' + ); + +ok(defined $folder); + +# We skipped message number 13 in the production, but that shouldn't +# distrub things. + +ok($folder->messages==45); + +# +# No single head should be read now, because take_headers==DELAY +# the default. +# + +my $heads = 0; +foreach ($folder->messages) +{ $heads++ if $_->headIsRead; +} +ok($heads==0); + +# +# Loading a header should not be done unless really necessary. +# + +my $message = $folder->message(7); +ok(not $message->headIsRead); + +ok($message->filename); # already known, but should not trigger header +ok(not $message->headIsRead); + +# +# Nothing should be parsed yet +# + +my $parsed = 0; +foreach ($folder->messages) +{ $parsed++ if $_->isParsed; +} +ok($parsed==0); + +# +# Trigger one message to get read. +# + +ok($message->body); # trigger body loading. +ok($message->isParsed); + +# +# Test taking header +# + +$message = $folder->message(8); +ok($message->head->get('subject')); +ok(not $message->isParsed); +ok(ref $message->head eq 'MIME::Head'); + +# This shouldn't cause any parsings: we do lazy extract, but Mail::Box +# will always take the `Subject' header for us. + +my @subjects = map { chomp; $_ } + map {$_->head->get('subject') || '' } + $folder->messages; + +$parsed = 0; +$heads = 0; +foreach ($folder->messages) +{ $parsed++ if $_->isParsed; + $heads++ if $_->headIsRead; +} +ok($parsed==1); # Loaded message 7 in an earlier test. +ok($heads==45); + +# +# The subjects must be the same as from the original Mail::Box::Mbox +# There are some differences with new-lines at the end of headerlines +# + +my $mbox = Mail::Box::Mbox->new + ( folder => $orig + , lock_method => 'NONE' + , access => 'r' + ); + +my @fsubjects = map { chomp; $_ } + map {$_->head->get('subject') || ''} + $mbox->messages; + +my (%subjects); +$subjects{$_}++ foreach @subjects; +$subjects{$_}-- foreach @fsubjects; + +my $missed = 0; +foreach (keys %subjects) +{ $missed++ if $subjects{$_}; + warn "Still left: $_ ($subjects{$_}x)\n" if $subjects{$_}; +} +ok(!$missed); + +# +# Check if we can read a body. +# + +my $msg3 = $folder->message(3); +my $body = $msg3->body; +ok(defined $body); +ok(@$body==43); # check expected number of lines in message 3. + +$folder->close; + +# +# Now with partially lazy extract. +# + +my $parse_size = 5000; +$folder = new Mail::Box::MH + ( folder => $src + , lock_method => 'NONE' + , lazy_extract => $parse_size # messages > $parse_size bytes stay unloaded. + , access => 'rw' + ); + +ok(defined $folder); + +ok($folder->messages==45); + +$parsed = 0; +$heads = 0; +my $mistake = 0; +foreach ($folder->messages) +{ $parsed++ if $_->isParsed; + $heads++ if $_->headIsRead; + $mistake++ if $_->isParsed && $_->size > $parse_size; +} + +ok(not $mistake); +ok(not $parsed); +ok(not $heads); + +foreach (5..13) +{ $folder->message($_)->head->get('subject'); +} + +$parsed = 0; +$heads = 0; +$mistake = 0; +foreach ($folder->messages) +{ $parsed++ if $_->isParsed; + $heads++ if $_->headIsRead; + $mistake++ if $_->isParsed && $_->size > $parse_size; +} + +ok(not $mistake); +ok($parsed == 7); +ok($heads == 9); + +clean_dir $src; diff --git a/Mail-Box-0.6/t/3mh2w.t b/Mail-Box-0.6/t/3mh2w.t new file mode 100755 index 0000000..bd06e9d --- /dev/null +++ b/Mail-Box-0.6/t/3mh2w.t @@ -0,0 +1,42 @@ +#!/usr/local/bin/perl -w + +# +# Test writing of MH folders. +# + +use Test; +use File::Compare; +use File::Copy; +use lib '..', 't'; +use strict; + +use Mail::Box::MH; +use Mail::Box::Mbox; + +use Tools; + +BEGIN {plan tests => 2} + +my $orig = 't/mbox.src'; +my $src = 't/mh.src'; + +unpack_mbox($orig, $src); + +my $folder = new Mail::Box::MH + ( folder => $src + , lock_method => 'NONE' + , lazy_extract => 'ALWAYS' + , access => 'rw' + , keep_index => 1 + ); + +ok(defined $folder); + +my $msg3 = $folder->message(3); +ok(not $msg3->isParsed); + +# Nothing yet... + +$folder->close; + +clean_dir $src; diff --git a/Mail-Box-0.6/t/3mh3a.t b/Mail-Box-0.6/t/3mh3a.t new file mode 100755 index 0000000..e9a5ac1 --- /dev/null +++ b/Mail-Box-0.6/t/3mh3a.t @@ -0,0 +1,94 @@ +#!/usr/local/bin/perl -w + +# +# Test appending messages on MH folders. +# + +use Test; +use File::Compare; +use File::Copy; +use lib '..', 't'; +use strict; + +use Mail::Box::Manager; +use Tools; + +BEGIN {plan tests => 12} + +my $orig = 't/mbox.src'; +my $src = 't/mh.src'; + +# +# Unpack the file-folder. +# + +unpack_mbox($orig, $src); + +my $mgr = Mail::Box::Manager->new; + +my $folder = $mgr->open + ( folder => $src + , lock_method => 'NONE' + , lazy_extract => 'ALWAYS' + , access => 'rw' + , save_on_exit => 0 + ); + +die "Couldn't read $src." unless $folder; + +# We checked this in other scripts before, but just want to be +# sure we have enough messages again. + +ok($folder->messages==45); + +# Add a message which is already in the opened folder. However, the +# message heads are not yet parsed, hence the message can not be +# ignored. + +my $message3 = $folder->message(3); + +my $fake = bless { %$message3 }, ref $message3; + +$folder->addMessage($fake); +ok($folder->messages==46); +ok(not $message3->headIsRead); +my $added = $folder->message(-1); +ok($added); +ok(not $added->headIsRead); + +# Now we trigger the load of the original message, which should cause it +# to do to deleted. + +$message3->head; +ok(not $message3->deleted); +$added->head; +ok($message3->deleted); +ok(not $added->deleted); + +# +# Create an MIME::Entity and add this to the open folder. +# + +my $msg = MIME::Entity->build + ( From => 'me@example.com' + , To => 'you@anywhere.aq' + , Subject => 'Just a try' + , Data => [ "a short message\n", "of two lines.\n" ] + ); + +$mgr->appendMessage($src, $msg); +ok($folder->messages==46); + +ok($mgr->openFolders==1); +$mgr->close($folder); # changes are not saved. +ok($mgr->openFolders==0); + +$mgr->appendMessage($src, $msg + , lock_method => 'NONE' + , lazy_extract => 'ALWAYS' + , access => 'rw' + ); + +ok(-f "$src/47"); # skipped 13, so new is 46+1 + +clean_dir $src; diff --git a/Mail-Box-0.5/t/7mgr.t b/Mail-Box-0.6/t/7mgr.t old mode 100644 new mode 100755 similarity index 95% rename from Mail-Box-0.5/t/7mgr.t rename to Mail-Box-0.6/t/7mgr.t index ff0678d..c21e37a --- a/Mail-Box-0.5/t/7mgr.t +++ b/Mail-Box-0.6/t/7mgr.t @@ -1,3 +1,4 @@ +#!/usr/local/bin/perl -w # # Test the folder manager diff --git a/Mail-Box-0.5/t/8tie.t b/Mail-Box-0.6/t/8tie.t old mode 100644 new mode 100755 similarity index 96% rename from Mail-Box-0.5/t/8tie.t rename to Mail-Box-0.6/t/8tie.t index 8ad870a..f2b2e94 --- a/Mail-Box-0.5/t/8tie.t +++ b/Mail-Box-0.6/t/8tie.t @@ -1,3 +1,4 @@ +#!/usr/local/bin/perl -w # # Test access to folders using ties. diff --git a/Mail-Box-0.5/t/9lock.t b/Mail-Box-0.6/t/9lock.t old mode 100644 new mode 100755 similarity index 95% rename from Mail-Box-0.5/t/9lock.t rename to Mail-Box-0.6/t/9lock.t index 43ae51a..a1d0e1a --- a/Mail-Box-0.5/t/9lock.t +++ b/Mail-Box-0.6/t/9lock.t @@ -1,3 +1,4 @@ +#!/usr/local/bin/perl -w # # Test the locking methods. diff --git a/Mail-Box-0.6/t/Tools.pm b/Mail-Box-0.6/t/Tools.pm new file mode 100644 index 0000000..f9292de --- /dev/null +++ b/Mail-Box-0.6/t/Tools.pm @@ -0,0 +1,53 @@ + +package Tools; +use strict; +use Exporter; +our @ISA = 'Exporter'; +our @EXPORT = qw/clean_dir unpack_mbox/; + +# CLEAN_DIR +# Clean a directory structure, typically created by unpack_mbox() +# + +sub clean_dir($); +sub clean_dir($) +{ my $dir = shift; + opendir DIR, $dir or return; + + foreach (map { "$dir/$_" } grep !/^\.\.?$/, readdir DIR) + { if(-d) { clean_dir $_ } + else { unlink $_ } + } + + closedir DIR; + rmdir $dir; +} + +# UNPACK_MBOX +# Unpack an mbox-file into an MH-directory. +# This skips message-nr 13 for testing purposes. + +sub unpack_mbox($$) +{ my ($file, $dir) = @_; + clean_dir($dir); + + mkdir $dir; + my $count = 1; + + open FILE, $file or die; + open OUT, '/dev/null'; + + while() + { if( /^From / ) + { close OUT; + open OUT, '>', "$dir/".$count++ or die; + $count++ if $count==13; # skip 13 for test + next; # from line not included in file. + } + print OUT; + } + + close OUT; + close FILE; +} + diff --git a/Mail-Box-0.5/t/mbox.src b/Mail-Box-0.6/t/mbox.src similarity index 100% rename from Mail-Box-0.5/t/mbox.src rename to Mail-Box-0.6/t/mbox.src