package WWW::Pastebin::Sprunge::Retrieve; use strict; use warnings; # ABSTRACT: retrieves pastes from the sprunge.us pastebin our $VERSION = '0.007'; # VERSION use URI; use Carp; use LWP::UserAgent; use Encode; use base 'Class::Data::Accessor'; __PACKAGE__->mk_classaccessors(qw( ua uri id content error results )); use overload q|""| => sub { shift->content }; sub new { my $class = shift; croak 'new() takes an even number of arguments' if @_ & 1; my %args = @_; $args{ +lc } = delete $args{ $_ } for keys %args; $args{timeout} ||= 30; $args{ua} ||= LWP::UserAgent->new( timeout => $args{timeout}, agent => 'WWW::Pastebin::Sprunge (+http://p3rl.org/WWW::Pastebin::Sprunge)', ); my $self = bless {}, $class; $self->ua( $args{ua} ); return $self; } sub retrieve { my $self = shift; my $id = shift; $self->$_(undef) for qw( error uri id results ); return $self->_set_error('Missing or empty paste ID/URL') unless $id; (my $uri, $id) = $self->_make_uri_and_id($id, @_) or return; $self->uri($uri); $self->id($id); my $ua = $self->ua; my $response = $ua->get($uri); if ($response->is_success) { return $self->_get_was_successful($response->content); } else { return $self->_set_error('Network error: ' . $response->status_line); } } sub _get_was_successful { my $self = shift; my $content = shift; return $self->results( $self->_parse($content) ); } sub _set_error { my $self = shift; my $err_or_res = shift; my $is_net_error = shift; if (defined $is_net_error) { $self->error('Network error: ' . $err_or_res->status_line); } else { $self->error($err_or_res); } return; } sub _make_uri_and_id { my $self = shift; my $in = shift; my $id; if ( $in =~ m{ (?:http://)? (?:www\.)? sprunge.us/ (\S+?) (?:\?\w+)? $}ix ) { $id = $1; } $id = $in unless defined $id; return ( URI->new("http://sprunge.us/$id"), $id ); } sub _parse { my $self = shift; my $content = shift; my $id = $self->id; if (!defined($content) or !length($content)) { return $self->_set_error('Nothing to parse (empty document retrieved)'); } elsif ($content eq "$id not found") { return $self->_set_error('No such paste'); } else { $self->results(decode_utf8($content)); return $self->content(decode_utf8($content)); } } sub content { my $self = shift; return $self->results; } 1; __END__ =pod =encoding utf-8 =head1 NAME WWW::Pastebin::Sprunge::Retrieve - retrieves pastes from the sprunge.us pastebin =head1 VERSION version 0.007 =head1 SYNOPSIS use strict; use warnings; use WWW::Pastebin::Sprunge::Retrieve; my $paster = WWW::Pastebin::Sprunge::Retrieve->new(); my $content = $paster->retrieve('http://sprunge.us/84Pc') or die $paster->error(); print $content; # overloaded =head1 DESCRIPTION The module provides an interface to retrieve pastes from the L pastebin website via Perl. =head1 METHODS =head2 C my $paster = WWW::Pastebin::Sprunge::Retrieve->new(); # OR: my $paster = WWW::Pastebin::Sprunge::Retrieve->new( timeout => 10, ); # OR: my $paster = WWW::Pastebin::Sprunge::Retrieve->new( ua => LWP::UserAgent->new( timeout => 10, agent => 'PasterUA', ), ); Constructs and returns a new WWW::Pastebin::Sprunge::Retrieve object. Takes two arguments, both are I. Possible arguments are as follows: =head3 C ->new( timeout => 10 ); B. Specifies the C argument of L's constructor, which is used for retrieving. B C<30> seconds. =head3 C ->new( ua => LWP::UserAgent->new( agent => 'Foos!' ) ); If the C argument is not enough for your needs, feel free to specify the C argument which takes an L object as a value. B the C argument to the constructor will not do anything if you specify the C argument as well. B a L object with C argument set to 30s, and a suitable useragent string. =head2 C my $content = $paster->retrieve('http://sprunge.us/SCLg') or die $paster->error(); my $content = $paster->retrieve('SCLg') or die $paster->error(); Instructs the object to retrieve a paste specified in the argument. Takes one mandatory argument which can be either a full URI to the paste you want to retrieve or just its ID. On failure returns either C or an empty list depending on the context and the reason for the error will be available via C method. On success, returns the pasted text. =head2 C $paster->retrieve('SCLg') or die $paster->error; On failure C returns either C or an empty list depending on the context and the reason for the error will be available via C method. Takes no arguments, returns an error message explaining the failure. =head2 C my $paste_id = $paster->id; Must be called after a successful call to C. Takes no arguments, returns a paste ID number of the last retrieved paste irrelevant of whether an ID or a URI was given to C =head2 C my $paste_uri = $paster->uri; Must be called after a successful call to C. Takes no arguments, returns a L object with the URI pointing to the last retrieved paste irrelevant of whether an ID or a URI was given to C =head2 C my $last_results_ref = $paster->results; Must be called I a successful call to C. Takes no arguments, returns the exact same string as the last call to C returned. See C method for more information. =head2 C my $paste_content = $paster->content; print "Paste content is:\n$paster\n"; Must be called after a successful call to C. Takes no arguments, returns the actual content of the paste. B this method is overloaded for this module for interpolation. Thus you can simply interpolate the object in a string to get the contents of the paste. =head1 AVAILABILITY The project homepage is L. The latest version of this module is available from the Comprehensive Perl Archive Network (CPAN). Visit L to find a CPAN site near you, or see L. =head1 SOURCE The development version is on github at L and may be cloned from L =head1 BUGS AND LIMITATIONS You can make new bug reports, and view existing ones, through the web interface at L. =head1 AUTHOR Mike Doherty =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2010 by Mike Doherty. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut