## Babble/DataSource/Mail.pm
## Copyright (C) 2004 Gergely Nagy <algernon@bonehunter.rulez.org>
##
## This file is part of Babble.
##
## Babble is free software; you can redistribute it and/or modify it
## under the terms of the GNU General Public License as published by
## the Free Software Foundation; version 2 dated June, 1991.
##
## Babble is distributed in the hope that it will be useful, but WITHOUT
## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
## FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
## for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

package Babble::DataSource::Mail;

use strict;
use Carp;
use Mail::Box::Manager;
use Date::Manip;

use Babble::Encode;
use Babble::DataSource;
use Babble::Document;
use Babble::Document::Collection;

use Exporter ();
use vars qw(@ISA);
@ISA = qw(Babble::DataSource);

=pod

=head1 NAME

Babble::DataSource::Mail - Fetch documents from mail archives

=head1 SYNOPSIS

 use Babble;
 use Babble::DataSource::Mail;

 my $babble = Babble->new ();
 $babble->add_sources (
	Babble::DataSource::Mail->new (
		-location => "babble.mbox",
		-permalink_base => 'http://example.org/~me/blog/'
	)
 );
 ...

=head1 DESCRIPTION

Babble::DataSource::Mail implements a Babble data source class that
fetches documents from mailboxes, maildirs, or anything Mail::Box
supports.

This can be used in a setup where one filters blog entries into a
separate mailbox, and uses this module to generate the blog itself.

=cut

my $permalink_msgid = sub {
	my ($base, $msgid, $subject, $date) = @_;
	my $anchor = $msgid;

	$anchor =~ s/[^-0-9a-z_.]/_/gi;

	return $$base . UnixDate (ParseDate ($date),
				  "%Y/%m/%d/#") . $anchor;
};

=head1 METHODS

=over 4

=item I<new>(B<%params>)

This method creates a new object. The recognised arguments are
I<-location>, which specifies the directory where documents should be
collected from; I<-permalink_base>, the base URL for the collection
(used by the permanent link generator, see later); and
I<-permalink_gen>, a code reference that is used to generate links to
documents.

The method specified in I<-permalink_gen> takes four arguments:
I<base>, I<msgid>, I<subject> and I<date>. All of them are strings,
except the first, which is a string reference.

Base is what we specified using I<-permalink_base>, msgid is the
message id, and subject is the subject of the mail.

=cut

sub new {
	my $type = shift;
	my $class = ref ($type) || $type;
	my $self = $class->SUPER::new (@_);

	$self->{-permalink_gen} = \&$permalink_msgid
		unless $self->{-permalink_gen};

	bless $self, $type;
}

=pod

=item I<collect>()

This function processes each message in a mail folder, and makes a
Babble::Document out of them. The title of the document is the subject
of the mail, author is the sender, the content is the body, the
subject (category) of the document can be set using the I<X-Category>
header.

The documents id property contains a pointer to the entry (eg, to one's
weblog). This is generated by the I<$source-E<gt>{permalink_gen}>
function, explained above.

For the Babble::Document::Collection object to return, some
information will be gathered from the Babble object which calls this
method, or from the parameters passed to us. Namely, the
I<meta_title>, I<meta_desc>, I<meta_link>, I<meta_owner>,
I<meta_owner_email>, I<meta_subject>, I<meta_image> and
I<meta_feed_link> keys will be used, if present.

=cut

sub collect () {
	my ($self, $babble) = @_;
	my ($collection, %args);
	my $mgr = Mail::Box::Manager->new ();
	my $folder = $mgr->open (folder => $self->{-location});

	foreach ("meta_title", "meta_desc", "meta_link", "meta_owner_email",
		 "meta_subject", "meta_feed_link", "meta_owner",
		 "meta_image") {
		$args{$_} = $self->{$_} || $$babble->{Params}->{$_} || "";
		$args{$_} = to_utf8 ($args{$_});
	}

	$collection = Babble::Document::Collection->new (
		title => $args{meta_title},
		link => $args{meta_feed_link},
		id => $args{meta_link},
		author => $args{meta_owner} || $args{meta_owner_email},
		content => $args{meta_desc},
		date => ParseDate ("today"),
		subject => $args{meta_subject},
		name => to_utf8 ($self->{-id}) || $args{meta_owner} ||
			$args{meta_owner_email} || $args{meta_title},
		image => $args{meta_image},
	);

	foreach my $msg (@$folder) {
		my $link = $self->{-permalink_gen} (
			\$self->{-permalink_base}, $msg->messageId,
			$msg->timestamp, ParseDate ('epoch ' . $msg->timestamp)
		);

		my $doc = Babble::Document->new (
			title => to_utf8 ($msg->subject) || $msg->date,
			id => $link,
			content => to_utf8 ($msg->decoded()->string),
			author => to_utf8 (($msg->from())[0]->name),
			date => ParseDate ('epoch ' . $msg->timestamp),
			subject => to_utf8 ($msg->get ('X-Category')),
		);

		push (@{$collection->{documents}}, $doc);
	}

	return $collection;
}

=pod

=back

=head1 AUTHOR

Gergely Nagy, algernon@bonehunter.rulez.org

Bugs should be reported at L<http://bugs.bonehunter.rulez.org/babble>.

=head1 SEE ALSO

Babble::Document, Babble::Document::Collection,
Babble::DataSource, Mail::Box

=cut

1;

# arch-tag: 86705493-1fbe-4c87-8964-ebebb6053818