Code:DoSIAL.pm

From BioPerl

#$Id maj 31-03-09 $
package DoSIAL;
use strict;
use warnings;
 
=head1 DoSIAL : a class for HTTP interaction with L<http://sial.org/pbot>
 
=head1 SYNOPSIS
 
 use DoSIAL;
 my $sial = DoSIAL->new();
 
 my $content = "I'm gonna paste ya one."
 my $nick = 'joe';
 
 unless ( $sial->paste( $content, $nick ) ) {
    die "Dude, the paste failed: ".$sial->fail;
 }
 
 printf( "Get your paste at %s\n", $sial->paste_url );
 
=head1 DESCRIPTION
 
 C<DoSIAL> provides a little UserAgent wrapper around the pbot pasting 
 facility at http://sial.org. Sprinkle over your ircbots liberally for
 a tangy functionality you've only dreamed of.
 
=head1 AUTHORS
 
Email: maj -at- fortinbras -dot- us
 
=cut
 
use Error qw(:try);
use LWP::UserAgent;
use constant PBOT => 'http://sial.org/pbot';
 
# set up ua
sub new {
    my $class = shift;
    my @args = @_;
    my %ua_args;
    my $self = {};
    bless ($self, $class);
    if ( ref $args[0] eq 'HASH' ) {
	%ua_args = %{$args[0]};
    }
    else {
	%ua_args = @args;
    }
    $self->ua( LWP::UserAgent->new( %ua_args ) );
    $self->ua->agent( "DoSIAL 0.1/".$self->ua->agent );
    $self->ua->default_headers->push_header('Complaints-Questions-to' => 'maj at fortinbras dot us');
    return $self;
}
 
# args: ($your_paste_content, $your_nick, $a_summary) all scalar strings
# returns: url of the paste on success; FALSE plus error info in ->failed
#  if not
sub paste {
    my $self = shift;
    my ($the_dump, $nick, $summary) = @_;
    $self->fail('');
    $self->warn('');
    my $url;
    try {
	$self->fail("SIAL connection not initialized") unless 
	    (ref $self->ua eq 'LWP::UserAgent');
	$self->warn("No data provided to paste") unless $the_dump;
	throw Error::Simple( $self->fail("Nickname required") ) unless $nick;
 
	# taint check
	throw Error::Simple( $self->fail("Bad char in nick '$nick'") )  if ($nick and $nick =~ /[^a-zA-Z0-9_]/);
	throw Error::Simple( $self->fail("Bad char in summary") ) if ($summary && $summary =~ m{[^a-zA-Z0-9\._:/'"()\[\] ]});
 
	my $sial_form = {  'channel' => '',
			   'nick'    => $nick,
			   'summary' => $summary || '#bioperl support paste',
			   'paste'   => $the_dump };
	$self->response( $self->ua->post( PBOT."/paste", $sial_form ) );
	throw Error::Simple( $self->fail("Request failed: ".$self->response->status_line) ) unless $self->response->is_success;
 
	($url) = ( $self->response->content() =~ m{(http://sial.org/pbot/[0-9]+)} );
	throw Error::Simple( $self->fail("Unparsed response failure") ) unless $url;
    }
    catch Error::Simple with {
	return 0;
    };
    return $self->paste_url( $url );
}
 
# accessors
 
# to contain the LWP::UserAgent object
sub ua {
    my $self = shift;
    return $self->{_ua} = shift if @_;
    return $self->{_ua};
}
 
# to contain failure messages
sub fail {
    my $self = shift;
    return $self->{_fail} = shift if @_;
    return $self->{_fail};
}
 
# to contain warnings
# reset the property on read
sub warn {
    my $self = shift;
    return $self->{_warn} = shift if @_;
    my $msg = $self->{_warn};
    $self->{_warn} = '';
    return $msg}
 
# to contain the returned url to access the paste
sub paste_url {
    my $self = shift;
    return $self->{_paste_url} = shift if @_;
    return $self->{_paste_url};
}
 
# to contain the HTTP::Response object after the 
# post to http://sial.org/pbot/paste
sub response {
    my $self = shift;
    return $self->{_response} = shift if @_;
    return $self->{_response};
}
1;