File Coverage

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

Criterion	Covered	Total	%
statement	44	47	93.6
branch	13	20	65.0
condition	9	13	69.2
subroutine	9	10	90.0
pod	1	1	100.0
total	76	91	83.5

package WWW::Pastebin::PastebinCom::Create;

use Moo;
use WWW::Mechanize;
our $VERSION = '1.003';

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

has error => ( is => 'rw', build_arg => undef, );
has paste_uri => ( is => 'rw', build_arg => undef, );
has _mech => (
    is => 'ro',
    build_arg => undef,
    default => sub {
        my $mech = WWW::Mechanize->new(
            timeout     => 30,
            autocheck   => 0,
        );
        $mech->agent_alias('Linux Mozilla');
        return $mech;
    },
);

sub paste {
    my ( $self, %args ) = @_;

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

    %args = __process_args( %args );
    defined $args{text}
        and length $args{text}
            or return $self->_set_error('Paste text is empty');

    my $mech = $self->_mech;
    $mech->get('http://pastebin.com');
    $mech->success or return $self->_set_mech_error;

    $mech->form_name('myform')
        or return $self->_set_error('Paste form not found');

    $mech->set_fields(
        paste_code          => $args{text},
        paste_format        => $args{format},
        paste_expire_date   => $args{expiry},
        paste_private       => $args{private},
        paste_name          => $args{desc},
    );
    $mech->submit;
    $mech->success or return $self->_set_mech_error;

    my $uri = '' . $mech->uri;
    $uri =~ m{/index\.php}
        and return $self->_set_error(q{Didn't get a valid paste URI});

    $uri =~ m{/warning\.php}
        and return $self->_set_error(q{Reached the paste limit. See } .
            $uri . q{ for details.}
        );

    return $self->paste_uri( $uri );
}

sub __process_args {
    my %args = @_;

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

    $args{desc} = substr($args{desc}, 0, 57) . '...'
        if defined $args{desc}
            and length $args{desc} > 60;

    my $valid_formats = __get_valid_formats();
    $args{format} = $valid_formats->{ lc($args{format} || '') };
    $args{format} = $valid_formats->{none}
        unless defined $args{format};

    my $valid_expiry = __get_valid_expiry();
    $args{expiry} = $valid_expiry->{ lc($args{expiry} || '') };
    $args{expiry} = $valid_expiry->{m}
        unless defined $args{expiry};

    $args{private} = 1
        unless defined $args{private}
            and $args{private} eq '0';

    return %args;
}

sub _set_mech_error {
    my ( $self, $mech ) = @_;
    $self->error(
        'Network error: ' . $mech->res->code . ' ' . $mech->res->status_line
    );
    return;
}

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

sub __get_valid_expiry {
    return {
        # 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',
        m       => '1M',
        m1      => '1M',
        eventually      => '1M',

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

sub __get_valid_formats {
    my %formats = (
                   'None' => '1',
                   'Bash' => '8',
                      'C' => '9',
                     'C#' => '14',
                    'C++' => '13',
                    'CSS' => '16',
                   'HTML' => '25',
                 'HTML 5' => '196',
                   'Java' => '27',
             'JavaScript' => '28',
                    'Lua' => '30',
                   'None' => '1',
            'Objective C' => '35',
                   'Perl' => '40',
                    'PHP' => '41',
                 'Python' => '42',
                  'Rails' => '67',
                    '4CS' => '142',
'6502 ACME Cross Assembler' => '143',
    '6502 Kick Assembler' => '144',
       '6502 TASM/64TASS' => '145',
                   'ABAP' => '73',
           'ActionScript' => '2',
         'ActionScript 3' => '74',
                    'Ada' => '3',
               'ALGOL 68' => '147',
             'Apache Log' => '4',
            'AppleScript' => '5',
            'APT Sources' => '75',
                    'ARM' => '217',
             'ASM (NASM)' => '6',
                    'ASP' => '7',
              'Asymptote' => '218',
               'autoconf' => '148',
             'Autohotkey' => '149',
                 'AutoIt' => '54',
               'Avisynth' => '76',
                    'Awk' => '150',
             'BASCOM AVR' => '198',
                   'Bash' => '8',
               'Basic4GL' => '77',
                 'BibTeX' => '78',
            'Blitz Basic' => '55',
                    'BNF' => '56',
                    'BOO' => '80',
              'BrainFuck' => '79',
                      'C' => '9',
             'C for Macs' => '10',
'C Intermediate Language' => '82',
                     'C#' => '14',
                    'C++' => '13',
'C++ (with QT extensions)' => '154',
          'C: Loadrunner' => '199',
                'CAD DCL' => '11',
               'CAD Lisp' => '12',
                   'CFDG' => '81',
             'ChaiScript' => '152',
                'Clojure' => '153',
                'Clone C' => '99',
              'Clone C++' => '100',
                  'CMake' => '83',
                  'COBOL' => '84',
           'CoffeeScript' => '200',
             'ColdFusion' => '15',
                    'CSS' => '16',
               'Cuesheet' => '151',
                      'D' => '17',
                    'DCL' => '219',
                'DCPU-16' => '220',
                    'DCS' => '85',
                 'Delphi' => '18',
 'Delphi Prism (Oxygene)' => '177',
                   'Diff' => '19',
                    'DIV' => '86',
                    'DOS' => '20',
                    'DOT' => '87',
                      'E' => '155',
             'ECMAScript' => '156',
                 'Eiffel' => '21',
                  'Email' => '88',
                    'EPC' => '201',
                 'Erlang' => '57',
                     'F#' => '158',
                 'Falcon' => '202',
            'FO Language' => '89',
            'Formula One' => '157',
                'Fortran' => '22',
              'FreeBasic' => '23',
             'FreeSWITCH' => '206',
                 'GAMBAS' => '159',
             'Game Maker' => '24',
                    'GDB' => '160',
                 'Genero' => '58',
                  'Genie' => '161',
                'GetText' => '90',
                     'Go' => '162',
                 'Groovy' => '59',
                'GwBasic' => '163',
                'Haskell' => '60',
                   'Haxe' => '221',
                 'HicEst' => '164',
               'HQ9 Plus' => '93',
                   'HTML' => '25',
                 'HTML 5' => '196',
                   'Icon' => '165',
                    'IDL' => '94',
               'INI file' => '26',
            'Inno Script' => '61',
               'INTERCAL' => '95',
                     'IO' => '96',
                      'J' => '166',
                   'Java' => '27',
                 'Java 5' => '97',
             'JavaScript' => '28',
                 'jQuery' => '167',
    );

    $formats{+lc} = delete $formats{$_} for keys %formats;

    return \%formats;
}

q|
Q: Whats the object-oriented way to become wealthy?

A: Inheritance
|;

__END__