#!/usr/bin/winperl
use warnings;
use strict;

use lib '.';
use base 'Net::Server::POP3::Skeleton';

use POSIX 'strftime';
use Mail::Webmail::Yahoo;

use constant PEND_INDEX => 0;
use constant PEND_MESSG => 1;

# Make STDOUT and STDERR autoflush
select((select(STDOUT), $|=1, select(STDERR), $|=1)[0]);

our $INBOX_FOLDER   = 'Inbox';
our $TRASH_FOLDER   = 'Trash';


# Create and start the server.
main->new(
  greeting  => 'POP3 Perl::Yahoo::POP ready',
  host      => 'localhost',
  log_file  => 'yahoo.log',
  log_level => 2,
  #setsid    => 1,  # Doesn't work on Win32
)->run();

#*********  Command Implementations  *********#

sub user {
  my $self = shift;
  my $name = shift;

  unless(defined $name) {
    $self->senderr("missing argument");
    return;
  }

  $self->log(4, "Received USER: $name");

  $self->set('username', $name);

  $self->sendok("username accepted, send password");
}

sub pass {
  my $self = shift;
  my $pass = shift;
  my $name = $self->get('username');

  return $self->unknown()                   unless defined $name;
  return $self->senderr("missing argument") unless defined $pass;

  $self->log(4, "Received PASS: $pass");

  $self->set('password', $pass);

  my $yahoo = Mail::Webmail::Yahoo->new(
    username => $self->get('username'),
    password => $self->get('password'),
  );

  $yahoo->trace(1) if $self->{server}{debug};

  $self->log(3, "Received auth, attempting login");
  unless($yahoo->login) {
    $self->log(0, "Auth failure ($@)");
    $self->senderr("connection or authentication failure ($@)");
    $self->set('username', undef);
    return;
  }

  $yahoo->guess_text_on_multipart(1);

  $self->set('yahoo', $yahoo);

  $self->state('TRANS');

  my @msgs = $yahoo->get_folder_index($INBOX_FOLDER);
  $self->set('message list', \@msgs);
  $self->set('message count', scalar @msgs);

  $self->log(2, "Logged on as ".$self->get('username')." (".@msgs." ms
+gs)");
  $self->sendok(@msgs . " messages");
}

sub stat {
  my $self = shift;
  my @msgs = @{$self->get('message list')};
  my $size = 0;

  $size += size2oct($_->{size}) for @msgs;

  $self->log(4, "Received STAT: ".@msgs." $size");
  $self->sendok(@msgs . " $size");
}

sub list {
  my $self = shift;
  my $msg    = shift;
  my @msgs   = @{$self->get('message list')};

  $self->log(4, "Received LIST: " . defined($msg) ? $msg : '<undef>');

  if(defined $msg and (1 > $msg || $msg > @msgs) || !defined $msgs[$ms
+g-1]) {
    $self->senderr("no such message");
    return;
  }

  my @results = map { "$_ ".size2oct($msgs[$_-1]{size}) } (defined $ms
+g
    ? $msg
    : grep { defined $msgs[$_-1] } 1..@msgs
  );

  $self->senddata($self->get('message count') . " messages", @results)
+;
}

sub retr {
  my $self  = shift;
  my $msg   = shift;
  my $msgs  = $self->get('message list');
  my $yahoo = $self->get('yahoo');

  unless(defined $msg) {
    $self->senderr("missing argument: message number");
    return;
  }

  if((1 > $msg || $msg > @$msgs) or not defined($msgs->[$msg-1])) {
    $self->senderr("no such message");
    return;
  }

  $self->log(3, "Retrieving message #$msg");

  my ($msgb) = $yahoo->get_mail_messages($INBOX_FOLDER, [$msgs->[$msg-
+1]]);

  chomp(my @msg = split /\n/, $msgb->as_string);
  $self->senddata("message follows", @msg);
}

sub dele {
  my $self  = shift;
  my $msg   = shift;
  my $yahoo = $self->get('yahoo');
  my $msgs  = $self->get('message list');
  my $pend  = $self->get('pending');

  if(not defined $pend) {
    $pend = [];
    $self->set('pending', $pend);
  }

  $self->log(4, "Received DELE: " . defined($msg) ? $msg : '<undef>');

  if((defined $msg and 1 > $msg || $msg > @$msgs) or !defined $msgs->[
+$msg-1]) {
    $self->senderr("no such message");
    return;
  }

  $self->log(3, "Deleting message #$msg");
  push @$pend, [$msg, $msgs->[$msg-1]];


  undef $msgs->[$msg-1];
  $self->set('message count', $self->get('message count')-1);

  $self->sendok("message deleted");
}

sub noop {
  my $self = shift;
  $self->log(4, "Received NOOP");
  shift->sendok("nothing done");
}

sub rset {
  my $self  = shift;
  my $yahoo = $self->get('yahoo');
  my $pend  = $self->get('pending');
  my $msgs  = $self->get('message list');

  $self->log(4, "Received RSET");

  if(defined $pend and @$pend) {
    # Copy the messages back
    $msgs->[$_->[PEND_INDEX]-1] = $_->[PEND_MESSG] for @$pend;

    # Reset state (count and list of pending)
    $self->set('message count', scalar @$msgs);
    $self->set('pending', []);
  }

  $self->log(3, "Reset to ".@$msgs." messages");
  $self->sendok("messages reset; ".@$msgs." messages");
}

sub top {
  my $self  = shift;
  my $args  = shift;
  my $yahoo = $self->get('yahoo');
  my @msgs  = @{$self->get('message list')};

  $args =~ s/^\s+//;
  my ($msg, $lines) = split /\s+/, $args;

  $self->log(4, "Received TOP: " .
    (defined $msg ? $msg : '<undef>') .
    (defined $lines ? $lines : '<undef>')
  );

  unless(defined $msg) {
    $self->senderr("missing argument: message number");
    return;
  }

  unless(defined $lines) {
    $self->senderr("missing argument: number of lines");
    return;
  }

  unless(1 <= $msg && $msg <= @msgs && defined $msgs[$msg-1]) {
    $self->senderr("no such message");
    return;
  }

  unless($lines >= 0) {
    $self->senderr("invalid number of lines");
    return;
  }

  $lines = @msgs if $lines > @msgs;

  my ($msgb) = $yahoo->get_mail_messages($INBOX_FOLDER, [$msgs[$msg-1]
+]);

  chomp(my @head = @{$msgb->head->header});
  chomp(my @body = @{$msgb->body});
  $self->senddata("top of message follows", @head, '', @body[0..$lines
+-1]);
}

sub uidl {
  my $self = shift;

  # Message-ids must persist across sessions.
  # Yahoo's message-ids don't.  In fact, they
  # change when you move the message to another
  # folder.  Maybe in the future I will find a
  # way to implement this.
  #$self->senderr("command not implemented");
  #return;


  # The following does not create valid (ie,
  # persisting across sessions) message-ids.
  # Though, I *think* they only change when
  # the message is moved, so it should be
  # close enough.

  my ($msg)  = split /\s+/, shift;
  my @msgs   = @{$self->get('message list')};

  $self->log(4, "Received UIDL: " . defined $msg ? $msg : '<undef>');

  if(defined $msg and (1 > $msg || $msg > @msgs) || !defined $msgs[$ms
+g-1]) {
    $self->senderr("no such message");
    return;
  }

  my @results = map { "$_ ".$msgs[$_-1]{id} } (defined $msg
    ? $msg
    : grep { defined $msgs[$_-1] } 1..@msgs
  );

  if(@results == 1) {
    $self->sendok(@results);
  } else {
    $self->senddata(@msgs . " messages", @results);
  }
}


#*********  Non-Command Methods  *********#

sub commit {
  my $self  = shift;
  my $yahoo = $self->get('yahoo');
  my $pend  = $self->get('pending');

  $self->log(2, "Client QUIT");

  return unless defined $pend and @$pend;

  $self->log(1, "Committing ".@$pend." messages to Trash");
  $yahoo->move($INBOX_FOLDER, $TRASH_FOLDER, map { $_->[PEND_MESSG] } 
+@$pend);

  $self->set('pending', []);
}

sub disconnect {
  my $self  = shift;
  my $yahoo = $self->get('yahoo');
  my $pend  = $self->get('pending');

  $self->log(2, "Client disconnected");

  $self->set('yahoo', undef);
  $self->set('username', undef);
  $self->set('password', undef);

  return unless defined $pend and @$pend;

  $self->log(2, "Cleaning up ".@$pend." messages back to Inbox");

  $self->set('pending', []);
}

sub write_to_log_hook {
  my $self = shift;
  my $lvl  = shift;
  my $msg  = shift || '';
  my $date = strftime("[%d-%b-%Y %H:%M:%S]:", localtime);

  $self->SUPER::write_to_log_hook($lvl, "$date $msg");

  return;
}

#*********  Helper Functions  *********#

sub size2oct {
  my $size = uc(shift || '');

  return 0 unless $size =~ /^\s*(\d+)\s*([BKM])\s*$/;

  return $1 * 1024 * 1024 if $2 eq 'M';
  return $1 * 1024        if $2 eq 'K';
  return $1;
}
[download]