Mail::Summary::Tools::ArchiveLink::GoogleGroups - Link to Google Groups via message ID.

	use Mail::Summary::Tools::ArchiveLink::GoogleGroups;

	my $link = Mail::Summary::Tools::ArchiveLink::GoogleGroups->new(
		message_id => ".....",
	);

	$link->thread_uri;
	$link->message_uri;

#!/usr/bin/perl

package Mail::Summary::Tools::ArchiveLink::GoogleGroups;
use Moose;

with "Mail::Summary::Tools::ArchiveLink::Base";

use WWW::Mechanize;
use URI;
use URI::QueryParam;

sub message_uri {
	my $self = shift;

	my $uri = URI->new("http://groups.google.com/groups");
	$uri->query_param( selm => $self->message_id );

	$uri;
}

sub thread_uri { } # FIXME Moose role composition
has thread_uri => (
	isa => "URI",
	is  => "ro",
	lazy => 1,
	default => sub { $_[0]->_thread_uri }
);

has use_frames => (
	isa => "Bool",
	is  => "rw",
	default => 1,
);

has cache => (
	isa => "Object",
	is  => "rw",
	required => 0,
);

sub cache_key {
	my $self = shift;

	join(":",
		qw/archive_links google_groups/,
		$self->message_id,
	);
}

sub _munge_thread_uri {
	my ( $self, $uri ) = @_;
	$uri =~ s/browse_thread/browse_frm/ if $self->use_frames;
	return $uri;
}

sub _thread_uri {
	my $self = shift;

	my $uri = $self->_find_thread_uri || return;
	
	URI->new( $self->_munge_thread_uri($uri) );
}

sub _find_thread_uri {
	my ( $self, $message_id ) = @_;

	my $cache = $self->cache;

	my $cache_key = $self->cache_key;

	if ( my $uri = $cache && $cache->get($cache_key) ) {
		return $uri;
	} else {
		my $m = WWW::Mechanize->new;

		my $uri = $self->message_uri;

		$m->get( $uri, 'user-agent' => "Mozilla" );

		if ( my $link = $m->find_link( url_regex => qr#browse_(?:thread|frm)/thread/# ) ) {
			my $uri = $link->url_abs->as_string;
			$cache && $cache->set( $cache_key, $uri );
			return $uri
		}
	}

	warn "no thread_uri for " . $self->message_id . ", falling back to gmane";

	require Mail::Summary::Tools::ArchiveLink::Easy;
	return Mail::Summary::Tools::ArchiveLink::Easy->gmane( $self->message_id )->thread_uri;
}

__PACKAGE__;

__END__