File Coverage

blib/lib/WWW/Pastebin/PastebinCa/Retrieve.pm
Criterion Covered Total %
statement 55 58 94.8
branch 29 34 85.2
condition 39 48 81.2
subroutine 7 7 100.0
pod n/a
total 130 147 88.4


line stmt bran cond sub pod time code
1             package WWW::Pastebin::PastebinCa::Retrieve;
2              
3 2     2   252555 use warnings;
  2         3  
  2         52  
4 2     2   6 use strict;
  2         2  
  2         59  
5              
6             our $VERSION = '1.001002'; # VERSION
7              
8 2     2   5 use base 'WWW::Pastebin::Base::Retrieve';
  2         5  
  2         526  
9 2     2   31627 use HTML::TokeParser::Simple;
  2         13272  
  2         43  
10 2     2   9 use HTML::Entities;
  2         3  
  2         1074  
11              
12             sub _make_uri_and_id {
13 2     2   5642 my ( $self, $id ) = @_;
14              
15 2         7 my ( $private ) = $id =~ m{(?:http://)? (?:www\.)? (.+?) pastebin\.ca};
16              
17 2 50       7 $private = ''
18             unless defined $private;
19              
20 2         19 $id =~ s{ ^ \s+ | (?:http://)? (?:www\.)?.*? pastebin\.ca/ | \s+ $}{}gxi;
21 2         14 return ( URI->new("http://${private}pastebin.ca/$id"), $id );
22             }
23              
24             sub _parse {
25 2     2   566230 my ( $self, $content ) = @_;
26 2 50 33     21 return $self->_set_error( 'Nothing to parse (empty document retrieved)' )
27             unless defined $content and length $content;
28              
29 2         59 my $parser = HTML::TokeParser::Simple->new( \$content );
30              
31 2         280 my %data;
32 2         13 my %nav = (
33             level => 0,
34             get_lang => 0,
35             get_name => 0,
36             get_date => 0,
37             get_desc => 0,
38             );
39 2         8 while ( my $t = $parser->get_token ) {
40 1370 100 100     56066 if ( $t->is_start_tag('h2')
    100 66        
    100 100        
    100 66        
    100 66        
    100 100        
    100 66        
    100 100        
    100 66        
    100 100        
    100 66        
    100 100        
    100 100        
      100        
      66        
41             #and defined $t->get_attr('class')
42             #and $t->get_attr('class') eq 'first'
43             ) {
44              
45 22         149 $nav{level} = 1;
46             }
47             elsif ( $nav{level} == 1 and $t->is_start_tag('dt') ) {
48 2         33 @nav{ qw(level get_name) } = (2, 1);
49             }
50             elsif ( $nav{get_name} == 1 and $t->is_text ) {
51 2         18 $data{name} = $t->as_is;
52 2         10 $nav{get_name} = 0;
53             }
54             elsif ( $t->is_start_tag('p') and defined $t->get_attr('id')
55             and $t->get_attr('id') eq 'des'
56             ) {
57 2         88 $nav{get_desc} = 1;
58             }
59             elsif ( $nav{get_desc} and $t->is_text ) {
60 2         34 $data{desc} = $t->as_is;
61 2         11 $nav{get_desc} = 0;
62             }
63             elsif ( $nav{level} == 2 and $t->is_start_tag('dd') ) {
64 2         45 $nav{get_date} = 1;
65 2         6 $nav{level}++;
66             }
67             elsif ( $nav{get_date} and $t->is_text ) {
68 2         27 $data{post_date} = $t->as_is;
69 2         28 $data{post_date} =~ s/\s+/ /g;
70 2         8 $data{post_date} =~ s/ //g;
71 2         4 $nav{get_date} = 0;
72 2         6 $nav{level} = 7;
73             }
74             elsif ( $nav{level} == 7 and $t->is_start_tag('span') ) {
75 2         48 $nav{level}++;
76             }
77             elsif ( $t->is_start_tag('textarea')
78             and defined $t->get_attr('name')
79             and $t->get_attr('name') eq 'content' ) {
80 2         93 $nav{get_paste} = 1;
81             }
82             elsif ( $nav{get_paste} and $t->is_text ) {
83 2         42 $data{content} = $t->as_is;
84 2         6 $nav{get_paste} = 0;
85 2         5 $nav{get_lang} = 1;
86             }
87             elsif ( $nav{get_lang} == 1 and $t->is_start_tag('select') ) {
88 2         75 $nav{get_lang} = 2;
89             }
90             elsif ( $nav{get_lang} == 2 and $t->is_start_tag('option')
91             and $t->get_attr('selected')
92             ) {
93 2         94 $nav{get_lang} = 3;
94             }
95             elsif ( $nav{get_lang} == 3 and $t->is_text ) {
96 2         44 $data{language} = $t->as_is;
97 2         8 $nav{success} = 1;
98 2         4 last;
99             }
100              
101             }
102 2 50       5 unless ( $nav{success} ) {
103 0         0 my $message = "Failed to parse paste.. ";
104             $message .= $nav{level}
105 0 0       0 ? "\$nav{level} == $nav{level}"
106             : "that paste ID doesn't seem to exist";
107 0         0 return $self->_set_error( $message );
108             }
109              
110 2         35 decode_entities( $_ ) for values %data;
111              
112 2         16 $self->content( $data{content} );
113 2         46 return \%data;
114             }
115              
116             1;
117             __END__