File Coverage

blib/lib/WWW/Lipsum.pm
Criterion Covered Total %
statement 46 53 86.7
branch 13 24 54.1
condition 1 6 16.6
subroutine 11 12 91.6
pod 1 1 100.0
total 72 96 75.0


line stmt bran cond sub pod time code
1             package WWW::Lipsum;
2              
3 2     2   147538 use strict;
  2         4  
  2         70  
4 2     2   8 use warnings;
  2         2  
  2         70  
5              
6             our $VERSION = '1.001011'; # VERSION
7              
8 2     2   8 use Carp qw/croak/;
  2         3  
  2         101  
9 2     2   620 use LWP::UserAgent;
  2         38131  
  2         42  
10 2     2   525 use Mojo::DOM;
  2         66253  
  2         49  
11 2     2   662 use Moo;
  2         11832  
  2         9  
12             use overload q|""| => sub {
13 6     6   3247 my $self = shift;
14 6         23 my $text = $self->generate;
15 6   33     2201 return $text || '[Error: ' . $self->error . ']';
16 2     2   1627 };
  2         4  
  2         18  
17              
18             has what => ( is => 'rw', default => 'paras' );
19             has start => ( is => 'rw', default => 1 );
20             has amount => ( is => 'rw', default => 5 );
21             has html => ( is => 'rw', default => 0 );
22             has lipsum => ( is => 'rw', build_args => undef );
23              
24             has error => ( is => 'rw', build_arg => undef );
25             has _ua => ( is => 'ro', build_arg => undef, default => sub {
26             return LWP::UserAgent->new( timeout => 30,
27             agent => 'Mozilla/5.0 (X11; Ubuntu; Linux i686; rv:26.0) '
28             . 'Gecko/20100101 Firefox/26.0'
29             );
30             });
31              
32             sub generate {
33 7     7 1 2494 my $self = shift;
34 7         29 $self->lipsum(undef);
35              
36 7         27 $self->_prep_args( @_ );
37 7 100       120 my $res = $self->_ua->post( 'http://lipsum.com/feed/html', {
38             amount => $self->amount,
39             what => $self->what,
40             start => $self->start ? 1 : 0,
41             generate => 'Generate Lorem Ipsum',
42             });
43              
44 7 50       2107203 return $self->_set_error( 'Network error: ' . $res->status_line )
45             unless $res->is_success;
46              
47 7         136 my $dom = eval {
48 7         71 Mojo::DOM->new( $res->decoded_content )
49             ->find('#lipsum')
50             ->first
51             ->children;
52             };
53 7 50       227378 @$ and return $self->_set_error("Parsing error: $@");
54 7 50       26 $dom or return $self->_set_error("Unknown error");
55              
56             $self->html
57             or return $self->lipsum(
58             join "\n\n", map $_->all_text,
59 7 100   11   99 $dom->grep(sub{ $_->tag eq 'p'})->each
  11         293  
60             );
61              
62 2         10 my $html = join '', $dom->each;
63              
64             # a little hackery to get rid of lipsum.com's invalid markup
65 2 100       38560 $self->what eq 'lists' and $html =~ s{

|

}{}gi;
66 2         13208 $html =~ s/^\s+|\s+$//g;
67              
68 2         1518 return $self->lipsum( $html );
69             }
70              
71             sub _set_error {
72 0     0   0 my ( $self, $error ) = @_;
73 0         0 $self->error( $error );
74 0         0 return;
75             }
76              
77             sub _prep_args {
78 7     7   14 my $self = shift;
79 7         18 my %args = @_;
80              
81 7 50       27 $self->start( $args{start} )
82             if exists $args{start};
83              
84 7 50       25 $self->html( $args{html} )
85             if exists $args{html};
86              
87 7 50       26 if ( defined $args{what} ) {
88 0 0       0 croak q{Argument 'what' must be one of 'paras', 'words', 'bytes',}
89             . q{ or 'lists'}
90             unless $args{what} =~ /\A(paras|words|bytes|lists)\z/;
91              
92 0         0 $self->what( $args{what} );
93             }
94              
95 7 50       23 if ( defined $args{amount} ) {
96 0 0 0     0 croak q{Argument 'amount' must contain a positive integer}
97             unless $args{amount} and $args{amount} =~ /\A\d+\z/;
98              
99 0         0 $self->amount( $args{amount} );
100             }
101              
102 7         13 return;
103             }
104              
105             q|
106             0 bottles of beer on the wall, 0 bottles of beer! You take one down,
107             and pass it around, 4294967295 bottles of beer on the wall!
108             |;
109              
110             __END__