WWW::Pastebin::PhpfiCom::Create - create new pastes on http://phpfi.com/ pastebin site

WWW-Pastebin-PhpfiCom-Create documentation Contained in the WWW-Pastebin-PhpfiCom-Create distribution.

Index

Code Index:

NAME

Top

WWW::Pastebin::PhpfiCom::Create - create new pastes on http://phpfi.com/ pastebin site

SYNOPSIS

Top

    use strict;
    use warnings;

    use WWW::Pastebin::PhpfiCom::Create;

    my $paster = WWW::Pastebin::PhpfiCom::Create->new;

    $paster->paste('large text to paste')
        or die $paster->error;

    print "Your paste is located on $paster\n";

DESCRIPTION

Top

The module provides interface to paste large texts or files to http://phpfi.com/

CONSTRUCTOR

Top

new

    my $paster = WWW::Pastebin::PhpfiCom::Create->new;

    my $paster = WWW::Pastebin::PhpfiCom::Create->new(
        timeout => 10,
    );

    my $paster = WWW::Pastebin::PhpfiCom::Create->new(
        ua => LWP::UserAgent->new(
            timeout => 10,
            agent   => 'PasterUA',
        ),
    );

Constructs and returns a brand new yummy juicy WWW::Pastebin::PhpfiCom::Create object. Takes two arguments, both are optional. Possible arguments are as follows:

timeout

    ->new( timeout => 10 );

Optional. Specifies the timeout argument of LWP::UserAgent's constructor, which is used for pasting. Defaults to: 30 seconds.

ua

    ->new( ua => LWP::UserAgent->new( agent => 'Foos!' ) );

Optional. If the timeout argument is not enough for your needs of mutilating the LWP::UserAgent object used for pasting, feel free to specify the ua argument which takes an LWP::UserAgent object as a value. Note: the timeout argument to the constructor will not do anything if you specify the ua argument as well. Defaults to: plain boring default LWP::UserAgent object with timeout argument set to whatever WWW::Pastebin::PhpfiCom::Create's timeout argument is set to as well as agent argument is set to mimic Firefox.

METHODS

Top

paste

    my $paste_uri = $paster->paste('lots and lots of text')
        or die $paster->error;

    $paster->paste(
        'paste.txt',
        file    => 1,
        name    => 'Zoffix',
        desc    => 'paste from file',
        lang    => 'perl',
    ) or die $paster->error;

Instructs the object to create a new paste. If an error occured during pasting will return either undef or an empty list depending on the context and the reason for the error will be available via error() method. On success returns a URI object pointing to a newly created paste. The first argument is mandatory and must be either a scalar containing the text to paste or a filename. The rest of the arguments are optional and are passed in a key/value fashion. Possible arguments are as follows:

file

    $paster->paste( 'paste.txt', file => 1 );

Optional. When set to a true value the object will treat the first argument as a filename of the file containing the text to paste. When set to a false value the object will treat the first argument as a scalar containing the text to be pasted. Defaults to: 0

name

    $paster->paste( 'some text', name => 'Zoffix' );

Optional. Takes a scalar as a value which specifies the name of the person creating the paste. Defaults to: empty string (no name)

desc

    $paster->paste( 'some text', desc => 'some l33t codez' );

Optional. Takes a scalar as a value which specifies the description of the paste. Defaults to: empty string (no description)

lang

    $paster->paste( 'some text', lang => 'perl' );

Optional. Takes a scalar as a value which must be one of predefined language codes and specifies (computer) language of the paste, in other words which syntax highlighting to use. When set to auto the pastebin will try to guess the language. Defaults to: auto. Valid language codes are as follows (case insensitive):

        auto
        plaintext
        ada
        ada95
        awk
        c
        c++
        cc
        cpp
        cxx
        patch
        gpasm
        groff
        html
        java
        javascript
        lisp
        m4
        make
        makefile
        pascal
        patch
        perl
        php
        povray
        python
        ruby
        shellscript
        sql

error

    my $paste_uri = $paster->paste('lots and lots of text')
        or die $paster->error;

If an error occured during the call to paste() it will return either undef or an empty list depending on the context and the reason for the error will be available via error() method. Takes no arguments, returns a human parsable error message explaining why we failed.

paste_uri

    my $last_paste_uri = $paster->paste_uri;

    print "Paste can be found on $paster\n";

Must be called after a successfull call to paste(). Takes no arguments, returns a URI object pointing to a paste created by the last call to paste(), i.e. the return value of the last paste() call. This method is overloaded as q|"" thus you can simply interpolate your object in a string to obtain the paste URI.

