File Coverage

blib/lib/Mail/Box/Thread/Node.pm

Criterion	Covered	Total	%
statement	126	155	81.2
branch	43	62	69.3
condition	24	39	61.5
subroutine	28	35	80.0
pod	19	22	86.3
total	240	313	76.6

# Copyrights 2001-2020 by [Mark Overmeer].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# This code is part of distribution Mail-Box.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Mail::Box::Thread::Node;
use vars '$VERSION';
$VERSION = '3.009';

use base 'Mail::Reporter';

use strict;
use warnings;

use Carp;


sub new(@)
{   my ($class, %args) = @_;
    (bless {}, $class)->init(\%args);
}

sub init($)
{   my ($self, $args) = @_;

    if(my $message = $args->{message})
    {   push @{$self->{MBTN_messages}}, $message;
        $self->{MBTN_msgid} = $args->{msgid} || $message->messageId;
    }
    elsif(my $msgid = $args->{msgid})
    {   $self->{MBTN_msgid} = $msgid;
    }
    else
    {   croak "Need to specify message or message-id";
    }

    $self->{MBTN_dummy_type} = $args->{dummy_type};
    $self;
}

#-------------------------------------------


sub message()
{   my $self = shift;

    unless($self->{MBTN_messages})
    {   return () if wantarray;

        my $dummy = $self->{MBTN_dummy_type}->new
          ( messageId =>$self->{MBTN_msgid}
          );

        push @{$self->{MBTN_messages}}, $dummy;
        return $dummy;
    }

    my @messages = @{$self->{MBTN_messages}};
    return @messages    if wantarray;
    return $messages[0] if @messages==1;

    foreach (@messages)
    {   return $_ unless $_->isDeleted;
    }

    $messages[0];
}


sub addMessage($)
{   my ($self, $message) = @_;

    return $self->{MBTN_messages} = [ $message ]
        if $self->isDummy;

    push @{$self->{MBTN_messages}}, $message;
    $message;
}


sub isDummy()
{   my $self = shift;
    !defined $self->{MBTN_messages} || $self->{MBTN_messages}[0]->isDummy;
}


sub messageId() { shift->{MBTN_msgid} }


sub expand(;$)
{   my $self = shift;
    return $self->message->label('folded') || 0
        unless @_;

    my $fold = not shift;
    $_->label(folded => $fold) foreach $self->message;
    $fold;
}

sub folded(;$)    # compatibility <2.0
{  @_ == 1 ? shift->expand : shift->expand(not shift) }

#-------------------------------------------

sub repliedTo()
{   my $self = shift;

    return wantarray
         ? ($self->{MBTN_parent}, $self->{MBTN_quality})
         : $self->{MBTN_parent};
}


sub follows($$)
{   my ($self, $thread, $how) = @_;
    my $quality = $self->{MBTN_quality};

    # Do not create cyclic constructs caused by erroneous refs.

    my $msgid = $self->messageId;       # Look up for myself, upwards in thread
    for(my $walker = $thread; defined $walker; $walker = $walker->repliedTo)
    {   return undef if $walker->messageId eq $msgid;
    }

    my $threadid = $thread->messageId;  # a->b and b->a  (ref order reversed)
    foreach ($self->followUps)
    {   return undef if $_->messageId eq $threadid;
    }

    # Register

    if($how eq 'REPLY' || !defined $quality)
    {   $self->{MBTN_parent}  = $thread;
        $self->{MBTN_quality} = $how;
        return $self;
    }

    return $self if $quality eq 'REPLY';

    if($how eq 'REFERENCE' || ($how eq 'GUESS' && $quality ne 'REFERENCE'))
    {   $self->{MBTN_parent}  = $thread;
        $self->{MBTN_quality} = $how;
    }

    $self;
}


sub followedBy(@)
{   my $self = shift;
    $self->{MBTN_followUps}{$_->messageId} = $_ foreach @_;
    $self;
}


sub followUps()
{   my $self    = shift;
    $self->{MBTN_followUps} ? values %{$self->{MBTN_followUps}} : ();
}


sub sortedFollowUps()
{   my $self    = shift;
    my $prepare = shift || sub {shift->startTimeEstimate||0};
    my $compare = shift || sub {(shift) <=> (shift)};

    my %value   = map { ($prepare->($_) => $_) } $self->followUps;
    map { $value{$_} } sort {$compare->($a, $b)} keys %value;
}

#-------------------------------------------

sub threadToString(;$$$)   # two undocumented parameters for layout args
{   my $self    = shift;
    my $code    = shift || sub {shift->head->study('subject')};
    my ($first, $other) = (shift || '', shift || '');
    my $message = $self->message;
    my @follows = $self->sortedFollowUps;

    my @out;
    if($self->folded)
    {   my $text = $code->($message) || '';
        chomp $text;
        return "    $first [" . $self->nrMessages . "] $text\n";
    }
    elsif($message->isDummy)
    {   $first .= $first ? '-*-' : ' *-';
        return (shift @follows)->threadToString($code, $first, "$other   " )
            if @follows==1;

        push @out, (shift @follows)->threadToString($code, $first, "$other | " )
            while @follows > 1;
    }
    else
    {   my $text  = $code->($message) || '';
        chomp $text;
        my $size  = $message->shortSize;
        @out = "$size$first $text\n";
        push @out, (shift @follows)
                       ->threadToString($code, "$other |-", "$other | " )
            while @follows > 1;
    }

    push @out, (shift @follows)->threadToString($code, "$other `-","$other   " )
        if @follows;

    join '', @out;
}


sub startTimeEstimate()
{   my $self = shift;

    return $self->message->timestamp
        unless $self->isDummy;

    my $earliest;
    foreach ($self->followUps)
    {   my $stamp = $_->startTimeEstimate;

        $earliest = $stamp
	    if !defined $earliest || (defined $stamp && $stamp < $earliest);
    }

    $earliest;
}


sub endTimeEstimate()
{   my $self = shift;

    my $latest;
    $self->recurse
     (  sub { my $node = shift;
              unless($node->isDummy)
              {   my $stamp = $node->message->timestamp;
                  $latest = $stamp if !$latest || $stamp > $latest;
              }
            }
     );

    $latest;
}


sub recurse($)
{   my ($self, $code) = @_;

    $code->($self) or return $self;

    $_->recurse($code) or last
        foreach $self->followUps;

    $self;
}


sub totalSize()
{   my $self  = shift;
    my $total = 0;

    $self->recurse
     ( sub {
          my @msgs = shift->messages;
          $total += $msgs[0]->size if @msgs;
          1;}
     );

    $total;
}


sub numberOfMessages()
{   my $self  = shift;
    my $total = 0;
    $self->recurse( sub {++$total unless shift->isDummy; 1} );
    $total;
}

sub nrMessages() {shift->numberOfMessages}  # compatibility


sub threadMessages()
{   my $self = shift;
    my @messages;
    $self->recurse
     ( sub
       { my $node = shift;
         push @messages, $node->message unless $node->isDummy;
         1;
       }
     );

    @messages;
}



sub ids()
{   my $self = shift;
    my @ids;
    $self->recurse( sub {push @ids, shift->messageId} );
    @ids;
}

#-------------------------------------------



1;