#webliberty::POP3.pm (2007/03/01)
#Copyright(C) 2002-2007 Knight, All rights reserved.

package webliberty::POP3;

use strict;
use Jcode;
use Socket;

### コンストラクタ
sub new {
	my $class = shift;

	my $self = {
		pop_server  => shift,
		pop_user    => undef,
		pop_pwd     => undef,
		pop_port    => undef,
		mail_number => undef
	};
	bless $self, $class;

	binmode(STDOUT);

	return $self;
}

### ログイン
sub login {
	my $self = shift;
	my %args = @_;

	$self->{pop_user} = $args{'pop_user'};
	$self->{pop_pwd}  = $args{'pop_pwd'};
	$self->{pop_port} = $args{'pop_port'};

	if (!$self->{pop_server} or !$self->{pop_user} or !$self->{pop_pwd}) {
		return 0;
	}
	if (!$self->{pop_port}) {
		$self->{pop_port} = '110';
	}

	socket(webliberty_POP3, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
	my $server_ip   = gethostbyname($self->{pop_server});
	my $server_addr = pack('Sna4x8', AF_INET, $self->{pop_port}, $server_ip);

	my $socket_mesg;

	connect(webliberty_POP3, $server_addr) or return 0;
	recv(webliberty_POP3, $socket_mesg, 512, 0);

	$socket_mesg .= $self->_sendrecv("USER $self->{pop_user}\n");
	$socket_mesg .= $self->_sendrecv("PASS $self->{pop_pwd}\n");
	if ($socket_mesg =~ /\-ERR/) {
		return 0;
	}

	return 1;
}

### ログアウト
sub logout {
	my $self = shift;

	$self->_sendrecv("QUIT\n");
	close(webliberty_POP3);

	return;
}

### メール件数取得
sub get_number {
	my $self = shift;

	if ($self->_sendrecv("STAT\n") =~ /^\+OK\s+(\d+)\s+\d+/) {
		$self->{mail_number} = $1;
	} else {
		$self->{mail_number} = 0;
	}

	return $self->{mail_number};
}

### メール受信
sub get_mail {
	my $self = shift;
	my %args = @_;

	$self->{max_size} = $args{'max_size'};

	if (!$self->{max_size}) {
		$self->{max_size} = 64;
	}

	my @mails;
	foreach (1 .. $self->{mail_number}) {
		my $mail_size = 0;
		if ($self->_sendrecv("LIST $_\n") =~ /^\+OK\s+\d+\s+(\d+)/) {
			$mail_size = $1;
		} else {
			return;
		}

		if ($mail_size < $self->{max_size} * 1024) {
			my $read_mail = $self->_sendrecv("RETR $_\n");

			while (my $message = <webliberty_POP3>) {
				if ($message =~ /^\.\r?\n$/) {
					last;
				}

				$message =~ s/^\.\.\n/.\n/;

				$read_mail .= $message;
			}

			push(@mails, $read_mail);
		} else {
			next;
		}

		if ($self->_sendrecv("DELE $_\n") !~ /^\+OK/) {
			return;
		}
	}

	return @mails;
}

### メール解析
sub parse_mail {
	my $self      = shift;
	my $mail_data = shift;

	my($mail_header, $mail_body) = split(/\r\n\r\n/, $mail_data, 2);

	$mail_header =~ s/\r\n? //g;
	$mail_body   =~ s/\r\n[\t ]+/ /g;

	my $subject = $self->_get_subject($mail_header);
	my $address = $self->_get_address($mail_header);
	my $date    = $self->_get_date($mail_header);

	$mail_header =~ s/\r\n/ /g;
	$mail_header =~ s/\t/ /g;
	$mail_body   =~ s/(\r\n)*$//g;
	#$mail_body   =~ s/\*1\*=/=/g;
	#$mail_body   =~ s/\*0\*=/=/g;

	my($text, $file, $ext);

	if ($mail_header =~ /Content-type:.*multipart\//i or $mail_header =~ /Content\-Transfer\-Encoding:.*base64/i) {
		#添付ファイル有りのメール
		my $boundary = '';
		if ($mail_header =~ /boundary\=\"([^\"]+)\"/i) {
			$boundary = $1;
		}

		if (!$boundary) {
			#バウンダリ文字列無しのメール
			$ext = $self->_get_ext($mail_header);

			if ($ext) {
				$file = $self->_get_file($mail_header, $mail_body);
			} else {
				$file = '';
			}
		} else {
			#バウンダリ文字列有りのメール
			$ext = $self->_get_ext($mail_body);

			my @body_parts = split(/\r*\n*--$boundary-?-?/, $mail_body);

			if ($ext) {
				$file = $self->_get_file($mail_body, $body_parts[$#body_parts]);
			} else {
				$file = '';
			}

			#本文解析
			if ($body_parts[1] =~ /Content-Type: text\/plain/) {
				foreach (split(/\r\n/, $body_parts[1])) {
					$_ = Jcode->new($_)->utf8;

					$_ =~ s/[\t\r\n]//g;

					$_ =~ s/&/&amp;/g;
					$_ =~ s/</&lt;/g;
					$_ =~ s/>/&gt;/g;
					$_ =~ s/"/&quot;/g;

					if ($_ =~ /Content-type:/i or $_ =~ /charset=/i or $_ =~ /Content-Transfer-Encoding:/i) {
						next;
					}

					$text .= "$_\n";
				}

				$text =~ s/^\n+//;
				$text =~ s/\n+$//;
				$text =~ s/\n/<br \/>/g;
			}
		}
	} else {
		#添付ファイル無しのメール
		$text = Jcode->new($mail_body)->utf8;

		$text =~ s/\r?\n/\r/g;
		$text =~ s/^\r+//;
		$text =~ s/\r+$//;
		$text =~ s/\r/<br \/>/g;
	}

	return(
		subject => $subject,
		address => $address,
		date    => $date,
		text    => $text,
		file    => $file,
		ext     => $ext
	);
}

### サーバー通信
sub _sendrecv {
	my $self      = shift;
	my $send_data = shift;

	my $recv_data;

	if ($send_data) {
		send(webliberty_POP3, $send_data, 0);
	}
	recv(webliberty_POP3, $recv_data, 512, 0);

	return $recv_data;
}

### メール件名取得(参考：http://www.kemokemo.com/)
sub _get_subject {
	my $self    = shift;
	my $subject = shift;

	$subject = "\n" . $subject;
	if ($subject =~ /\nSubject:[ \t]*([^\r\n]+)/) {
		$subject = $1;

		while(my($tmp1, $tmp2, $tmp3) = $subject =~ /(.*)=\?[Ii][Ss][Oo]-2022-[Jj][Pp]\?B\?([^\?]+)\?=(.*)/) {
			$tmp3    =~ s/ //g;
			$subject = $tmp1 . $self->_base64_dencode($tmp2) . $tmp3;
		}

		$subject = Jcode->new($subject)->utf8;

		$subject =~ s/[\t\r\n]//g;

		$subject =~ s/&/&amp;/g;
		$subject =~ s/</&lt;/g;
		$subject =~ s/>/&gt;/g;
		$subject =~ s/"/&quot;/g;
	} else {
		$subject = '';
	}

	return $subject;
}

### 送信元メールアドレス取得
sub _get_address {
	my $self    = shift;
	my $address = shift;

	$address = "\n" . $address;
	if ($address =~ /\nFrom:[ \t]*([^\r\n]+)/) {
		$address = $1;
		if ($address =~ /([\w\-\.]+\@[\w\-\.]+)/) {
			$address = $1;
		} else {
			$address = '';
		}
	} else {
		$address = '';
	}

	return $address;
}

### メール送信日時取得
sub _get_date {
	my $self = shift;
	my $date = shift;

	my %month = ('Jan'=>'01', 'Feb'=>'02', 'Mar'=>'03', 'Apr'=>'04', 'May'=>'05', 'Jun'=>'06', 'Jul'=>'07', 'Aug'=>'08', 'Sep'=>'09', 'Oct'=>'10', 'Nov'=>'11', 'Dec'=>'12');

	$date = "\n" . $date;
	if ($date =~ /\nDate:[ \t]*([^\r\n]+)/) {
		$date = $1;
		if ($date =~ /(\d\d)\s(\w\w\w)\s(\d\d\d\d)\s(\d\d)\:(\d\d)\:(\d\d)/) {
			$date  = "$3$month{$2}$1$4$5$6";
		} else {
			$date = '';
		}
	} else {
		$date = '';
	}

	return $date;
}

### 添付ファイル拡張子取得
sub _get_ext {
	my $self = shift;
	my $info = shift;

	my $ext;

	if ($info =~ /name=\"?([^\"\n]+)\"?/i) {
		my $filename = $1;
		$filename =~ s/[\t\r\n]//g;

		while(my($tmp1, $tmp2, $tmp3) = $filename =~ /(.*)=\?[Ii][Ss][Oo]-2022-[Jj][Pp]\?B\?([^\?]+)\?=(.*)/) {
			$tmp3 =~ s/ //g;
			$filename = $tmp1 . $self->_base64_dencode($tmp2) . $tmp3;
		}

		$filename = Jcode->new($filename)->utf8;

		$filename =~ s/^\s+//;
		$filename =~ s/\s+$//;

		if ($filename =~ /[^\/\\]*\.([^.\/\\]*)$/) {
			$ext = lc($1);
		} else {
			$ext = '';
		}
	} else {
		$ext = '';
	}

	return $ext;
}

### 添付ファイル取得
sub _get_file {
	my $self   = shift;
	my $header = shift;
	my $body   = shift;

	my @files = split(/\r\n\r\n/, $body);
	if ($header =~ /Content\-Transfer\-Encoding:.*base64/i) {
		$files[$#files] = $self->_base64_dencode($files[$#files]);
	}

	return $files[$#files];
}

### BASE64デコード
sub _base64_dencode {
	my $self   = shift;
	my $string = shift;

	$string =~ tr/A-Za-z0-9+\///cd;
	$string =~ tr/A-Za-z0-9+\//\x00-\x3f/;
	$string = unpack('B*', $string);
	$string =~ s/(..)(......)/$2/g;
	$string =~ s/((........)*)(.*)/$1/;
	$string = pack('B*', $string);

	return $string;
}

1;