ua

    my $old_LWP_UA_obj = $paster->ua;

    $paster->ua( LWP::UserAgent->new( timeout => 10, agent => 'foos' );

Returns a currently used LWP::UserAgent object used for pating. Takes one optional argument which must be an LWP::UserAgent object, and the object you specify will be used in any subsequent calls to paste().

NAME

Top

WWW::Pastebin::PhpfiCom::Create - blah

SYNOPSIS

Top

DESCRIPTION

Top

AUTHOR

Top

Zoffix Znet, <zoffix at cpan.org> (http://zoffix.com, http://haslayout.net)

BUGS

Top

Please report any bugs or feature requests to bug-www-pastebin-phpficom-create at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WWW-Pastebin-PhpfiCom-Create. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

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

    perldoc WWW::Pastebin::PhpfiCom::Create

You can also look for information at:

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=WWW-Pastebin-PhpfiCom-Create

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/WWW-Pastebin-PhpfiCom-Create

* CPAN Ratings

http://cpanratings.perl.org/d/WWW-Pastebin-PhpfiCom-Create

* Search CPAN

http://search.cpan.org/dist/WWW-Pastebin-PhpfiCom-Create

COPYRIGHT & LICENSE

Top

Copyright 2008 Zoffix Znet, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

WWW-Pastebin-PhpfiCom-Create documentation Contained in the WWW-Pastebin-PhpfiCom-Create distribution. 
package WWW::Pastebin::PhpfiCom::Create;

use warnings;
use strict;

our $VERSION = '0.001';

use Carp;
use URI;
use LWP::UserAgent;
use HTTP::Request::Common;
use base 'Class::Data::Accessor';
__PACKAGE__->mk_classaccessors qw(
    ua
    paste_uri
    error
);

use overload q|""| => sub { shift->paste_uri; };

my %Valid_Syntax_Highlights = _make_valid_highlights();

sub new {
    my $class = shift;
    croak "Must have even number of arguments to new()"
        if @_ & 1;

    my %args = @_;
    $args{ +lc } = delete $args{ $_ } for keys %args;

    $args{timeout} ||= 30;
    $args{ua} ||= LWP::UserAgent->new(
        timeout => $args{timeout},
        agent   => 'Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.8.1.12)'
                    .' Gecko/20080207 Ubuntu/7.10 (gutsy) Firefox/2.0.0.12',
    );

    my $self = bless {}, $class;
    $self->ua( $args{ua} );

    return $self;
}

sub paste {
    my ( $self, $text ) = splice @_, 0, 2;

    $self->$_(undef) for qw(paste_uri error);
    
    defined $text or carp "Undefined paste content" and return;
    
    croak "Must have even number of optional arguments to paste()"
        if @_ & 1;

    my %args = @_;
    %args = (
        source      => $text,
        name        => '',
        desc        => '',
        lang        => 'auto',

        %args,
    );

    $args{lang} = lc $args{lang};
    croak "Invalid value for 'lang' argument to paste()"
        unless exists $Valid_Syntax_Highlights{ $args{lang} };
        
    $args{file}
        and not -e $args{source}
        and return $self->_set_error(
            "File $args{source} does not seem to exist"
        );

    @args{ qw(nick descr) } = delete @args{ qw(name desc) };
    
    my $uri = URI->new('http://phpfi.com');
    
    my $ua = $self->ua;
    $ua->requests_redirectable( [] );
    my @post_request = $self->_make_request_args( \%args );
    my $response = $self->ua->request( POST @post_request );
    if ( $response->code == 302 ) {
        my $id = $response->header('Location');
        return $self->paste_uri( URI->new( 'http://phpfi.com' . $id ) );
    }
    elsif ( not $response->is_success ) {
        return $self->_set_error( $response, 'net' );    
    }
    else {
        return $self->_set_error(
            q|Request was successfull but I don't see a link to the paste| .
                $response->code . $response->content
        );
    }
}

sub _make_request_args {
    my ( $self, $args ) = @_;
    my $source = delete $args->{sourcefile};
    my %content = (
        exists $args->{file}
        ? ( sourcefile => [ $args->{source} ], source => '' )
        : ( source     => $args->{source}, sourcefile => '' )
    );
    delete @$args{qw(file source)};
    %content = ( %$args, %content );
    return (
        'http://phpfi.com/',
        Content_Type => 'form-data',
        Content => [ %content ],
    );
}

sub _set_error {
    my ( $self, $error, $type ) = @_;
    if ( defined $type and $type eq 'net' ) {
        $self->error( 'Network error: ' . $error->status_line );
    }
    else {
        $self->error( $error );
    }
    return;
}

sub _make_valid_highlights {
    return map { $_ => $_ } qw(
        auto
        plaintext
        ada
        ada95
        awk
        c
        c++
        cc
        cpp
        cxx
        patch
        gpasm
        groff
        html
        java
        javascript
        lisp
        m4
        make
        makefile
        pascal
        patch
        perl
        php
        povray
        python
        ruby
        shellscript
        sql
    );
}

1;
__END__