view release on metacpan or  search on metacpan

Net/POP3.pm  view on Meta::CPAN

sub getfh
{
 @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )';
 my $me = shift;

 return unless $me->_RETR(shift);
 return        $me->tied_fh;
}



sub delete
{
 @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
 $_[0]->_DELE($_[1]);
}

sub uidl
{
 @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )';
 my $me = shift;
 my $uidl;

 $me->_UIDL(@_) or
    return undef;
 if(@_)
  {
   $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0];
  }
 else
  {
   my $ref = $me->read_until_dot
	or return undef;
   my $ln;
   $uidl = {};
   foreach $ln (@$ref) {
     my($msg,$uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/;
     $uidl->{$msg} = $uid;
   }
  }
 return $uidl;
}

sub ping
{
 @_ == 2 or croak 'usage: $pop3->ping( USER )';
 my $me = shift;

 return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/;

 ($1 || 0, $2 || 0);
}

sub _lookup_credentials
{
  my ($me, $user) = @_;

  require Net::Netrc;

  $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] } ||
    $ENV{NAME} || $ENV{USER} || $ENV{LOGNAME};

  my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
  $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});

  my $pass = $m ? $m->password || ""
                : "";

  ($user, $pass);
}

sub _get_mailbox_count
{
  my ($me) = @_;
  my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
	  ? $1 : ($me->popstat)[0];

  $ret ? $ret : "0E0";
}


sub _STAT { shift->command('STAT')->response() == CMD_OK }
sub _LIST { shift->command('LIST',@_)->response() == CMD_OK }
sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK }
sub _DELE { shift->command('DELE',$_[0])->response() == CMD_OK }
sub _NOOP { shift->command('NOOP')->response() == CMD_OK }
sub _RSET { shift->command('RSET')->response() == CMD_OK }
sub _QUIT { shift->command('QUIT')->response() == CMD_OK }
sub _TOP  { shift->command('TOP', @_)->response() == CMD_OK }
sub _UIDL { shift->command('UIDL',@_)->response() == CMD_OK }
sub _USER { shift->command('USER',$_[0])->response() == CMD_OK }
sub _PASS { shift->command('PASS',$_[0])->response() == CMD_OK }
sub _APOP { shift->command('APOP',@_)->response() == CMD_OK }
sub _PING { shift->command('PING',$_[0])->response() == CMD_OK }

sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK }
sub _LAST { shift->command('LAST')->response() == CMD_OK }

sub quit
{
 my $me = shift;

 $me->_QUIT;
 $me->close;
}

sub DESTROY
{
 my $me = shift;

 if(defined fileno($me))
  {
   $me->reset;
   $me->quit;
  }
}

##
## POP3 has weird responses, so we emulate them to look the same :-)
##