############################################################
#
#   $Id: Comic.pm,v 1.5 2006/01/10 15:45:44 nicolaw Exp $
#   WWW::Comic - Retrieve Comic of the day comic strip images
#
#   Copyright 2006 Nicola Worthington
#
#   Licensed under the Apache License, Version 2.0 (the "License");
#   you may not use this file except in compliance with the License.
#   You may obtain a copy of the License at
#
#       http://www.apache.org/licenses/LICENSE-2.0
#
#   Unless required by applicable law or agreed to in writing, software
#   distributed under the License is distributed on an "AS IS" BASIS,
#   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   See the License for the specific language governing permissions and
#   limitations under the License.
#
############################################################

package WWW::Comic;
# vim:ts=4:sw=4:tw=78

use strict;
use Carp qw(carp croak);
use WWW::Comic::Plugin qw();
use Module::Pluggable(
			search_path => [ __PACKAGE__.'::Plugin' ],
			instantiate => 'new',
			sub_name => '_plugins',
		);

use constant DEBUG => $ENV{DEBUG} ? 1 : 0;
use vars qw($VERSION $AUTOLOAD);
$VERSION = '1.06' || sprintf('%d.%02d', q$Revision$ =~ /(\d+)/g);


#################################
# Public methods

sub new {
	ref(my $class = shift) && croak 'Class name required';
	my $self = { plugins => [ __PACKAGE__->_plugins() ] };
	bless $self, $class;
	DUMP('$self',$self);
	return $self;
}

sub comics {
	my $self = shift;
	my $comics = $self->_comics_to_plugins(@_);
	return sort(keys(%{$comics}));
}

sub strip_url {
	my $self = shift;
	my %param = $self->_parse_params(@_);
	my $plugin = $self->_plugin_to_handle_comic($param{comic});
	return $plugin->strip_url(%param);
}

sub get_strip {
	my $self = shift;
	my %param = $self->_parse_params(@_);
	my $plugin = $self->_plugin_to_handle_comic($param{comic});
	return $plugin->get_strip(%param);
}

sub mirror_strip {
	my $self = shift;
	my %param = $self->_parse_params(@_);
	my $plugin = $self->_plugin_to_handle_comic($param{comic});
	return $plugin->mirror_strip(%param);
}

sub plugins {
	my $self = shift;
	my @plugins = ();
	push @plugins, map { ref($_) } @{$self->{plugins}};
	return @plugins;
}

sub AUTOLOAD {
	my $self = shift;
	my %param = $self->_parse_params(@_);
	my $plugin = $self->_plugin_to_handle_comic($param{comic});

	(my $name = $AUTOLOAD) =~ s/.*://;
	if (UNIVERSAL::can($plugin,$name)) {
		return $plugin->$name(%param);
	}

	croak "Plugin ".ref($plugin)." does not support method ${name}()";
}

sub DESTROY {}




#################################
# Private methods

sub _plugin_to_handle_comic {
	my ($self,$comic) = @_;

	my $plugin = undef;
	my $comic_plugins = $self->_comics_to_plugins(@_);
	while (my ($k,$v) = each %{$comic_plugins}) {
		if (lc($k) eq lc($comic)) {
			$plugin = $v;
			last;
		}
	}

	croak "No plugin found for comic '$comic'"
		unless (defined($plugin) && ref($plugin) &&
				UNIVERSAL::isa($plugin, __PACKAGE__.'::Plugin'));

	return $plugin;
}

sub _comics_to_plugins {
	my $self = shift;

	my %comics;
	for my $plugin (@{$self->{plugins}}) {
		for my $comic ($plugin->comics(@_)) {
			$comics{$comic} = $plugin if defined $comic;
		}
	}

	return \%comics;
}

sub _parse_params {
	my $self = shift;
	if (@_ % 2) {
		croak "Odd number of paramaters passed when even expected";
	} else {
		my %params = @_;
		croak "Missing mandatory 'comic' paramater"
			unless (exists($params{comic}) && $params{comic} =~ /\S+/);
	}
	return @_;
}

sub TRACE {
	return unless DEBUG;
	carp(shift());
}

sub DUMP {
	return unless DEBUG;
	eval {
		require Data::Dumper;
		carp(shift().': '.Data::Dumper::Dumper(shift()));
	}
}


1;


=pod

=head1 NAME

WWW::Comic - Retrieve comic strip images

=head1 SYNOPSIS

 use strict;
 use WWW::Comic qw();
 
 # Create a WWW::Comic object
 my $wc = new WWW::Comic;
 
 # Get a list of supported comics
 my @comics = $wc->comics;
 
 # Allow HTTP requests to retrieve a full list of supported
 # comics if necessary (some plugins may not know what comics
 # they support until they make an HTTP request)
 my @comics = $wc->comics(probe => 1);
 
 for my $comic (@comics) {
     # Get the most recent comic strip URL for $comic
     my $url = $comic->strip_url(comic => $comic);
      
     # Download the most recent comic strip
     # for $comic in to $blob
     my $blob = $comic->get_strip(comic => $comic);
      
     # Write the most recent comic strip for
     # $comic to disk
     my $filename = $comic->mirror_strip(comic => $comic);
 }
 
=head1 DESCRIPTION

This module will download cartoon comic strip images from various
websites and return a binary blob of the image, or write it to
disk. Multiple comic strips can be supported through subclassed
plugin modules.

