File Coverage

blib/lib/WWW/Yahoo/Groups.pm

Criterion	Covered	Total	%
statement	87	189	46.0
branch	20	66	30.3
condition	2	27	7.4
subroutine	25	29	86.2
pod	16	17	94.1
total	150	328	45.7

package WWW::Yahoo::Groups;
use strict;
use warnings FATAL => 'all';

=head1 NAME

WWW::Yahoo::Groups - Automated access to Yahoo! Groups archives.

=head1 SYNOPSIS

    my $y = WWW::Yahoo::Groups->new();
    $y->login( $user => $pass );
    $y->list( 'Jade_Pagoda' );
    my $email = $y->fetch_message( 2345 );

    # Error catching
    my $email = eval { $y->fetch_message( 93848 ) };
    if ( $@ and ref $@ and $@->isa('X::WWW::Yahoo::Groups') )
    {
        warn "Problem: ".$@->error;
    }

=head1 DESCRIPTION

C retrieves messages from the archive of Yahoo
Groups. It provides a simple OO interface to logging in and retrieving
said messages which you may then do with as you will.

=head2 Things it does

=over 4

=item *

B It lets you login.

=item *

B It notes that it got one and
progresses straight to the message.

=item *

B It just goes straight on.

=item *

B We get the source which happens to be the raw stuff.

=item *

B Could be improved, but it will generally barf if it
doesn't understand something.

=item *

B I've found that some groups' archives have
unusually corrupted headers. Evidently it would be beneficial to
restore these headers. As far as I can tell, it comes from not
being a moderator on the lists in question.

=back

=head1 USAGE

Try to be a well behaved bot and C for a few seconds (at least)
after doing things. It's considered polite. There's an
L method that should be useful for this.
Recently, this has been set to a default of 1 second. Feel free to tweak
if necessary.

If you're used to seeing munged email addresses when you view
the message archive (i.e. you're not a moderator or owner of
the group) then you'll be pleased to know that
C can demunge those email addresses.

All exceptions are subclasses of C, itself a
subclass of C. See L for
details.

=head1 OTHER DOCUMENTATION

=head2 I, by Kevin Hemenway and Tara Calishain

I from O'Reilly
(L) is a great book for anyone
wanting to know more about screen-scraping and spidering.

There is a WWW::Yahoo::Groups based hack by Andy Lester:

=over 4

=item 44 Archiving Yahoo! Groups Messages with WWW::Yahoo::Groups

=item

=back

and two hacks, not related to this module, by me, Iain Truskett:

=over 4

=item 19 Scraping with HTML::TreeBuilder

=item 57 Related Amazon.com Products with Alexa

=back

=cut

our $VERSION = '1.91';

use Carp;
use HTTP::Cookies;
use HTML::Entities;
use Params::Validate qw( :all );
use WWW::Yahoo::Groups::Mechanize;

require WWW::Yahoo::Groups::Errors;
Params::Validate::validation_options(
    WWW::Yahoo::Groups::Errors->import()
);

=head1 METHODS

=head2 Constructor

=head3 new

Create a new C robot.

    my $y = WWW::Yahoo::Groups->new();

It can take a has of named arguments. Two arguments are defined:
C and C. They correspond to the methods of the same
name.

    my $y = WWW::Yahoo::Groups->new(
        debug => 1,
        autosleep => 4,
    );

=cut

sub new
{
    my $class = shift;
    my %args = ( debug => 0, autosleep => 1, @_ );
    my $self = bless {}, $class;
    my $w = WWW::Yahoo::Groups::Mechanize->new();
    $self->agent($w);
    $self->debug( $args{debug} );
    $self->autosleep( $args{ autosleep } );
    return bless $self, $class;
}

=head2 Options

=head3 debug

Enable/disable/read debugging mode.

    $y->debug(0); # Disable
    $y->debug(1); # Enable
    warn "Debugging!" if $y->debug();

The C method of the current L object will
be invoked with the truth of the argument. This usually means
L.

=cut

sub debug
{
    my $self = shift;
    if (@_) {
	my $true = ($_[0] ? 1 : 0);
	$self->{__PACKAGE__.'-debug'} = $true;
	$self->agent->debug( $true );
    }
    $self->{__PACKAGE__.'-debug'};
}

=head3 autosleep

If given a parameter, it sets the numbers of seconds to sleep.
Otherwise, it returns the number. Defaults to 1 second.

    $y->autosleep( 5 ); # Set it to 5.
    sleep ( $y->autosleep() );

May throw C if given invalid parameters.

This is used by L. If C is set, then C will
C for the specified period after every fetch.

Implemented by the object returned by L. By default this
means L.

=cut

sub autosleep { my $self = shift; $self->agent->autosleep(@_) }

=head2 Logging in and out

=head3 login

Logs the robot into the Yahoo! Groups system.

    $y->login( $user => $passwd );

May throw:

=over 4

=item *

C if it cannot fetch any of the
appropriate pages.

=item *

C if given invalid parameters.

=item *

C if unable to log in for some reason
(error will be given the text of the Yahoo error).

=item *

C if the object is already
logged in. I intend to make this exception redundant, perhaps by
just making C a null-op is we're already logged in, or by calling
L and then relogging in.

=back

=cut

sub login
{
    my $self = shift;
    my %p;
    @p{qw( user pass )} = validate_pos( @_,
	{ type => SCALAR, }, # user
	{ type => SCALAR, }, # pass
    );
    my $w = $self->agent();
    my $rv = eval {
	X::WWW::Yahoo::Groups::AlreadyLoggedIn->throw(
	    "You must logout before you can log in again.")
		if $self->loggedin;

	$w->get('http://groups.yahoo.com/');
	$w->follow('Sign In');
	$w->field( login => $p{user} );
	$w->field( passwd => $p{pass} );
	$w->click();
	if (my ($error) = $w->res->content =~ m!
	    \Q\E
	    \s+
	    (.*?)
	    \s+
	    \Q