#!/usr/bin/perl -T
$| = 1;
##############################################################################
# This is POP3 gateway server which retrieves your messages from mixi.
#           http://mixi.jp/
#
# require : Perl 5.6 or later.
# Depend  : Net::Server, Net::Server::POP3, DateTime,
#           DateTime::Format::Mail, WWW::Mixi, Jcode, Digest::MD5
# author  : makamaka [at] donzoko.net
# license : same as Perl's
#
# original code from Net-Server-POP3's  scripts/simpletest.pl
# See     : http://search.cpan.org/~jonadab/Net-Server-POP3-0.0009/
#
# See Also : http://search.cpan.org/dist/WWW-Mixi/
##############################################################################
# (default example)
#-----------------------------------------------------------------------------
# $ su
# # cd your_favorite_dir
# # mkdir tmp
# # chown nobody: tmp
# # ./mixi_pop3.pl
#-----------------------------------------------------------------------------
# If you want to stop the server, please use kill.
##############################################################################
use strict;
use warnings;
use lib qw(./lib);

use Net::Server::POP3;
use DateTime;
use DateTime::Format::Mail;
use Jcode;
use Digest::MD5;

use WWW::Mixi;
##############################################################################
# Set your server options
##############################################################################
my $Tempdir    = './tmp'; # message digests
my $Port       = 110;     # by default 110
my $Welcome    = 'Welcome to mixi_pop3 gateway (based on Net::Server::POP3)';
# (perldoc Net::Server::POP3)
my $Serveropts = { user => 'nobody', group => 'nobody', log_level => 3 };
##############################################################################
our $VERSION = 0.11;
our $DEBUG   = 0;

my $newmsgnum;
my $Inbox = { mail => [] };

my $server = Net::Server::POP3->new(
	port         => $Port,
	serveropts   => $Serveropts,
	authenticate => \&authenticate, 
	list         => \&list,
	retrieve     => \&retrieve,
	size         => \&size,
	delete       => \&delete,
	EOL          => "\r\n",
	welcome      => $Welcome,
);


$server->startserver();

##############################################################################

sub authenticate {
	my ($user, $pass, $ip) = @_;
	my $mixi = WWW::Mixi->new($user,$pass, -abort => sub { 0; });

	if(!$mixi->login){
		return 0;
	}

	if(! @{$Inbox->{mail}}){
		my $rv = _get_mixi_messages($mixi, $user, $pass, $ip);

		$Inbox->{user_digest} = Digest::MD5::md5_hex($user);

		%{$Inbox->{msgid}}    = map{ ($_->[0] => $_) } @{$rv->[0]};
		%{$Inbox->{digest}}   = %{$rv->[1]};

		push @{$Inbox->{mail}}, @{$rv->[0]};
	}

	return 1;
}


sub list {
	my ($username) = @_;
	return map { $_->[0] } @{$Inbox->{mail}};
}


sub retrieve {
	  warn "Attempting to retrieve @_\n" if $DEBUG;
	  my ($username, $msgid) = @_;
	  my $mail = $Inbox->{msgid}->{$msgid};
	  my $msg = $mail->[1];
	  warn "$msg\n" if $DEBUG;
	  return $msg;
}


sub size {
	  warn "Attempting to find size of @_\n" if $DEBUG;
	  my ($username, $msgid) = @_;
	  my $mail = $Inbox->{msgid}->{$msgid};
	  my $len  = length $mail->[1];
	  warn "Found size:  $len\n" if $DEBUG;
	  return $len;
}


sub newmessage {
	++$newmsgnum;
	my ($username, $message) = @_;

	my ($year,$mon,$day,$hour,$min)
	 = $message->{time} =~ m{(\d{4})/(\d{2})/(\d{2}) (\d{2}):(\d{2})};

	my $dt = DateTime->new(
		year  => $year, month => $mon, day   => $day, hour  => $hour,
		minute=> $min, second=> 0, time_zone => 'Asia/Tokyo',
	);

	my $stamp = sprintf("%04d%02d%02d%02d%02d%02d%05d",
		$dt->year(), $dt->month(), $dt->day(), $dt->hour(), $dt->min(),
		$dt->sec(), $newmsgnum
	);

	my ($mixi_id)  = $message->{link} =~ /\?id=(\w+)/;
	my $dateheader = DateTime::Format::Mail->format_datetime($dt);
	my $newmsgid   = "miximsg$mixi_id.$stamp\@test.mixi.example.com";

	my $name        = $message->{name};
	my $subject     = $message->{subject};
	my $description = $message->{description};
	my $reply       = $message->{reply_action};

	$description =~ s/\r/\n/g;

	$name        = jcode($name,'euc')->mime_encode;
	$description = jcode($description,'euc')->iso_2022_jp;
	$subject     = jcode($subject,'euc')->mime_encode;

	my $newmsgtext = <<"MESSAGE";
Received: from /dev/random by mixi_pop3
From: $name <$mixi_id\@mixi.pop3.localhost>
To: $username
Precedence: bulk
Message-ID: $newmsgid
Subject: $subject
Content-Type: text/plain; charset=iso-2022-jp
Date: $dateheader

$description
----
Reply : $reply
MESSAGE
  return [$newmsgid, $newmsgtext];
}


