/perl/site/lib/WWW/Pastebin/PastebinCom/Create.pm
Perl | 532 lines | 481 code | 50 blank | 1 comment | 8 complexity | e38fdd347f89055f531af5eae2980b0c MD5 | raw file
Possible License(s): LGPL-3.0, Unlicense, GPL-2.0, LGPL-2.0, BSD-3-Clause, LGPL-2.1, AGPL-1.0, GPL-3.0
- package WWW::Pastebin::PastebinCom::Create;
- use warnings;
- use strict;
- our $VERSION = '0.004';
- use Carp;
- use URI;
- use LWP::UserAgent;
- use overload q|""| => sub { shift->paste_uri };
- sub new {
- my $class = shift;
- croak "Must have even number of arguments to the constructor"
- if @_ & 1;
- my %args = @_;
-
- unless ( $args{timeout} ) {
- $args{timeout} = 30;
- }
- unless ( $args{ua} ) {
- $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',
- );
- }
- return bless \%args, $class;
- }
- sub paste {
- my $self = shift;
- croak "Must have even number of arguments to paste() method"
- if @_ & 1;
- my %args = @_;
- $args{ +lc } = delete $args{ $_ } for keys %args;
- unless ( defined $args{text} ) {
- $self->error( 'Missing or undefined `text` argument' );
- return;
- }
- # handle uri (deprecated argument)
- if ( exists $args{uri} )
- {
- ($args{subdomain} ) = $args{uri} =~ m{http://(.+)\.pastebin\.com}
- or croak( "can't parse URI parameter: $args{uri}\n" );
- delete $args{uri};
- }
- $self->paste_uri( undef );
- $self->error( undef );
- %args = (
- format => 'text',
- expiry => 'd',
- poster => '',
- email => '',
- %args,
- );
- my $valid_formats = $self->get_valid_formats;
- unless ( exists $valid_formats->{ $args{format} } ) {
- croak "Invalid syntax-highlight format was specified\n"
- . "Use ->get_valid_formats() method to get full list"
- . " of valid values";
- }
- # map onto expiration
- my %expire = ( f => 'n',
- d => '1d',
- m => '1m' );
- croak "Invalid `expiry` argument. Must be either 'f', 'd' or 'm'"
- if !exists $expire{$args{expiry}};
- $args{expiry} = $expire{ $args{expiry} };
- # map onto API parameters
- my %API = (
- poster => 'paste_name',
- text => 'paste_code',
- email => 'paste_email',
- subdomain => 'paste_subdomain',
- private => 'paste_private',
- expiry => 'paste_expire_date',
- format => 'paste_format',
- );
- $args{$API{$_}} = delete $args{$_}
- foreach grep { defined $API{$_}} keys %args;
- my $uri = URI->new( 'http://pastebin.com/api_public.php' );
- my $response = $self->{ua}->post( $uri, \%args );
- if ( $response->is_success or $response->is_redirect ) {
- return $self->paste_uri( $response->content );
- }
- else {
- $self->error( $response->status_line );
- return;
- }
- }
- sub error {
- my $self = shift;
- if ( @_ ) {
- $self->{ ERROR } = shift;
- }
- return $self->{ ERROR };
- }
- sub paste_uri {
- my $self = shift;
- if ( @_ ) {
- $self->{ PASTE_URI } = shift;
- }
- return $self->{ PASTE_URI };
- }
- sub get_valid_formats {
- return {
- abap => 'ABAP',
- actionscript => 'ActionScript',
- actionscript3 => 'ActionScript 3',
- ada => 'Ada',
- apache => 'Apache Log',
- applescript => 'AppleScript',
- apt_sources => 'APT Sources',
- asm => 'ASM (NASM)',
- asp => 'ASP',
- autoit => 'AutoIt',
- avisynth => 'Avisynth',
- bash => 'Bash',
- basic4gl => 'Basic4GL',
- bibtex => 'BibTeX',
- blitzbasic => 'Blitz Basic',
- bnf => 'BNF',
- boo => 'BOO',
- bf => 'BrainFuck',
- c => 'C',
- c_mac => 'C for Macs',
- cill => 'C Intermediate Language',
- csharp => 'C#',
- cpp => 'C++',
- caddcl => 'CAD DCL',
- cadlisp => 'CAD Lisp',
- cfdg => 'CFDG',
- klonec => 'Clone C',
- klonecpp => 'Clone C++',
- cmake => 'CMake',
- cobol => 'COBOL',
- cfm => 'ColdFusion',
- css => 'CSS',
- d => 'D',
- dcs => 'DCS',
- delphi => 'Delphi',
- dff => 'Diff',
- div => 'DIV',
- dos => 'DOS',
- dot => 'DOT',
- eiffel => 'Eiffel',
- email => 'Email',
- erlang => 'Erlang',
- fo => 'FO Language',
- fortran => 'Fortran',
- freebasic => 'FreeBasic',
- gml => 'Game Maker',
- genero => 'Genero',
- gettext => 'GetText',
- groovy => 'Groovy',
- haskell => 'Haskell',
- hq9plus => 'HQ9 Plus',
- html4strict => 'HTML',
- idl => 'IDL',
- ini => 'INI file',
- inno => 'Inno Script',
- intercal => 'INTERCAL',
- io => 'IO',
- java => 'Java',
- java5 => 'Java 5',
- javascript => 'JavaScript',
- kixtart => 'KiXtart',
- latex => 'Latex',
- lsl2 => 'Linden Scripting',
- lisp => 'Lisp',
- locobasic => 'Loco Basic',
- lolcode => 'LOL Code',
- lotusformulas => 'Lotus Formulas',
- lotusscript => 'Lotus Script',
- lscript => 'LScript',
- lua => 'Lua',
- m68k => 'M68000 Assembler',
- make => 'Make',
- matlab => 'MatLab',
- matlab => 'MatLab',
- mirc => 'mIRC',
- modula3 => 'Modula 3',
- mpasm => 'MPASM',
- mxml => 'MXML',
- mysql => 'MySQL',
- text => 'None',
- nsis => 'NullSoft Installer',
- oberon2 => 'Oberon 2',
- objc => 'Objective C',
- 'ocaml-brief' => 'OCalm Brief',
- ocaml => 'OCaml',
- glsl => 'OpenGL Shading',
- oobas => 'Openoffice BASIC',
- oracle11 => 'Oracle 11',
- oracle8 => 'Oracle 8',
- pascal => 'Pascal',
- pawn => 'PAWN',
- per => 'Per',
- perl => 'Perl',
- php => 'PHP',
- 'php-brief' => 'PHP Brief',
- pic16 => 'Pic 16',
- pixelbender => 'Pixel Bender',
- plsql => 'PL/SQL',
- povray => 'POV-Ray',
- powershell => 'Power Shell',
- progress => 'Progress',
- prolog => 'Prolog',
- properties => 'Properties',
- providex => 'ProvideX',
- python => 'Python',
- qbasic => 'QBasic',
- rails => 'Rails',
- rebol => 'REBOL',
- reg => 'REG',
- robots => 'Robots',
- ruby => 'Ruby',
- gnuplot => 'Ruby Gnuplot',
- sas => 'SAS',
- scala => 'Scala',
- scheme => 'Scheme',
- scilab => 'Scilab',
- sdlbasic => 'SdlBasic',
- smalltalk => 'Smalltalk',
- smarty => 'Smarty',
- sql => 'SQL',
- tsql => 'T-SQL',
- tcl => 'TCL',
- tcl => 'TCL',
- teraterm => 'Tera Term',
- thinbasic => 'thinBasic',
- typoscript => 'TypoScript',
- unreal => 'unrealScript',
- vbnet => 'VB.NET',
- verilog => 'VeriLog',
- vhdl => 'VHDL',
- vim => 'VIM',
- visualprolog => 'Visual Pro Log',
- vb => 'VisualBasic',
- visualfoxpro => 'VisualFoxPro',
- whitespace => 'WhiteSpace',
- whois => 'WHOIS',
- winbatch => 'Win Batch',
- xml => 'XML',
- xorg_conf => 'Xorg Config',
- xpp => 'XPP',
- z80 => 'Z80 Assembler',
- };
- }
- 1;
- __END__
- =head1 NAME
- WWW::Pastebin::PastebinCom::Create - paste to L<http://pastebin.com> from Perl.
- =head1 SYNOPSIS
- use strict;
- use warnings;
- use WWW::Pastebin::PastebinCom::Create;
- my $paste = WWW::Pastebin::PastebinCom::Create->new;
- $paste->paste( text => 'lots and lost of text to paste' )
- or die "Error: " . $paste->error;
- print "Your paste can be found on $paste\n";
- =head1 DESCRIPTION
- The module provides means of pasting large texts into
- L<http://pastebin.com> pastebin site.
- =head1 CONSTRUCTOR
- =head2 new
- my $paste = WWW::Pastebin::PastebinCom::Create->new;
- my $paste = WWW::Pastebin::PastebinCom::Create->new(
- timeout => 10,
- );
- my $paste = WWW::Pastebin::PastebinCom::Create->new(
- ua => LWP::UserAgent->new(
- timeout => 10,
- agent => 'PasterUA',
- ),
- );
- Constructs and returns a brand new yummy juicy WWW::Pastebin::PastebinCom::Create
- object. Takes two arguments, both are I<optional>. Possible arguments are
- as follows:
- =head3 timeout
- ->new( timeout => 10 );
- B<Optional>. Specifies the C<timeout> argument of L<LWP::UserAgent>'s
- constructor, which is used for pasting. B<Defaults to:> C<30> seconds.
- =head3 ua
- ->new( ua => LWP::UserAgent->new( agent => 'Foos!' ) );
- B<Optional>. If the C<timeout> argument is not enough for your needs
- of mutilating the L<LWP::UserAgent> object used for pasting, feel free
- to specify the C<ua> argument which takes an L<LWP::UserAgent> object
- as a value. B<Note:> the C<timeout> argument to the constructor will
- not do anything if you specify the C<ua> argument as well. B<Defaults to:>
- plain boring default L<LWP::UserAgent> object with C<timeout> argument
- set to whatever C<WWW::Pastebin::PastebinCom::Create>'s C<timeout> argument is
- set to as well as C<agent> argument is set to mimic Firefox.
- =head1 METHODS
- =head2 paste
- $paste->paste( text => 'long long text' )
- or die "Failed to paste: " . $paste->error;
- my $paste_uri = $paste->paste(
- text => 'long long text',
- format => 'perl',
- poster => 'Zoffix',
- expiry => 'm',
- subdomain => 'subdomain',
- private => 0,
- ) or die "Failed to paste: " . $paste->error;
- Instructs the object to pastebin some text. If pasting succeeded returns
- a URI pointing to your paste, otherwise returns either C<undef> or
- an empty list (depending on the context) and the reason for the failure
- will be avalable via C<error()> method (see below).
- Note: you don't have to store the return value. There is a C<paste_uri()>
- method as well as overloaded construct; see C<paste_uri()> method's
- description below.
- Takes one mandatory and
- three optional arguments which are as follows:
- =head3 text
- ->paste( text => 'long long long long text to paste' );
- B<Mandatory>. The C<text> argument must contain the text to paste. If
- C<text>'s value is undefined the C<paste()> method will return either
- C<undef> or an empty list (depending on the context) and the C<error()>
- method will contain a message about undefined C<text>.
- =head3 format
- ->paste( text => 'foo', format => 'perl' );
- B<Optional>. Specifies the format of the paste to enable specific syntax
- highlights on L<http://pastebin.com>. The list of possible values is
- very long, see C<get_valid_formats()> method below for information
- on how to obtain possible valid values for the C<format> argument.
- B<Defaults to:> C<text> (plain text paste).
- =head3 poster
- ->paste( text => 'foo', poster => 'Zoffix Znet' );
- B<Optional>. Specifies the name of the person pasting the text.
- B<Defaults to:> empty string, which leads to C<Anonymous> apearing on
- L<http://pastebin.com>
- =head3 expiry
- ->paste( text => 'foo', expiry => 'f' );
- B<Optional>. Specifies when the paste should expire.
- B<Defaults to:> C<d> (expire the paste in one day). Takes three possible
- values:
- =over 5
- =item d
- When C<expiry> is set to value C<d>, the paste will expire in one day.
- =item m
- When C<expiry> is set to value C<m>, the paste will expire in one month.
- =item f
- When C<expiry> is set to value C<f>, the paste will (should) stick around
- "forever".
- =back
- =head3 C<subdomain>
- subdomain => 'private_domain'
- B<Optional>. Allows one to paste into a so called "private" pastebin with a personal domain name. Takes the domain name.
- =head3 C<uri>
- uri => 'http://private_domain.pastebin.com/'
- B<DEPRECATED>. use C<subdomain>.
- =head2 error
- $paste->paste( text => 'foos' )
- or die "Error: " . $paste->error;
- If the C<paste()> method failed to paste your text for any reason
- (including your text being undefined) it will return either C<undef>
- or an empty list depending on the context. When that happens you will
- be able to find out the reason of the error via C<error()> method.
- Returns a scalar containing human readable message describing the error.
- Takes no arguments.
- =head2 paste_uri (and overloads)
- print "You can find your pasted text on " . $paste->paste_uri . "\n";
- # or by interpolating the WWW::Pastebin::PastebinCom::Create object directly:
- print "You can find your pasted text on $paste\n";
- Takes no arguments. Returns a URI pointing to the L<http://pastebin.com>
- page containing the text you have pasted. If you call this method before
- pasting anything or if C<paste()> method failed the C<paste_uri> will
- return either C<undef> or an empty list depending on the context.
- B<Note:> the WWW::Pastebin::PastebinCom::Create object is overloaded so instead
- of calling C<paste_uri> method you could simply interpolate the
- WWW::Pastebin::PastebinCom::Create object. For example:
- my $paster = WWW::Pastebin::PastebinCom::Create->new;
- $paster->paste( text => 'long text' )
- or die "Failed to paste: " . $paster->error;
-
- print "Your paste is located on $paster\n";
- =head2 get_valid_formats
- my $valid_formats_hashref = $paste->get_valid_formats;
- Takes no arguments. Returns a hashref, keys of which will be valid
- values of the C<format> argument to C<paste()> method and values of which
- will be explanation of semi-cryptic codes.
- =head1 AUTHOR
- Zoffix Znet, C<< <zoffix at cpan.org> >>
- (L<http://zoffix.com>, L<http://haslayout.net>, L<http://mind-power-book.com/>)
- Patches by Diab Jerius (DJERIUS)
- =head1 BUGS
- Please report any bugs or feature requests to C<bug-www-pastebin-pastebincom-create at rt.cpan.org>, or through
- the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WWW-Pastebin-PastebinCom-Create>. I will be notified, and then you'll
- automatically be notified of progress on your bug as I make changes.
- =head1 SUPPORT
- You can find documentation for this module with the perldoc command.
- perldoc WWW::Pastebin::PastebinCom::Create
- You can also look for information at:
- =over 4
- =item * RT: CPAN's request tracker
- L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=WWW-Pastebin-PastebinCom-Create>
- =item * AnnoCPAN: Annotated CPAN documentation
- L<http://annocpan.org/dist/WWW-Pastebin-PastebinCom-Create>
- =item * CPAN Ratings
- L<http://cpanratings.perl.org/d/WWW-Pastebin-PastebinCom-Create>
- =item * Search CPAN
- L<http://search.cpan.org/dist/WWW-Pastebin-PastebinCom-Create>
- =back
- =head1 COPYRIGHT & LICENSE
- 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.
- =cut