#!/usr/bin/perl

# m-pop -- retrieve (new) messages via POP3

use strict;
use warnings;

use Getopt::Std;
use Net::POP3;
use POSIX;
use Sys::Hostname;

our $VERSION = '0.01';

# Process arguments
my %opt;
$Getopt::Std::STANDARD_HELP_VERSION = 1;
getopts('m:i:j:', \%opt);
HELP_MESSAGE() unless $opt{m} and $opt{i};
sub HELP_MESSAGE {
	print STDERR <<USAGE;
usage: $0 -m mbox -i mbox.i [-j mbox.i.out]
USAGE
	exit 1;
}

# Open TTY for reading and writing
open my $tty, '+<:unix', '/dev/tty' or die "Could not open /dev/tty: $!";

# Get UIDs of existing messages
my ($mbox, $index, @existing_uids);
if (-e $opt{i}) {
	open $index, '<', $opt{i} or die "Could not open $opt{i}: $!";
	local $/ = ''; # paragraph mode
	while (<$index>) {
		push @existing_uids, $1 if /^M-UID: (.*)$/m;
	}
	close $index;
}

# Open mbox and index files for appending
open $mbox, '>>', $opt{m} or die "Could not open $opt{m}: $!";
$opt{j} = $opt{i} if not $opt{j};
open $index, '>>', $opt{j} or die "Could not open $opt{j}: $!";

# Get POP3 server, username and password
my $server = 'pop3.mailbox.org';
my $ssl = 1;
my $timeout = 5;

die "USERNAME variable not set\n" if not $ENV{USERNAME};
die "PASSWORD variable not set\n" if not $ENV{PASSWORD};

# Connect to POP3 server
my $pop = Net::POP3->new($server, SSL => $ssl, Timeout => $timeout)
	or die "Could not connect to POP3 server $server: $!\n";
$pop->login($ENV{USERNAME}, $ENV{PASSWORD}) or die "Could not log into server\n";

# Retrieve ids and uids of all messages
my @ids = sort { $a <=> $b } keys %{$pop->list};
my %uids = %{$pop->uidl};

# Handle SIGINT
my $sigint = 0;
$SIG{INT} = sub {
	print $tty "\nSafely ending retrieval...\n";
	$sigint = 1;
};

# Append new messages to mbox and index files
chomp(my $date = asctime(localtime(time)));
my $offset = 0;
my $i = 0;

for my $id (@ids) {
	next if grep { $_ eq $uids{$id} } @existing_uids;
	print $tty "\r$id/$ids[-1]";

	my @msg;
	{
		local $/ = "\r\n";
		chomp(@msg = @{$pop->get($id)});
	}

	# Make From_ line
	my ($from, $from_alt);
	my $j = 0; # index of empty line before message body
	for (@msg) {
		last if /^$/;
		$j++;
		$from = $1 if /^From: (.*)$/;
		$from_alt = $1 if /^from: (.*)$/;
	}
	$from = $from_alt if $from_alt and not $from;
	$from = $1 if $from and $from =~ /^.* <(.*?@.*?)>$/;
	$from = 'MAILER-DAEMON@' . hostname if not $from;
	my $from_ = "From $from $date";

	# Calculate message length
	my ($head_length, $body_length, $message_length);
	$head_length += length($_)+1 for (@msg[0..$j-1]);
	$body_length += length($_)+1 for (@msg[$j..$#msg]);
	$message_length = length($from_) + 1 + $head_length + $body_length;

	# Append message to mbox and index files
	local $" = "\n";
	print $mbox <<MBOX;
$from_
@msg[0..$j-1]
@msg[$j..$#msg]

MBOX
	print $index <<INDEX;
$from_
M-Offset: $offset
M-Length: $message_length
M-Status: 00
M-UID: $uids{$id}
@msg[0..$j-1]

INDEX

	exit 130 if $sigint;

	# Set offset for next message
	$offset += $message_length + 1;
}
print $tty "\n";

close $index;
close $mbox;
$pop->quit;