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 1     1   114917 use warnings;
  1         3  
  1         28  
4 1     1   4 use strict;
  1         2  
  1         36  
5              
6             our $VERSION = '0.003';
7              
8 1     1   4 use base 'WWW::Pastebin::Base::Retrieve';
  1         6  
  1         60  
9 1     1   4 use HTML::TokeParser::Simple;
  1         2  
  1         15  
10 1     1   4 use HTML::Entities;
  1         1  
  1         749  
11              
12             sub _make_uri_and_id {
13 2     2   5643 my ( $self, $id ) = @_;
14              
15 2         8 my ( $private ) = $id =~ m{(?:http://)? (?:www\.)? (.+?) pastebin\.ca};
16              
17 2 50       9 $private = ''
18             unless defined $private;
19              
20 2         33 $id =~ s{ ^ \s+ | (?:http://)? (?:www\.)?.*? pastebin\.ca/ | \s+ $}{}gxi;
21 2         19 return ( URI->new("http://${private}pastebin.ca/$id"), $id );
22             }
23              
24             sub _parse {
25 2     2   608853 my ( $self, $content ) = @_;
26 2 50 33     22 return $self->_set_error( 'Nothing to parse (empty document retrieved)' )
27             unless defined $content and length $content;
28              
29 2         48 my $parser = HTML::TokeParser::Simple->new( \$content );
30              
31 2         424 my %data;
32 2         16 my %nav = (
33             level => 0,
34             get_lang => 0,
35             get_name => 0,
36             get_date => 0,
37             get_desc => 0,
38             );
39 2         12 while ( my $t = $parser->get_token ) {
40 1580 100 100     112171 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 18         235 $nav{level} = 1;
46             }
47             elsif ( $nav{level} == 1 and $t->is_start_tag('dt') ) {
48 2         52 @nav{ qw(level get_name) } = (2, 1);
49             }
50             elsif ( $nav{get_name} == 1 and $t->is_text ) {
51 2         28 $data{name} = $t->as_is;
52 2         16 $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         139 $nav{get_desc} = 1;
58             }
59             elsif ( $nav{get_desc} and $t->is_text ) {
60 2         52 $data{desc} = $t->as_is;
61 2         16 $nav{get_desc} = 0;
62             }
63             elsif ( $nav{level} == 2 and $t->is_start_tag('dd') ) {
64 2         76 $nav{get_date} = 1;
65 2         8 $nav{level}++;
66             }
67             elsif ( $nav{get_date} and $t->is_text ) {
68 2         46 $data{post_date} = $t->as_is;
69 2         38 $data{post_date} =~ s/\s+/ /g;
70 2         10 $data{post_date} =~ s/ //g;
71 2         5 $nav{get_date} = 0;
72 2         8 $nav{level} = 7;
73             }
74             elsif ( $nav{level} == 7 and $t->is_start_tag('span') ) {
75 2         89 $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         157 $nav{get_paste} = 1;
81             }
82             elsif ( $nav{get_paste} and $t->is_text ) {
83 2         64 $data{content} = $t->as_is;
84 2         13 $nav{get_paste} = 0;
85 2         8 $nav{get_lang} = 1;
86             }
87             elsif ( $nav{get_lang} == 1 and $t->is_start_tag('select') ) {
88 2         132 $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         176 $nav{get_lang} = 3;
94             }
95             elsif ( $nav{get_lang} == 3 and $t->is_text ) {
96 2         74 $data{language} = $t->as_is;
97 2         12 $nav{success} = 1;
98 2         5 last;
99             }
100              
101             }
102 2 50       9 unless ( $nav{success} ) {
103 0         0 my $message = "Failed to parse paste.. ";
104 0 0       0 $message .= $nav{level}
105             ? "\$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         44 decode_entities( $_ ) for values %data;
111              
112 2         24 $self->content( $data{content} );
113 2         94 return \%data;
114             }
115              
116             1;
117             __END__