root/lang/perl/misc/i18n-emoji/EmailPOP3.pm

# ------------------------------------------------------------------------
#   EmailPOP3.pm --- POP3 Client based on UID
# ------------------------------------------------------------------------
    use strict;
    package EmailPOP3;
    use IO::Socket::INET;
# ------------------------------------------------------------------------
    my $DEFAULT_SOCKET = {
        PeerPort    =>  "110",
        Proto       =>  "tcp",
        Timeout     =>  3,
    };
# ------------------------------------------------------------------------
sub new {
    my $pkg = shift;
    my $obj = {};
    bless $obj, $pkg;
    $obj->{args} = { @_ };      # options
    $obj;
}
# ------------------------------------------------------------------------
#   $socket = $pop3->connect();
# ------------------------------------------------------------------------
sub connect {
    my $obj = shift;
    if ( $obj->{socket} && $obj->{socket}->connected() ) {
        return $obj->{socket};
    }

    my $conn = { %$DEFAULT_SOCKET };            # copy
    foreach my $key ( keys %{$obj->{args}} ) {
        next unless ( $key =~ /^[A-Z]/ );       # CAPITAL
        $conn->{$key} = $obj->{args}->{$key};
    }
    my $host = $conn->{PeerAddr} || $conn->{PeerHost};
    $obj->{socket} = new IO::Socket::INET(%$conn);
    unless ( $obj->{socket} ) {
        $obj->{error} = "POP3 connection failed - $host";
        return;
    }

    $obj->cmd_single() or return;
    $obj->cmd_single( "USER", $obj->{args}->{user} ) or return;
    $obj->cmd_single( "PASS", $obj->{args}->{pass} ) or return;

    $obj->{socket};
}
# ------------------------------------------------------------------------
#   $list = $pop3->uidl();
# ------------------------------------------------------------------------
sub uidl {
    my $obj = shift;
    return $obj->{uidlist} if ref $obj->{uidlist};
    $obj->connect() or return;
    my $res = $obj->cmd_multi( "UIDL" ) or return;
    my $uidlist = [];
    my $uidhash = {};
    foreach my $line ( @$res ) {
        chomp $line;
        my( $msg, $uid ) = split( /\s+/, $line );
        push( @$uidlist, $uid );
        $uidhash->{$uid} = $msg;
    }
    $obj->{uidhash} = $uidhash;
    $obj->{uidlist} = $uidlist;
}
# ------------------------------------------------------------------------
#   ( $mails, $total ) = $pop3->stat();
# ------------------------------------------------------------------------
sub stat {
    my $obj = shift;
    my $uid = shift;
    $obj->connect() or return;
    my $stat = $obj->cmd_single( "STAT" ) or return;
    my( $mails, $total ) = @$stat;
    wantarray ? ( $mails, $total ) : $mails;
}
# ------------------------------------------------------------------------
#   $size = $pop3->msgid( $uid );
# ------------------------------------------------------------------------
sub msgid {
    my $obj = shift;
    my $uid = shift;
    $obj->uidl() or return;
    $obj->{uidhash}->{$uid};
}
# ------------------------------------------------------------------------
#   $size = $pop3->size( $uid );
# ------------------------------------------------------------------------
sub size {
    my $obj = shift;
    my $uid = shift;
    $obj->uidl() or return;
    my $msg = $obj->{uidhash}->{$uid} or return;
    my $res = $obj->cmd_single( "LIST", $msg ) or return;
    return $res->[1];
}
# ------------------------------------------------------------------------
#   $top = $pop3->top( $uid, $lines );
# ------------------------------------------------------------------------
sub top {
    my $obj = shift;
    my $uid = shift;
    my $line = shift || 0;
    $obj->uidl() or return;
    my $msg = $obj->{uidhash}->{$uid} or return;
    return $obj->cmd_multi( "TOP", $msg, $line );
}
# ------------------------------------------------------------------------
#   $mail = $obj->retr( $uid );
# ------------------------------------------------------------------------
sub retr {
    my $obj = shift;
    my $uid = shift;
    $obj->uidl() or return;
    my $msg = $obj->{uidhash}->{$uid} or return;
    return $obj->cmd_multi( "RETR", $msg );
}
# ------------------------------------------------------------------------
#   $mail = $obj->retr_to_handle( $uid, $fh );
# ------------------------------------------------------------------------
sub retr_to_handle {
    my $obj = shift;
    my $uid = shift;
        my $fh = shift;
    $obj->uidl() or return;
    my $msg = $obj->{uidhash}->{$uid} or return;
    return $obj->cmd_multi_to_handle( $fh, "RETR", $msg );
}
# ------------------------------------------------------------------------
#   $ok = $pop3->dele( $uid );
# ------------------------------------------------------------------------
sub delete_mail {
    my $obj = shift;
    my $uid = shift;
    $obj->uidl() or return;
    my $msg = $obj->{uidhash}->{$uid} or return;
    my $res = $obj->cmd_multi( "DELE", $msg ) or return;
    $res;
}
# ------------------------------------------------------------------------
#   $pop3->noop();
# ------------------------------------------------------------------------
sub noop {
    my $obj = shift;
    $obj->connect() or return;
    return $obj->cmd_single( "NOOP" );
}
# ------------------------------------------------------------------------
#   $pop3->rset();
# ------------------------------------------------------------------------
sub rset {
    my $obj = shift;
    $obj->connect() or return;
    return $obj->cmd_single( "RSET" );
}
# ------------------------------------------------------------------------
#   $ok = $pop3->quit();
# ------------------------------------------------------------------------
sub quit {
    my $obj = shift;
    $obj->connect() or return;
    return $obj->cmd_single( "QUIT" );
}
# ------------------------------------------------------------------------
#   send a pop command and receive one result line.
# ------------------------------------------------------------------------
sub cmd_single {
    my $obj = shift;
    my $sock = $obj->{socket} or return;
    $sock->print( join(" ", @_ ), "\n" ) if scalar @_;
    my $res = $sock->getline();
    $res =~ s/[\r\n]+$//s;
    if ( $res =~ /^\+OK/ ) {
        my $list = [split( /\s+/, $res )];
        shift @$list;
        return $list;                           # return ref
    } else {
        $obj->{error} = $res;
        return undef;                           # return undef
    }
}
# ------------------------------------------------------------------------
#   send a pop command and receive multiple result lines.
# ------------------------------------------------------------------------
sub cmd_multi {
    my $obj = shift;
    my $res = $obj->cmd_single( @_ ) or return; # return undef
    my $sock = $obj->{socket} or return;
    my $array = [];
    while( my $line = $sock->getline() ) {
        $line =~ s/[\r\n]+$/\n/s;
        last if ( $line =~ /^\.$/ );
        $line =~ s/^\.\././;
        push( @$array, $line );
    }
    $array;                                     # return ref
}
# ------------------------------------------------------------------------
#   send a pop command and write result to the handle.
# ------------------------------------------------------------------------
sub cmd_multi_to_handle {
    my $obj = shift;
        my $fh = shift;
    my $res = $obj->cmd_single( @_ ) or return; # return undef
    my $sock = $obj->{socket} or return;
    my $array = [];
        my $cnt = 0;
    while( my $line = $sock->getline() ) {
        $line =~ s/[\r\n]+$/\n/s;
        last if ( $line =~ /^\.$/ );
        $line =~ s/^\.\././;
                print $fh $line;
                $cnt ++;
    }
        $cnt;                                                                           # return count (not undef)
}
# ------------------------------------------------------------------------
;1;
# ------------------------------------------------------------------------

=head1 NAME

    EmailPOP3.pm - POP3 Client based on UID

=head1 SYNOPSIS

    use EmailPOP3;
    
    my $conn = {
        PeerHost    =>  "pop.example.com",
        PeerPort    =>  "110",
        Proto       =>  "tcp",
        Timeout     =>  3,
    };
    my $pop3 = new EmailPOP3( %$conn );

    ( $mails, $total ) = $pop3->stat();         # get status
    print "$mails mails with $total bytes.\n";

    my $list = $pop3->uidl();                   # get UID list

    foreach my $uid ( @$list ) {
        my $mail = $obj->retr( $uid );          # get mail header and body
        print $mail;
        $pop3->dele( $uid );                    # delete mail
    }
    $pop3->quit();                              # quit pop3 connection

=cut