libmail-box-perl 2.110-1 / usr / share / perl5 / Mail / Box / POP3.pm

# Copyrights 2001-2014 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.01.

package Mail::Box::POP3;
use vars '$VERSION';
$VERSION = '2.110';

use base 'Mail::Box::Net';

use strict;
use warnings;

use Mail::Box::POP3::Message;
use Mail::Box::Parser::Perl;
use Mail::Box::FastScalar;

use File::Spec;
use File::Basename;
use Carp;


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

    $args->{server_port} ||= 110;
    $args->{folder}      ||= 'inbox';

    $self->SUPER::init($args);

    $self->{MBP_client}    = $args->{pop_client}; 
    $self->{MBP_auth}      = $args->{authenticate} || 'AUTO';

    $self;
}


sub create($@) { undef }         # fails

sub foundIn(@)
{   my $self = shift;
    unshift @_, 'folder' if @_ % 2;
    my %options = @_;

       (exists $options{type}   && lc $options{type} eq 'pop3')
    || (exists $options{folder} && $options{folder} =~ m/^pop/);
}


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

    $self->log(ERROR => "You cannot write a message to a pop server (yet)")
       if defined $message;

    undef;
}


sub addMessages(@)
{   my $self = shift;

    # error message described in addMessage()
    $self->log(ERROR => "You cannot write messages to a pop server (yet)")
        if @_;

    ();
}

sub type() {'pop3'}

sub close(@)
{   my $self = shift;

    $self->SUPER::close(@_);

    my $pop = delete $self->{MBP_client};
    $pop->disconnect if defined $pop;

    $self;
}


sub delete(@)
{   my $self = shift;
    $self->log(WARNING => "POP3 folders cannot be deleted.");
    undef;
}


sub listSubFolders(@) { () }     # no


sub openSubFolder($@) { undef }  # fails

sub topFolderWithMessages() { 1 }  # Yes: only top folder


sub update() {shift->notImplemented}

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


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

    return $self->{MBP_client}
        if defined $self->{MBP_client};

    my $auth = $self->{auth};

    require Mail::Transport::POP3;
    my $client  = Mail::Transport::POP3->new
      ( username     => $self->{MBN_username}
      , password     => $self->{MBN_password}
      , hostname     => $self->{MBN_hostname}
      , port         => $self->{MBN_port}
      , authenticate => $self->{MBP_auth}
      , use_ssl      => $args{use_ssl}
      );

    $self->log(ERROR => "Cannot create POP3 client for $self.")
       unless defined $client;

    $self->{MBP_client} = $client;
}

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

    my $pop   = $self->popClient or return;
    my @log   = $self->logSettings;
    my $seqnr = 0;

    foreach my $id ($pop->ids)
    {   my $message = $args{message_type}->new
         ( head      => $args{head_delayed_type}->new(@log)
         , unique    => $id
         , folder    => $self
         , seqnr     => $seqnr++
         );

        my $body    = $args{body_delayed_type}->new(@log, message => $message);
        $message->storeBody($body);

        $self->storeMessage($message);
    }

    $self;
}
 

sub getHead($)
{   my ($self, $message) = @_;
    my $pop   = $self->popClient or return;

    my $uidl  = $message->unique;
    my $lines = $pop->header($uidl);

    unless(defined $lines)
    {   $lines = [];
        $self->log(WARNING  => "Message $uidl disappeared from POP3 server $self.");
    }

    my $text   = join '', @$lines;
    my $parser = Mail::Box::Parser::Perl->new   # not parseable by C parser
     ( filename  => "$pop"
     , file      => Mail::Box::FastScalar->new(\$text)
     , fix_headers => $self->{MB_fix_headers}
     );

    $self->lazyPermitted(1);

    my $head     = $message->readHead($parser);
    $parser->stop;

    $self->lazyPermitted(0);

    $self->log(PROGRESS => "Loaded head of $uidl.");
    $head;
}


sub getHeadAndBody($)
{   my ($self, $message) = @_;
    my $pop   = $self->popClient or return;

    my $uidl  = $message->unique;
    my $lines = $pop->message($uidl);

    unless(defined $lines)
    {   $lines = [];
        $self->log(WARNING  => "Message $uidl disappeared from POP3 server $self.");
     }

    my $parser = Mail::Box::Parser::Perl->new   # not parseable by C parser
     ( filename  => "$pop"
     , file      => IO::ScalarArray->new($lines)
     );

    my $head = $message->readHead($parser);
    unless(defined $head)
    {   $self->log(ERROR => "Cannot find head back for $uidl on POP3 server $self.");
        $parser->stop;
        return undef;
    }

    my $body = $message->readBody($parser, $head);
    unless(defined $body)
    {   $self->log(ERROR => "Cannot read body for $uidl on POP3 server $self.");
        $parser->stop;
        return undef;
    }

    $parser->stop;

    $self->log(PROGRESS => "Loaded message $uidl.");
    ($head, $body);
}


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

    if(my $modifications = grep {$_->isModified} @{$args->{messages}})
    {   $self->log(WARNING =>
           "Update of $modifications messages ignored for POP3 folder $self.");
    }

    $self;
}

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



1;