sub delete { # virtual dele
	my ($username, $msgid) = @_;
	my $mail        = $Inbox->{msgid}->{$msgid};
	my $user_digest = $Inbox->{user_digest};
	my $digest      = $Inbox->{digest}->{$msgid};

	_mark_dele($user_digest,$digest);
}


####


sub _get_mixi_messages { warn "ok get mixi message...\n" if($DEBUG);
	my ($mixi, $user, $pass, $ip) = @_;
	my @items = $mixi->get_list_message();
	my (@box,%digest);

	my $user_digest = Digest::MD5::md5_hex($user);
	my $digest_list = _list_digest($user_digest); # return hashref

	for my $item (reverse @items){
		my $digest = Digest::MD5::md5_hex($item->{link});

		# if exists, return message. dele marked, return 0. otherwise undef.
		if( defined( my $content = _get_digest($user_digest,$digest)) ){
			if($content){
				my ($msgid,$message) = split/\n/,$content,2;
				push @box, [$msgid,$message];
				$digest{$msgid} = $digest;
			}
			delete $digest_list->{$digest};
		}
		else{
			my $mail = $mixi->get_view_message($item->{link});
			my %action
			 = map{ ($_->{command} => $_->{action})  } $mixi->parse_view_message_form();
			$mail->{reply_action}  = $action{reply_message};
			my $data = newmessage($user, $mail);
			push @box, $data;
			$digest{$data->[0]} = $digest;
			_make_digest($user_digest, $digest, $data);
		}
	}

	for my $must_del (keys %$digest_list){
		_delete_digest($user_digest,$must_del);
	}

	return [\@box,\%digest];
}


sub _mark_dele {
	my ($dir,$digest) = @_;

	unless(-e "$Tempdir/$dir/$digest"){
		warn "$Tempdir/$dir/$digest is already deleted.\n";
		return;
	}

	rename "$Tempdir/$dir/$digest","$Tempdir/$dir/.$digest";
}


sub _delete_digest {
	my ($dir,$digest) = @_;

	if(-e "$Tempdir/$dir/$digest"){
		unlink "$Tempdir/$dir/$digest" or warn $!;
	}
	elsif(-e "$Tempdir/$dir/.$digest"){
		unlink "$Tempdir/$dir/.$digest" or warn $!;
	}
}


sub _get_digest {
	my ($dir,$digest) = @_;

	unless(-d "$Tempdir/$dir"){
		mkdir "$Tempdir/$dir" or warn $!;
	}

	my $normal = -e "$Tempdir/$dir/$digest";
	my $dele   = -e "$Tempdir/$dir/.$digest";

	return undef if(!$normal and !$dele);
	return 0     if($dele);

	local $/ = undef;
	open(FILE,"$Tempdir/$dir/$digest") or return;
	my $content = <FILE>;
	close(FILE);

	$content;
}


sub _list_digest {
	my ($dir) = @_;
	my %hash;

	return {} unless(-d "$Tempdir/$dir");

	opendir(DIR,"$Tempdir/$dir") or warn $!;
	while(my $file = readdir(DIR)){
		next unless(-f "$Tempdir/$dir/$file");
		($file) = $file =~ /\/?\.?(\w+)$/;
		$hash{$file} = 1;
	}
	closedir(DIR);

	return \%hash;
}


sub _make_digest {
	my ($dir,$digest,$data) = @_;
	my ($msgid,$message) = ($data->[0],$data->[1]);
	open(FILE,">$Tempdir/$dir/$digest") or warn $!;
	print FILE join("\n",$msgid,$message);
	close(FILE);
}