view release on metacpan or  search on metacpan

lib/Net/Pavatar.pm  view on Meta::CPAN

	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;
}



=head2 my ($hashref, $type) = Net::Pavatar->fetch( $url, \%opts )

Returns a hashref and a string, as a 2-list. The hash contains the image sizes as keys, and the image data for each size as values. The string contains the image type and can either be 'jpeg', 'png' or 'gif'. If a pavatar does not exist, or is not va...

The \%opts hashref is optional, and accepts the following keys:

C<size> : the sizes that you want the pavatar image returned in - defaults to 80

C<timeout> : the total time that UserAgent is allowed to retrieve each page or image - defaults to 15

e.g. C<< Net::Pavatar->fetch( $url, { size => [32, 48], timeout => 25 } ) >>

=cut

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);
}

=head1 AUTHOR

Alexander Karelas, C<< <karjala at karjala.org> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-net-pavatar at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-Pavatar>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

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

    perldoc Net::Pavatar

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation