# $Revision: 1.3 $
# $Date: 2003/03/03 14:48:12 $
package Net::IMAP::Server::RSSBridge;

use strict;
use warnings;

use POSIX;

use Carp;
use Mail::Message;

use XML::RSS;
use Time::Local;
use LWP::UserAgent;
use Data::Dumper;

my @mailboxes		= qw(INBOX);
my $NUMBER_OF_MESSAGES	= 2;
#my $URL		= q(http://localhost/~greg/blog/index.rdf);
#my $URL = q(http://www.linux.hr/backend.php);
my $URL = q{http://www.kuro5hin.org/backend.rdf};
my $CACHE_MINUTES	= 120;
my $feeds;	# hash in 'inbox_name' => 'feed url' form

my $debug = 1;

sub new {
	my $proto	= shift;
	my $class	= ref($proto) || $proto;
	my $args	= {@_};
	my $server	= $args->{'server'} || die "need server arg";
	my $feeds	= $args->{'feeds'} || die "need feeds";

	my $ua		= new LWP::UserAgent (
		agent => 'Net-IMAP-Server-RSSBridge/0.01',
		env_proxy => 1,
		timeout => 30,
		);
	my $self	= bless(
		{
			server		=> $server,
			ua		=> $ua,
			_feed_cache	=> {}
		}, $class );

#	my $content	= $self->get_url( $URL );
#	warn "got feed [" . length($content) . " bytes]\n";
	return $self;
}

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

sub auth {
	my $self	= shift;
	my $user	= shift || '';
	my $pass	= shift || '';
	return ($self->server->data->{ 'users' }{ $user }{ 'password' } eq $pass);
}

sub count {
	my $self	= shift;
	my $mailbox	= shift;
	my $rss		= $self->rss( $mailbox ) || return 0;
	return scalar(@{ $rss->{ 'items' } });
}

sub fetch {
	my $self	= shift;
	my $mailbox	= shift;
	my $from	= shift;
	my $to		= shift;
	my $fields	= shift;
	my $by_uid	= shift;
	
	print STDERR "store->fetch from: $from to: $to fields: ",Dumper($fields)," by_uid: $by_uid\n" if ($debug);

	my $i			= 1;
	my $rss			= $self->rss( $mailbox ) || return [];
	my @messages	= reverse $self->messages_from_rss( $rss );
	my %seqs		= map { reverse($i++, $_) } @messages;
	my %by_uid		= map { $self->message_time( $_ ) => $_ } @messages;
	my @uids		= reverse sort keys %by_uid;
	
	if ($to eq '*') {
		$to				= ($by_uid) ? $uids[ 0 ] : scalar(@messages);
	}
	my @results;
	my @loop	= ($by_uid) ? grep { $_ >= $from and $_ <= $to } @uids : ($from .. $to);
	for my $number (@loop) {
		# warn "trying to get message " . $number . "/" . scalar(@messages) . "\n";
		my $m	= ($by_uid) ? $by_uid{ $number } : $messages[ $number - 1 ];
		next unless (ref($m));
		my $h	= $m->head;
		my $uid	= $self->message_time( $m );
		
		my $data = { _number => $seqs{ $m }, _uid => $uid };
		my %known	= map { lc($_) => 1 } $h->knownNames;
		
		my $seen_uid	= 0;
		foreach (@{ $fields }) {
			if (/ENVELOPE/) { 
				$data->{ ENVELOPE }	= '""';
			} elsif (/UID/) {
				$data->{ UID }	= $uid;
			} elsif (/FLAGS/) {
				$data->{ FLAGS }	= '(\Seen)';
			} elsif (/INTERNALDATE/) {
				$data->{ INTERNALDATE }	= '"' . $m->head->get('Date') . '"';
			} elsif (/BODY/) {
				$data->{ _body }	= "-->". $m->string . "<--";
			} elsif (/RFC822\.(.*)/) {
				if ($1 eq 'SIZE') {
					$data->{ 'RFC822.SIZE' }	= $m->size;
				}
			} elsif (ref($_) and ($_->[0] eq 'BODY')) {
				my $field	= $_;
				my $headerfields	= ${ $field }[ $#{ $field } ] || [];
				
				if (grep {$_ eq 'HEADER'} @{ $field }) {
					push(@{$headerfields},keys %known) unless (@{$headerfields});
					$data->{ _body }	= join(
									'',
									map {
										ucfirst(lc($_)) . ': ' . $h->get( $_ ) . "\n"
									} grep { $known{ lc($_) } } @{ $headerfields }
								);
				} else {
					$data->{ _body }	= $m->string;
				}
			}
		}
		push(@results, $data);
	}
	
	return \@results;
}

sub list {
	my $self	= shift;
	my @args	= shift;
	return (@mailboxes, @{ $self->server->user->{ 'subscriptions' } });
}

sub status {
	my $self	= shift;
	my $mailbox	= shift;
	my $count	= $self->count( $mailbox );
	return {
		MESSAGES	=> $count,
		RECENT		=> 0,
		UIDNEXT		=> $count+1,
		UIDVALIDITY	=> 4,
		UNSEEN		=> 0
	};
}

sub subscribe {
	my $self	= shift;
	my $url		= shift;
	my %already	= map { $_ => 1 } @{ $self->server->user->{ 'subscriptions' } };
	
	print STDERR "subscribe $url\n" if ($debug);
	if (my $rss = $self->rss( $url )) {
		push( @{ $self->server->user->{ 'subscriptions' } }, $url ) unless ($already{ $url });
		return 1;
	} else {
		return 0;
	}
}

sub unsubscribe {
	my $self	= shift;
	my $url		= shift;
	my $subs	= $self->server->user->{ 'subscriptions' };
	@{ $subs }	= grep { $_ ne $url } @{ $subs };
	return 1;
}

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

sub get_url {
	my $self	= shift;
	my $url		= shift;
	
# CACHING is taken care of in rss() - look there instead
#	if (my $cache = $self->_feed_cache->{ $url }[1]) {
#		return $cache;
#	} else {
		print STDERR "get_url: $url\n" if ($debug);
		my $response	= $self->ua->get( $url );
		if ($response->is_success) {
			$self->{ _feed_cache }{ $url }	= [ time, $response->content ];
			my $xml = $response->content;
			print STDERR "Content from ",$response->request->uri, " has ",length($xml)," bytes\n";

			# fix broken feeds which have unparsable chars in
			# title (e.g. from phpNuke)
			$xml =~ s/\s+&\s+/ &amp; /gs;
			print STDERR "RSS: $xml\n" if ($debug);
			return $xml;
		} else {
			print STDERR "Error while getting ", $response->request->uri, " -- ", $response->status_line, "\n";
			return undef;
		}
#	}
}

sub rss {
	my $self	= shift;
	my $url		= shift;
	if ($feeds->{$url}) {
		$url = $feeds->{$url};
	} else {
		# fall back to default feed
		$url = $URL;
	}
	
	no warnings 'uninitialized';
	if (ref(my $rss = $self->_feed_cache->{ $url }[2]) and (time - $self->_feed_cache->{ $url }[0] < ($CACHE_MINUTES * 60))) {
		# IF we have the RSS file cached,
		# AND we've updated within the last 10 minutes
		# THEN use the cached RSS object 
		return $rss;
	} else {
		my $rss		= new XML::RSS;
		my $content	= $self->get_url( $url );
		if (defined($content)) {
			$rss->parse( $content ) or return undef;
			$self->_feed_cache->{ $url }[2]	= $rss;
			return $rss;
		} else {
			warn "No RSS feed at $url\n";
			return undef;
		}
	}
}

sub messages_from_rss {
	my $self	= shift;
	my $rss		= shift;
	
	my @messages;
	my $title	= $rss->{ 'channel' }{ 'title' };
	foreach my $item (@{ $rss->{ 'items' } }) {
		my $m		= build Mail::Message (
					# 'RSS-IMAP Bridge <greg@evilfunhouse.com>',
					To 		=> join(' ', $title, '<rss+bridge@evilfunhouse.com>'),
					From	=> join(' ', $title, '<rss+bridge@evilfunhouse.com>'),
					Subject	=> $item->{ 'title' },
					data	=> $item->{ 'description' }
				);
		if (my $date = $item->{'dc'}{'date'}) {
			# 2003-02-24T02:39:11-05:00
			my ($year,$mon,$day,$hour,$min,$sec,$o_dir,$o_hour,$o_min)
				= $date =~ m{^(\d{4})-(\d{1,2})-(\d{1,2}).(\d{1,2}):(\d{2}):(\d{1,2})(.)(\d{1,2}):(\d{1,2})$};
			my $time	= timegm( $sec, $min, $hour, $day, $mon-1, $year-1900 );
			$time		+= (($o_hour * 60 * 60) + ($o_min * 60)) * (($o_dir eq '-') ? 1 : -1);
			my $dstr	= strftime( "%a, %d %b %Y %H:%M:%S", (localtime($time))[0..6] )
						. " -${o_hour}${o_min}";
			$m->head->delete( 'Date' );
			$m->head->add( Date => $dstr );
		}
		push(@messages, $m);
	}
	return @messages;
}

{
	my %months	= (
		Jan	=> 0,
		Feb	=> 1,
		Mar	=> 2,
		Apr	=> 3,
		May	=> 4,
		Jun	=> 5,
		Jul	=> 6,
		Aug	=> 7,
		Sep	=> 8,
		Oct	=> 9,
		Nov	=> 10,
		Dec	=> 11
	);
	sub message_time {
		my $self	= shift;
		my $m		= shift;
		my $date	= $m->head->get( 'Date' );
		my ($day,$mon,$year,$hour,$min,$sec)	= $date =~ /^..., (..) (...) (....) (..):(..):(..)/;
		my $time	= timegm( $sec, $min, $hour, $day, $months{$mon}, $year-1900);
		return $time;
	}
}

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

sub AUTOLOAD {
	our $AUTOLOAD;
	my $self	= shift;
	my $name	= substr($AUTOLOAD,rindex($AUTOLOAD,':')+1);
	return if ($name eq 'DESTROY');
	if (scalar(@_)) {
		$self->{ $name }	= shift;
	} else {
		return $self->{ $name };
	}
}

1;

__END__

 $Log: RSSBridge.pm,v $
 Revision 1.3  2003/03/03 14:48:12  greg
 - indented Log tags for (future) perldoc handling

 Revision 1.2  2003/03/03 14:10:14  greg
 - added PREREQ_PM to makefile
 - command tag is now an instance variable
 - command tag is no longer passed to cmd_* and send_* functions
 - rid code of unused Switch references
 - added CVS Revision, Date, and Log tags