A number of plugin modules are bundled as part of this distrubution.
You may want to refer to their documentation for any additional
custom methods and features. Specifically, L<WWW::Comic::Plugin::UFS>
and L<WWW::Comic::Plugin::uComics> require use of the C<probe>
paramater with the C<comics> method on order to retrieve a list
of supported commics.

To find out what plugin modules you currently have installed and
available, run the following:

 perl -MWWW::Comic -MData::Dumper -e"print Dumper([WWW::Comic->new->plugins]);"

=head1 METHODS

=head2 new

 my $wc = new WWW::Comic;

Creates a new WWW::Comic object.

=head2 comics

 my @comics = $wc->comics(probe => 1);
 
Returns a list of available comics. The C<probe> paramater is
optional. (See below).

=over 4

=item probe

This paramater is an optional boolean value supported by a few
plugins that do not automatically know what comics they support.
Specifying a boolean true value for this paramater will tell those
plugins that they should make HTTP requests to find out what comics
they can make available. Plugins should cache this information in
memory once they have performed an initial probe.

=back

=head2 strip_url

 # Get the URL of the most recent "mycomic" comic image
 my $url = $wc->strip_url(comic => "mycomic");
 
 # Get the URl of a specific "mycomic" comic image
 my $specificStripUrl = $wc->strip_url(
                             comic => "mycomic",
                             id => 990317
                         );

Returns the URL of a comic strip. The C<comic> paramater is
mandatory and must be a valid supported comic as listed by the
C<comics()> method. The most recent comic strip image URL will
be returned unless otherwise specified (see the C<id> paramater
below).

This method will return an C<undef> value upon failure.

The C<id> paramater is optional and can be used to specify a specific
comic (if supported by the plugin in question). Comic IDs are typically
date based in some way, but this is unique to each comic and follows
no special format for the purposes of this module. See each plugin
module's documentation for further information.

=over 4

=item comic

This paramater is mandatory. It specifies the comic that this method
should process. See the C<comics()> method.

=item id

This paramater is optional. It specifies a specfic comic that should
be processed.

=back

=head2 get_strip

 # Retrieve the most recent "mycomic" comic strip image
 my $imageBlob = $wc->get_strip(comic => "mycomic");
 
 # Retrieve a specific "mycomic" comic strip image
 my $image2 = $wc->get_strip(
                        comic => "mycomic",
                        id => "0042304973"
                    );

Downloads a copy of a comic strip image and returns the binary data
as a scalar. The C<comic> paramater is mandatory and must be a valid
supported comic as listed by the C<comics()> method. The most recent
comic strip image will be returned unless otherwise specified.

This method will return an C<undef> value upon failure.

=over 4

=item comic

This paramater is mandatory. It specifies the comic that this method
should process. See the C<comics()> method.

=item id

This paramater is optional. It specifies a specfic comic that should
be processed.

=item url

This paramater is optional. It specifies a specific comic that should
be processed. If specified it must be a fully qualified and valid absolute
HTTP URL. This paramater is typically only used when being called
indirectly by the C<mirror_strip()> method.

=back

=head2 mirror_strip

 # Write the most recent "mycomic" comic strip to disk
 # and return the name of the file that was written
 my $filename = $wc->mirror_strip(comic => "mycomic");
 
 # Write the "mycomic" comic strip image (reference 132)
 # to disk, specifcally to mycomic.gif, and return the
 # actual filename that was written to disk in to $file2
 my $file2 = $wc->mirror_strip(
                       comic => "mycomic",
                       id => "132",
                       filename => "mycomic.gif"
                  );

Download a copy of a comic strip image and write it to disk,
returning the name of the file that was actually written. This
method accepts the same paramaters as the C<get_strip()> method,
with the addition of the C<filename> paramater.

This method will return an C<undef> value upon failure.

=over 4

=item comic

This paramater is mandatory. It specifies the comic that this method
should process. See the C<comics()> method.

=item id

This paramater is optional. It specifies a specfic comic that should
be processed.

=item url

This paramater is optional. It specifies a specific comic that should
be processed. If specified it must be a fully qualified and valid absolute
HTTP URL.

=item filename

This paramater is optional. It specifiec the target filename that you
would like to be written to disk. If you do not supply an image file
extension, one will be added for you automatically. If you specify an
image file extension that differs to the file format of the file that
is to ultimately be written disk, it will be altered for you
automatically.

=back

=head2 plugins

 my @plugins = $wc->plugins;

Return a list of loaded plugins.

=head1 PLUGINS

Support for different comics is handled through the L<WWW::Comic::Plugin>
superclass. See the POD for L<WWW::Comic::Plugin> on how to create a new
plugin.

=head1 SEE ALSO

L<WWW::Comic::Plugin>, L<WWW::Dilbert>, L<WWW::VenusEnvy>

=head1 VERSION

$Id: Comic.pm,v 1.5 2006/01/10 15:45:44 nicolaw Exp $

=head1 AUTHOR

Nicola Worthington <nicolaw@cpan.org>

L<http://perlgirl.org.uk>

=head1 COPYRIGHT

Copyright 2006 Nicola Worthington.

This software is licensed under The Apache Software License, Version 2.0.

L<http://www.apache.org/licenses/LICENSE-2.0>

=cut