view release on metacpan or  search on metacpan

bin/eboks2pop  view on Meta::CPAN

}

sub debug($)
{
	return unless $opt{debug};
	my $t = scalar localtime;
	warn "$t: $_[0]\n";
}

my $serv = lambda {
	context $server;
	accept {
		# incoming connection
		my $conn = shift;
		again;

		unless ( ref($conn)) {
			debug("accept() error:$conn") if !ref($conn);
			return;
		}
		$conn-> blocking(0);

       		my $hostname = inet_ntoa((sockaddr_in(getsockname($conn)))[1]);
		
		debug("[$hostname] connect");
		
		my $buf     = '';
		my $session = { hostname => $hostname };
		my $resp    = ok("POP3 server ready\x{a}");
		context writebuf, $conn, \$resp, length($resp), 0, $conn_timeout;
	tail {
		context readbuf, $conn, \$buf, qr/^([^\r\n]*)[\r\n]+/s, $conn_timeout;
	tail {
		my @frame = get_frame;
		my ( $match, $error) = @_;
		unless ( defined($match)) {
			debug("[$hostname] session error: $error");
			undef @frame; # circular refs!
			return close($conn);
		}
		substr( $buf, 0, length($match)) = '';
		my $resp = handle( $match, $session);
		context ref($resp) ? $resp : lambda {};
	tail {
		$resp = shift if ref $resp;
		$resp .= "\x{a}";
		context writebuf, $conn, \$resp, length($resp), 0, $conn_timeout;
	tail {
		if ($session->{quit}) {
			debug("[$hostname] QUIT");
			undef @frame; # circular refs!
			close($conn);
		} else {
			set_frame(@frame);
			again;
		}
	}}}}}
};

sub fail($) { "-ERR $_[0]" }
sub ok($) { "+OK $_[0]" }
sub multi
{
	my @msgs;
	my $comment = shift;
	for ( @_ ) {
		my $p = $_;
		$p .= ' ' if $p eq '.';
		push @msgs, $p;
	}
	return ok(join("\x{a}", $comment, @msgs, '.'));
}

sub remotefail($)
{
	debug($_[0]);
	fail("e-boks.dk says: $_[0]");
}

sub list_share
{
	my ($session, $share) = (shift, shift);
	return lambda {
		context $session->{obj}->fetch_request( $session->{obj}->folders($share) );
	tail {
		my ( $folders, $error ) = @_;
		$session->{error} = $error;
		return 0 unless $folders;

		$session->{folder} = $folders->{Inbox};
		context $session->{obj}->list_all_messages($share, $session->{folder}->{id});
	tail {
		my ( $list, $error ) = @_;
		unless ($list) {
			$session->{error} = $error;
			return 0;
		}

		$session->{msgs} += scalar keys %$list;
		push @{$session->{keys}}, map { $list->{$_} } sort keys %$list;
		return 1;
	}}};
}

sub want_list
{
	my $session = shift;
	return lambda {
		return 1 if $session->{list};

		$session->{keys} = [];
		$session->{msgs} = 0;
		if ( $session->{all_shares}) {
			context $session->{obj}->fetch_request( $session->{obj}->shares );
		} else {
			context lambda {};
		}
	tail {
		my ( $shares, $error ) = @_;
		my @shares = ($session->{share});
		if ( $session->{all_shares}) {