package WebService::Bluga::Webthumb;

use warnings;
use strict;
use Carp;
use Digest::MD5;
use LWP::Simple;
use URI;
use Path::Class;
use POSIX qw(strftime);

=head1 NAME

WebService::Bluga::Webthumb - fetch website thumbnails via


our $VERSION = '0.05';


    use WebService::Bluga::Webthumb;
    my $wt = WebService::Bluga::Webthumb->new(
        user    => $user_id,
        api_key => $api_key,
        size    => $size,  # small, medium, medium2, large (default: medium)
        cache   => $cache_days, # optional - default 14
        # optional settings for local caching:
        cache_dir => '....',
        cache_url_stub => '/images/thumbs/',

    # get a thumbnail URL using the default settings
    my $thumb_url = wt->thumb_url($url);

    # Get a thumbnail URL overriding some settings:
    my $thumb_url = $wt->thumb_url($url, { size => 'large' });

=head1 Class methods

=over 4

=item new

Create a new WebService::Bluga::Webthumb object.  Takes the following params:

=over 4

=item user

Your webthumb user ID, available from your L<>

=item api_key

Your webthumb API key. also available from your user page.  (This is used to
construct the hash of the thumbnail URL, but not sent directly.)

=item size

The size of the thumbnail to generate.  Size can be:

=over 4

=item * small - 80x60

=item * medium - 160x120

=item * medium2 - 320x240

=item * large - 640x480


=item cache

How many days a generated thumbnail can be cached on the webthumb servers before
a fresh one is generated.  Generating a thumbnail uses a credit whereas serving
up a cached one uses a fraction of a credit, so don't set this too low.

If not specified, defaults to 14 days.

=item cache_dir

If set, generated thumbnails will be saved into this directory, and the URL
returned will be constructed using C<cache_url_stub> (so the C<cache_url_stub>
setting should be set to the URL at which the contents of C<cache_dir> are

The age of the cached thumbnail will be compared against the C<cache> setting, 
and if it's too old, the cached thumbnail will be replaced with a fresh one.



sub new {
    my $class = shift;
    if (@_ % 2 != 0) {
        croak "Uneven number of parameters provided";

    my %params = @_;
    # TODO: more extensive validation
    if (!$params{user} || !$params{api_key}) {
        croak "'user' and 'api_key' params must be provided";

    if (exists $params{size} 
        && !grep { $params{size} eq $_ } qw(small medium medium2 large)
    ) {
        croak "Invalid size $params{size} supplied!";
    } elsif (!exists $params{size}) {
        $params{size} = 'medium';

    if (!exists $params{cache}) {
        $params{cache} = 14;

    my $self = \%params;
    bless $self => $class;
    return $self;


=head1 Instance methods

=over 4

=item thumb_url

Given an URL, and optionally C<size> / C<cache> params to override those from
the object, returns an URL to the thumbnail, to use in an IMG tag.


sub thumb_url {
    my ($self, $url, $params) = @_;

    # Get our params, use defaults from the object
    $params ||= {};
    $params->{$_} ||= $self->{$_}
        for qw(size cache cache_dir cache_url_stub);

    # First, if we're caching locally, we need to see if we already have a
    # cached version; if so, it's easy
    if (my $url = $self->_get_cached_url($url, $params)) {
        return $url;

    # Generate the appropriate URL:
    my $uri = URI->new('');
        url   => $url,
        size  => $params->{size},
        cache => $params->{cache},
        user  => $self->{user},
        hash  => Digest::MD5::md5_hex(join '',
            strftime("%Y%m%d", gmtime(time())),

    # If we're caching, we want to fetch the resulting thumbnail and store it
    # locally, then return the URL to that instead
    if ($params->{cache_dir}) {
        my $img_content = LWP::Simple::get($uri);
        if ($img_content) {
            my $url = $self->_cache_image($url, $params, $img_content);
            return $url if defined $url;

    return $uri->as_string;

=item easy_thumb

An alias for C<thumb_url>.  This name was used in 0.01 to reflect the fact that
it used the L<EasyThumb API|> rather than
the full API; however, I think C<thumb_url> is rather clearer as to the actual
purpose of the method, and the implementation of it is somewhat unimportant, so
consider this method somewhat deprecated (but likely to be supported


sub easy_thumb { shift->thumb_url(@_); }

sub _get_cached_url {
    my ($self, $url, $params) = @_;

    my $dir = Path::Class::dir($params->{cache_dir})
        or return;
    my $file = $dir->file(
        Digest::MD5::md5_hex($url . $params->{size})
    ) or return;
    my $stat = $file->stat or return;
    if ($stat->mtime < time - ($params->{cache} * 24 * 60 * 60)) {
    } else {
        return $params->{cache_url_stub} . $file->basename;

sub _cache_image {
    my ($self, $url, $params, $img_content) = @_;

    my $dir = Path::Class::dir($params->{cache_dir})
        or return;
    my $file = $dir->file(
        Digest::MD5::md5_hex($url . $params->{size})
    ) or return;
    return $params->{cache_url_stub} . $file->basename;


=head1 AUTHOR

David Precious, C<< <davidp at> >>


James Ronan


This module is developed on GitHub at:


Bug reports / suggestions / pull requests are all very welcome.

If you find this module useful, please feel free to 
L<rate it on cpanratings|>

=head1 BUGS

Bug reports via L<Issues on
GitHub|> are
preferred, as the module is developed on GitHub, and issues can be correlated to
commits.  Bug reports via L<the RT
are still valued though, if you'd prefer that way.

=head1 SEE ALSO

See the API documentation at L<>

For a basic description of the service, see L<>

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc WebService::Bluga::Webthumb


Copyright 2011 David Precious.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See for more information.


1; # End of WebService::Bluga::Webthumb