File Coverage

blib/lib/WWW/Pastebin/PastebinCom/API.pm

Criterion	Covered	Total	%
statement	126	178	70.7
branch	38	106	35.8
condition	16	63	25.4
subroutine	22	24	91.6
pod	8	8	100.0
total	210	379	55.4

package WWW::Pastebin::PastebinCom::API;

use strict;
use warnings;

our $VERSION = '1.001002'; # VERSION

use LWP::UserAgent;
use Carp;
use HTTP::Cookies;

use base qw/Class::Data::Accessor/;
__PACKAGE__->mk_classaccessors(qw/
    error
    api_key
    user_key
    paste_url
    _ua
/);

use overload q|""| => sub {
    my $obj = shift;
    defined $obj->error ? 'Error: ' . $obj->error : $obj->paste_url
};

sub new {
    my $class = shift;
    croak 'Must have even number of arguments to the constructor'
        if @_ & 1;

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

    unless ( $args{timeout} ) {
        $args{timeout} = 30;
    }
    unless ( $args{ua} ) {
        $args{ua} = LWP::UserAgent->new(
            timeout => $args{timeout},
            agent   => 'Mozilla/5.0 (X11; Ubuntu; Linux i686; rv:21.0)'
                        . ' Gecko/20100101 Firefox/21.0',
        );
    }

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

    return $self;
}

sub get_user_info {
    my $self = shift;
    $self->error( undef );

    my $api_key = $self->_get_api_key
        or return $self->_set_error(q|Missing API key|);

    my $user_key = $self->_get_user_key
        or return $self->_set_error(
            q|Missing USER key. See ->get_user_key() method|
        );

    my $response = $self->_ua->post(
        'http://pastebin.com/api/api_post.php',
        {
            api_dev_key         => $api_key,
            api_user_key        => $user_key,
            api_option          => 'userdetails',
        },
    );

    if ( $response->is_success or $response->is_redirect ) {
        return $self->_set_error( $response->content )
            if $response->content =~ /^Bad API request/;

        return $self->_parse_user_xml( $response->content );
    }
    else {
        $self->error( $response->status_line );
        return;
    }
}

sub list_user_pastes {
    my $self = shift;
    my $limit = shift || 50;
    $limit = 1    if $limit < 1;
    $limit = 1000 if $limit > 1000;

    $self->error( undef );

    my $api_key = $self->_get_api_key
        or return $self->_set_error(q|Missing API key|);

    my $user_key = $self->_get_user_key
        or return $self->_set_error(
            q|Missing USER key. See ->get_user_key() method|
        );

    my $response = $self->_ua->post(
        'http://pastebin.com/api/api_post.php',
        {
            api_dev_key         => $api_key,
            api_user_key        => $user_key,
            api_results_limit   => $limit,
            api_option          => 'list',
        },
    );

    if ( $response->is_success or $response->is_redirect ) {
        return $self->_set_error( $response->content )
            if $response->content =~ /^Bad API request/;

        return []
            if $response->content =~ /^No pastes found/;

        return $self->_parse_xml( $response->content );
    }
    else {
        $self->error( $response->status_line );
        return;
    }
}

sub list_trends {
    my $self = shift;

    $self->error( undef );

    my $api_key = $self->_get_api_key
        or return $self->_set_error(q|Missing API key|);

    my $response = $self->_ua->post(
        'http://pastebin.com/api/api_post.php',
        {
            api_dev_key         => $api_key,
            api_option          => 'trends',
        },
    );

    if ( $response->is_success or $response->is_redirect ) {
        return $self->_set_error( $response->content )
            if $response->content =~ /^Bad API request/;

        return $self->_parse_xml( $response->content );
    }
    else {
        $self->error( $response->status_line );
        return;
    }
}

