File Coverage

blib/lib/WWW/Lipsum.pm

Criterion	Covered	Total	%
statement	49	59	83.0
branch	13	26	50.0
condition	1	6	16.6
subroutine	11	12	91.6
pod	1	1	100.0
total	75	104	72.1

package WWW::Lipsum;

use strict;
use warnings;

our $VERSION = '1.001012'; # VERSION

use Carp qw/croak/;
use LWP::UserAgent;
use Mojo::DOM;
use Moo;
use overload q|""| => sub {
    my $self = shift;
    my $text = $self->generate;
    return $text || '[Error: ' . $self->error . ']';
};

has what   => ( is => 'rw', default => 'paras'  );
has start  => ( is => 'rw', default => 1        );
has amount => ( is => 'rw', default => 5        );
has html   => ( is => 'rw', default => 0        );
has lipsum => ( is => 'rw', build_args => undef );

has error => ( is => 'rw', build_arg => undef );
has _ua    => ( is => 'ro', build_arg => undef, default => sub {
    return LWP::UserAgent->new( timeout => 30,
        agent => 'Mozilla/5.0 (X11; Ubuntu; Linux i686; rv:26.0) '
                    . 'Gecko/20100101 Firefox/26.0'
    );
});

sub generate {
    my $self = shift;
    $self->lipsum(undef);

    $self->_prep_args( @_ );

    # sometimes we fail to get decent Lipsum content,
    # so let's retry once in that case and bail out if we still fail
    my $did_already_retry = 0;
    my ( $res, $dom );
    GET_LIPSUM: {
        $res = $self->_ua->post( 'http://lipsum.com/feed/html', {
            amount => $self->amount,
            what   => $self->what,
            start  => $self->start ? 1 : 0,
            generate => 'Generate Lorem Ipsum',
        });

        return $self->_set_error( 'Network error: ' . $res->status_line )
            unless $res->is_success;

        $dom = eval {
            Mojo::DOM->new( $res->decoded_content )
                ->find('#lipsum')
                ->first
                ->children;
        };
        @$ and return $self->_set_error("Parsing error: $@");
        unless ( $dom ) {
            redo GET_LIPSUM unless $did_already_retry;
            $did_already_retry = 1;

            return $self->_set_error(
                'Unknown error. HTML we got from Lipsum is: '
                    . $res->decoded_content
            );
        }
    }

    $self->html
        or return $self->lipsum(
            join "\n\n", map $_->all_text,
                $dom->grep(sub{ $_->tag eq 'p'})->each
        );

    my $html = join '', $dom->each;

    # a little hackery to get rid of lipsum.com's invalid markup
    $self->what eq 'lists' and $html =~ s{|}{}gi;
    $html =~ s/^\s+|\s+$//g;

    return $self->lipsum( $html );
}

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

sub _prep_args {
    my $self = shift;
    my %args = @_;

    $self->start( $args{start} )
        if exists $args{start};

    $self->html( $args{html} )
        if exists $args{html};

    if ( defined $args{what} ) {
        croak q{Argument 'what' must be one of 'paras', 'words', 'bytes',}
                . q{ or 'lists'}
            unless $args{what} =~ /\A(paras|words|bytes|lists)\z/;

        $self->what( $args{what} );
    }

    if ( defined $args{amount} ) {
        croak q{Argument 'amount' must contain a positive integer}
            unless $args{amount} and $args{amount} =~ /\A\d+\z/;

        $self->amount( $args{amount} );
    }

    return;
}

q|
0 bottles of beer on the wall, 0 bottles of beer! You take one down,
and pass it around, 4294967295 bottles of beer on the wall!
|;

__END__