Net::Pavatar - Pavatar client

    use Net::Pavatar;

    my ($hash, $file_type) = Net::Pavatar->fetch( 'http://someblog.com/', { size => [32, 48] } );

    if ($file_type) {
        open FILE, ">avatar.$file_type";
        print FILE $hash->{'48'};
        close FILE;
    }

    perldoc Net::Pavatar

package Net::Pavatar;

use warnings;
use strict;
use LWPx::ParanoidAgent;
use Carp;
use URI;
use GD;
use Regexp::Common qw /URI/;

our $VERSION = '1.01';

sub _browser_get {
	my $url = shift;
	my $browser = shift;

	my ($i, $resp) = (0, undef);
	do {
		if ($i++) { sleep(1); }
		$resp = $browser->get($url);
	} until ($i >= 3 or $resp->code <= 499);
	return wantarray ? ($resp, $resp->is_success) : $resp;
}

sub _discover {
	my $class = shift;
	my $url = shift;
	my $params = shift || {};

	my $ua = $params->{'ua'} || LWPx::ParanoidAgent->new( timeout => 15, parse_head => 0 );
	my ($resp, $ok) = &_browser_get($url, $ua);
	if (! $ok) { return }
	my $base = $resp->base();

	# STEP 3.a of spec
	my ($answer) = $resp->header('X-Pavatar');
	if (defined $answer) {
		if ($answer eq 'none' or $answer !~ /$RE{'URI'}{'HTTP'}/) { return }
		return $answer;
	}

	# STEP 3.b of spec
	my $page = $resp->content;
	if ($resp->content_type =~ /\b(x?html|xml)\b/) {
		($answer) = $page =~ /<link rel="pavatar" href="([^"]+)" ?\/?>/gi;
		if (defined $answer) {
			if ($answer eq 'none' or $answer !~ /$RE{'URI'}{'HTTP'}/) { return }
			return $answer;
		}
	}

	# STEP 3.c of spec
	my $uri = URI->new($url);
	#my $uri = $resp->request->uri;
	if ($uri->scheme ne 'http') { return; }
	$uri = 'http://'.$uri->host_port.($uri->path || '/');
	my $pavuri = URI->new_abs('pavatar.png', $uri);

	my $max_size = $ua->max_size;
	$ua->max_size(51200);

	($resp, $ok) = &_browser_get( $pavuri->as_string, $ua );
	if ($ok) { $ua->max_size($max_size); return wantarray ? ($pavuri, $resp) : $pavuri; }

	my $did_pavuri = $pavuri->as_string;
	$pavuri->path('/pavatar.png');

	if ($pavuri->as_string ne $did_pavuri) {
		($resp, $ok) = &_browser_get( $pavuri, $ua );
		if ($ok) { $ua->max_size($max_size); return wantarray ? ($pavuri, $resp) : $pavuri; }
	}

	$ua->max_size($max_size);

	return;
}

sub fetch {
	my $class = shift;
	my $url = shift;
	my $params = shift || {};

	my $ua = $params->{'ua'} || LWPx::ParanoidAgent->new( timeout => 15, parse_head => 0 );
	($url, my $resp) = $class->_discover($url, { ua => $ua });
	if (! $url) { return; }

	my $max_size = $ua->max_size;
	$ua->max_size(51200);
	my $ok;
	if (! $resp) {
		($resp, $ok) = &_browser_get($url, $ua);
	} else {
		$ok = 1;
	}
	$ua->max_size($max_size);
	if (! $ok) { return; }

	my $type = $resp->content_type;
	($type) = $type =~ /^image\/(.+)$/g;

	my $img;
	if ($type eq 'jpeg') {
		$img = GD::Image->newFromJpegData($resp->content, 1);
	} elsif ($type eq 'gif') {
		$img = GD::Image->newFromGifData($resp->content, 1);
	} elsif ($type eq 'png') {
		$img = GD::Image->newFromPngData($resp->content, 1);
	} else {
		return;
	}
	if (! $img) { return; }

	my ($width, $height) = $img->getBounds();
	if ($width != 80 or $height != 80) { return; }
	my @sizes;
	my $size = $params->{'size'};
	if (! defined $size) {
		@sizes = (80);
	} elsif (ref $size eq 'ARRAY') {
		@sizes = grep { /^\d+$/ } @$size;
	} elsif (! ref $size) {
		@sizes = int($size);
	} else {
		confess "Error: sizes parameter needs to be a number or an arrayref";
	}

	my $return = { };
	foreach my $size (@sizes) {
		if ($size == 80) {
			$return->{'80'} = $resp->content();
		} elsif ($size > 0 and $size < 80) {
			my $newimage = GD::Image->new($size, $size, 1);
			$newimage->copyResampled($img, 0, 0, 0, 0, $size, $size, 80, 80);
			my $data = $newimage->$type();
			$return->{$size} = $data;
		} else {
			confess "Error: problem with size = '$size' (needs to be an integer between 1 and 80 inclusive)";
		}
	}
	if (! keys %$return) { return; }

	return ($return, $type);
}

1; # End of Net::Pavatar