sub delete_paste {
    my $self       = shift;
    my $paste_key  = shift;

    $paste_key =~ s{(?:https?://)?(?:www\.)?pastebin\.com/}{}i;

    return $self->_set_error('Missing paste key')
        unless defined $paste_key and length $paste_key;

    $self->error( undef );

    my $api_key = $self->_get_api_key
        or return $self->_set_error(q|Missing API key|);

    my $user_key = $self->_get_user_key
        or return $self->_set_error(
            q|Missing USER key. See ->get_user_key() method|
        );

    my $response = $self->_ua->post(
        'http://pastebin.com/api/api_post.php',
        {
            # mandatory API keys
            api_dev_key         => $api_key,
            api_user_key        => $user_key,
            api_paste_key       => $paste_key,
            api_option          => 'delete',
        },
    );

    if ( $response->is_success or $response->is_redirect ) {
        return $self->_set_error( $response->content )
            if $response->content =~ /^Bad API request/;

        return 1;
    }
    else {
        $self->error( $response->status_line );
        return;
    }
    return 1;
}

sub get_paste {
    my $self       = shift;
    my $paste_key  = shift;
    my ( $login, $pass ) = @_;

    $self->error( undef );

    $paste_key =~ s{(?:https?://)?(?:www\.)?pastebin\.com/}{}i;

    defined $paste_key and length $paste_key
        or return $self->_set_error('Missing paste ID or URL');

    if ( defined $login and defined $pass ) {
        $self->_ua->cookie_jar( HTTP::Cookies->new );
        $self->_ua->post(
            'http://pastebin.com/login.php', {
                submit_hidden   => 'submit_hidden',
                user_name       => $login,
                user_password   => $pass,
                submit          => 'Login',
            }
        );
    }

    my $response = $self->_ua->get(
        "http://pastebin.com/raw.php?i=$paste_key",
    );

    $self->_ua->cookie_jar( undef );

    if ( $response->is_success or $response->is_redirect ) {
        return $self->_set_error(q|This paste doesn't exist|)
            unless defined $response->content
                and length $response->content;

        return $self->_set_error( $response->content )
            if $response->content
            eq 'Error, this is a private paste. If this is your '
                . 'private paste, please login to Pastebin first.';

        return $response->content;
    }
    else {
        if ( $response->status_line eq '404 Not Found' ) {
            $self->error(q|This paste doesn't exist|);
        }
        else {
            $self->error( 'Network error: ' . $response->status_line );
        }
        return;
    }
}

sub paste {
    my $self       = shift;
    my $paste_text = shift;

    $self->error( undef );
    $self->paste_url( undef );

    defined $paste_text and length $paste_text
        or return $self->_set_error('Paste text is empty');

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

    my @args = $self->_prepare_optional_api_options( \%args )
        or return;

    my $api_key = $self->_get_api_key
        or return $self->_set_error(q|Missing API key|);

    my $response = $self->_ua->post(
        'http://pastebin.com/api/api_post.php',
        {
            # mandatory API keys
            api_dev_key    => $api_key,
            api_option     => 'paste',
            api_paste_code => $paste_text,

            @args,
        },
    );

    if ( $response->is_success or $response->is_redirect ) {
        return $self->_set_error( $response->content )
            if $response->content =~ /^Bad API request|^Post limit, maximum pastes/;

        return $self->paste_url( $response->content );
    }
    else {
        $self->error( $response->status_line );
        return;
    }
}

sub get_user_key {
    my ( $self, $login, $pass ) = @_;

    $self->error( undef );
    $self->user_key( undef );

    my $api_key = $self->_get_api_key
        or return $self->_set_error(q|Missing API key|);

    my $response = $self->_ua->post(
        'http://pastebin.com/api/api_login.php',
        {
            api_dev_key         => $api_key,
            api_user_name       => $login,
            api_user_password   => $pass,
        },
    );

    if ( $response->is_success or $response->is_redirect ) {
        return $self->_set_error( $response->content )
            if $response->content =~ /^Bad API request/;

        return $self->user_key( $response->content );
    }
    else {
        $self->error( $response->status_line );
        return;
    }
}

sub _parse_user_xml {
    my ( $self, $content ) = @_;

    $content =~ s{\s*(.+)\s*}{$1}gs;

    my %user = $content =~ ( m{<([^>]+)>(.*?)}sg );
    $user{ substr $_, 5 } = delete $user{ $_ } for keys %user;
    if ( $user{private} == 2 ) {
        $user{private} = 1
    }
    elsif ( $user{private} == 1 ) {
        $user{unlisted} = 1;
    }
    else {
        delete $user{private};
    }

    return wantarray ? %user : \%user;
}

sub _parse_xml {
    my ( $self, $content ) = @_;

    my @out;
    for ( $content =~ m{(.+?)}gs ) {
        my %paste = ( m{<([^>]+)>(.*?)}sg );
        $paste{ substr $_, 6 } = delete $paste{ $_ } for keys %paste;

        my $private_flag = delete $paste{private};
        if ( $private_flag == 2 ) { $paste{private} = 1; }
        elsif ( $private_flag == 1 ) { $paste{unlisted} = 1; }

        push @out, \%paste;
    }

    return wantarray ? @out : \@out;
}

sub _get_user_key {
    my $self = shift;

    return $self->user_key
        || return $self->_set_error('API user key must be provided'
            . ' to create private pastes. See ->user_key() or'
            . ' ->get_user_key() in the documentation.');
}

sub _get_api_key {
    my $self = shift;

    return $self->api_key
        || return $self->_set_error(q|Can't operate without an API key.|
            . q| Sign up / Log in to pastebin.com, then go|
            . q| to http://pastebin.com/api to see your API key|
            . q| (it's in the section "Your Unique Developer API Key")|);
}

sub _prepare_optional_api_options {
    my ( $self, $args ) = @_;
    my @out_args;

    push @out_args, api_paste_name => $args->{title}
        if defined $args->{title}; # title of the paste

    if ( defined $args->{format} ) {
        $self->_is_valid_format( $args->{format} )
            or return $self->_set_error(
                'Invalid syntax highlighting code. See ->valid_formats()'
                . ' method in the documentation'
            );
        push @out_args, api_paste_format => $args->{format};
    }

    if( $args->{owned} and not $args->{private} ) {
        defined ( $args->{user_key} || $self->user_key )
            or return $self->set_error(
                'API user key must be provided to create owned pastes.'
                    . ' See ->user_key() or ->get_user_key() in the'
                    . ' documentation.'
            );

            push @out_args,
                api_user_key => ( $args->{user_key} || $self->user_key );
    }

    if ( $args->{private} ) {
        defined ( $args->{user_key} || $self->user_key )
            or return $self->_set_error(
                'API user key must be provided to create private pastes.'
                    . ' See ->user_key() or ->get_user_key() in the'
                    . ' documentation.'
            );

        push @out_args,
            api_paste_private => 2,
            api_user_key => ( $args->{user_key} || $self->user_key );
    }
    elsif ( $args->{unlisted} ) {
        push @out_args, api_paste_private => 1;
    }
    else {
        ### DEBUGGING NOTE:
        ### Pastebin will automatically list duplicate content
        ### or content with "some" keywords as unlisted
        ### even if we tell it to go public
        push @out_args, api_paste_private => 0;
    }

    if ( $args->{expiry} ) {
        my $expiry = $self->_translate_expiry( $args->{expiry} )
            or return $self->_set_error('Invalid `expiry` argument');

        push @out_args, api_paste_expire_date => $expiry;
    }

    return @out_args;
}

sub _translate_expiry {
    my ( $self, $expiry ) = @_;

    my %expiries = (
        # 10 Minutes
        '10m'   => '10M',
        m10     => '10M',
        asap    => '10M',

        # 1 Hour
        h       => '1H',
        '1h'    => '1H',

        # 1 Day
        d       => '1D',
        '1d'    => '1D',
        soon    => '1D',

        # 1 Week
        w       => '1W',
        '1w'    => '1W',
        awhile  => '1W',

        '2w'    => '2W',
        w2      => '2W',

        # 1 Month
        '1m'    => '1M',
        m1      => '1M',
        eventually      => '1M',

        # Never
        n       => 'N',
        never   => 'N',
    );

    return $expiries{ lc $expiry }
        || $self->_set_error('Invalid expiry value');
}

sub _set_error {
    my ( $self, $error ) = @_;
    $self->error( $error );
    return;
}

sub _is_valid_format {
    my ( $self, $format ) = @_;

    my %formats = (
        '4cs' => '4CS',
        '6502acme' => '6502 ACME Cross Assembler',
        '6502kickass' => '6502 Kick Assembler',
        '6502tasm' => '6502 TASM/64TASS',
        'abap' => 'ABAP',
        'actionscript' => 'ActionScript',
        'actionscript3' => 'ActionScript 3',
        'ada' => 'Ada',
        'algol68' => 'ALGOL 68',
        'apache' => 'Apache Log',
        'applescript' => 'AppleScript',
        'apt_sources' => 'APT Sources',
        'arm' => 'ARM',
        'asm' => 'ASM (NASM)',
        'asp' => 'ASP',
        'asymptote' => 'Asymptote',
        'autoconf' => 'autoconf',
        'autohotkey' => 'Autohotkey',
        'autoit' => 'AutoIt',
        'avisynth' => 'Avisynth',
        'awk' => 'Awk',
        'bascomavr' => 'BASCOM AVR',
        'bash' => 'Bash',
        'basic4gl' => 'Basic4GL',
        'bibtex' => 'BibTeX',
        'blitzbasic' => 'Blitz Basic',
        'bnf' => 'BNF',
        'boo' => 'BOO',
        'bf' => 'BrainFuck',
        'c' => 'C',
        'c_mac' => 'C for Macs',
        'cil' => 'C Intermediate Language',
        'csharp' => 'C#',
        'cpp' => 'C++',
        'cpp-qt' => 'C++ (with QT extensions)',
        'c_loadrunner' => 'C: Loadrunner',
        'caddcl' => 'CAD DCL',
        'cadlisp' => 'CAD Lisp',
        'cfdg' => 'CFDG',
        'chaiscript' => 'ChaiScript',
        'clojure' => 'Clojure',
        'klonec' => 'Clone C',
        'klonecpp' => 'Clone C++',
        'cmake' => 'CMake',
        'cobol' => 'COBOL',
        'coffeescript' => 'CoffeeScript',
        'cfm' => 'ColdFusion',
        'css' => 'CSS',
        'cuesheet' => 'Cuesheet',
        'd' => 'D',
        'dcl' => 'DCL',
        'dcpu16' => 'DCPU-16',
        'dcs' => 'DCS',
        'delphi' => 'Delphi',
        'oxygene' => 'Delphi Prism (Oxygene)',
        'diff' => 'Diff',
        'div' => 'DIV',
        'dos' => 'DOS',
        'dot' => 'DOT',
        'e' => 'E',
        'ecmascript' => 'ECMAScript',
        'eiffel' => 'Eiffel',
        'email' => 'Email',
        'epc' => 'EPC',
        'erlang' => 'Erlang',
        'fsharp' => 'F#',
        'falcon' => 'Falcon',
        'fo' => 'FO Language',
        'f1' => 'Formula One',
        'fortran' => 'Fortran',
        'freebasic' => 'FreeBasic',
        'freeswitch' => 'FreeSWITCH',
        'gambas' => 'GAMBAS',
        'gml' => 'Game Maker',
        'gdb' => 'GDB',
        'genero' => 'Genero',
        'genie' => 'Genie',
        'gettext' => 'GetText',
        'go' => 'Go',
        'groovy' => 'Groovy',
        'gwbasic' => 'GwBasic',
        'haskell' => 'Haskell',
        'haxe' => 'Haxe',
        'hicest' => 'HicEst',
        'hq9plus' => 'HQ9 Plus',
        'html4strict' => 'HTML',
        'html5' => 'HTML 5',
        'icon' => 'Icon',
        'idl' => 'IDL',
        'ini' => 'INI file',
        'inno' => 'Inno Script',
        'intercal' => 'INTERCAL',
        'io' => 'IO',
        'j' => 'J',
        'java' => 'Java',
        'java5' => 'Java 5',
        'javascript' => 'JavaScript',
        'jquery' => 'jQuery',
        'kixtart' => 'KiXtart',
        'latex' => 'Latex',
        'ldif' => 'LDIF',
        'lb' => 'Liberty BASIC',
        'lsl2' => 'Linden Scripting',
        'lisp' => 'Lisp',
        'llvm' => 'LLVM',
        'locobasic' => 'Loco Basic',
        'logtalk' => 'Logtalk',
        'lolcode' => 'LOL Code',
        'lotusformulas' => 'Lotus Formulas',
        'lotusscript' => 'Lotus Script',
        'lscript' => 'LScript',
        'lua' => 'Lua',
        'm68k' => 'M68000 Assembler',
        'magiksf' => 'MagikSF',
        'make' => 'Make',
        'mapbasic' => 'MapBasic',
        'matlab' => 'MatLab',
        'mirc' => 'mIRC',
        'mmix' => 'MIX Assembler',
        'modula2' => 'Modula 2',
        'modula3' => 'Modula 3',
        '68000devpac' => 'Motorola 68000 HiSoft Dev',
        'mpasm' => 'MPASM',
        'mxml' => 'MXML',
        'mysql' => 'MySQL',
        'nagios' => 'Nagios',
        'newlisp' => 'newLISP',
        'text' => 'None',
        'nsis' => 'NullSoft Installer',
        'oberon2' => 'Oberon 2',
        'objeck' => 'Objeck Programming Langua',
        'objc' => 'Objective C',
        'ocaml-brief' => 'OCalm Brief',
        'ocaml' => 'OCaml',
        'octave' => 'Octave',
        'pf' => 'OpenBSD PACKET FILTER',
        'glsl' => 'OpenGL Shading',
        'oobas' => 'Openoffice BASIC',
        'oracle11' => 'Oracle 11',
        'oracle8' => 'Oracle 8',
        'oz' => 'Oz',
        'parasail' => 'ParaSail',
        'parigp' => 'PARI/GP',
        'pascal' => 'Pascal',
        'pawn' => 'PAWN',
        'pcre' => 'PCRE',
        'per' => 'Per',
        'perl' => 'Perl',
        'perl6' => 'Perl 6',
        'php' => 'PHP',
        'php-brief' => 'PHP Brief',
        'pic16' => 'Pic 16',
        'pike' => 'Pike',
        'pixelbender' => 'Pixel Bender',
        'plsql' => 'PL/SQL',
        'postgresql' => 'PostgreSQL',
        'povray' => 'POV-Ray',
        'powershell' => 'Power Shell',
        'powerbuilder' => 'PowerBuilder',
        'proftpd' => 'ProFTPd',
        'progress' => 'Progress',
        'prolog' => 'Prolog',
        'properties' => 'Properties',
        'providex' => 'ProvideX',
        'purebasic' => 'PureBasic',
        'pycon' => 'PyCon',
        'python' => 'Python',
        'pys60' => 'Python for S60',
        'q' => 'q/kdb+',
        'qbasic' => 'QBasic',
        'rsplus' => 'R',
        'rails' => 'Rails',
        'rebol' => 'REBOL',
        'reg' => 'REG',
        'rexx' => 'Rexx',
        'robots' => 'Robots',
        'rpmspec' => 'RPM Spec',
        'ruby' => 'Ruby',
        'gnuplot' => 'Ruby Gnuplot',
        'sas' => 'SAS',
        'scala' => 'Scala',
        'scheme' => 'Scheme',
        'scilab' => 'Scilab',
        'sdlbasic' => 'SdlBasic',
        'smalltalk' => 'Smalltalk',
        'smarty' => 'Smarty',
        'spark' => 'SPARK',
        'sparql' => 'SPARQL',
        'sql' => 'SQL',
        'stonescript' => 'StoneScript',
        'systemverilog' => 'SystemVerilog',
        'tsql' => 'T-SQL',
        'tcl' => 'TCL',
        'teraterm' => 'Tera Term',
        'thinbasic' => 'thinBasic',
        'typoscript' => 'TypoScript',
        'unicon' => 'Unicon',
        'uscript' => 'UnrealScript',
        'ups' => 'UPC',
        'urbi' => 'Urbi',
        'vala' => 'Vala',
        'vbnet' => 'VB.NET',
        'vedit' => 'Vedit',
        'verilog' => 'VeriLog',
        'vhdl' => 'VHDL',
        'vim' => 'VIM',
        'visualprolog' => 'Visual Pro Log',
        'vb' => 'VisualBasic',
        'visualfoxpro' => 'VisualFoxPro',
        'whitespace' => 'WhiteSpace',
        'whois' => 'WHOIS',
        'winbatch' => 'Winbatch',
        'xbasic' => 'XBasic',
        'xml' => 'XML',
        'xorg_conf' => 'Xorg Config',
        'xpp' => 'XPP',
        'yaml' => 'YAML',
        'z80' => 'Z80 Assembler',
        'zxbasic' => 'ZXBasic',
    );

    return $formats{ $format }
        || $self->_set_error('Invalid syntax highlighting code');
}

1;

__END__