File Coverage

lib/URI/Title/HTML.pm
Criterion Covered Total %
statement 41 57 71.9
branch 13 28 46.4
condition 5 15 33.3
subroutine 7 7 100.0
pod 0 2 0.0
total 66 109 60.5


line stmt bran cond sub pod time code
1             package URI::Title::HTML;
2             $URI::Title::HTML::VERSION = '1.902';
3 2     2   1602 use warnings;
  2         4  
  2         57  
4 2     2   8 use strict;
  2         3  
  2         34  
5 2     2   414 use HTML::Entities;
  2         5995  
  2         135  
6 2     2   13 use utf8;
  2         4  
  2         11  
7              
8             our $CAN_USE_ENCODE;
9             BEGIN {
10 2     2   170 eval { require Encode; Encode->import('decode') };
  2         515  
  2         12404  
11 2         1698 $CAN_USE_ENCODE = !$@;
12             }
13              
14             sub types {(
15 2     2 0 7 'text/html',
16             'default',
17             )}
18              
19             sub title {
20 1     1 0 4 my ($class, $url, $data, $type, $cset) = @_;
21              
22 1         2 my $title;
23             my $special_case;
24              
25 1         2 my $default_match = '(.+?)
26              
27             # special case for the iTMS.
28 1 0 33     5 if ( $INC{'URI/Title/iTMS.pm'} and $url =~ m!phobos.apple.com! and $data =~ m!(itms://[^']*)! ) {
      33        
29 0         0 return URI::Title::iTMS->title($1);
30             }
31              
32             # TODO - work this out from the headers of the HTML
33 1 50       5 if ($data =~ /charset=\"?([\w-]+)/i) {
34 0         0 $cset = lc($1);
35             }
36              
37 1 50       3 if ( $CAN_USE_ENCODE ) {
38 1   33     2 $data = eval { decode('utf-8', $data, 1) } || eval { decode($cset, $data, 1) } || $data;
39             }
40              
41 1         276 my $found_title;
42              
43 1 50       6 if ($url) {
44 1 50 33     14 if ($url =~ /use\.perl\.org\/~([^\/]+).*journal\/\d/i) {
    50          
    50          
    50          
    50          
    50          
    50          
45 0         0 $special_case = '(.+?)<';
46 0         0 $title = "use.perl journal of $1 - ";
47              
48             } elsif ($url =~ /(pants\.heddley\.com|dailychump\.org).*#(.*)$/i) {
49 0         0 my $id = $2;
50 0         0 $special_case = 'id="a'.$id.'.*?>(.+?)<';
51 0         0 $title = "pants daily chump - ";
52              
53             } elsif ($url =~ /paste\.husk\.org/i) {
54 0         0 $special_case = 'Summary: (.+?)<';
55 0         0 $title = "paste - ";
56              
57             } elsif ($url =~ /twitter.com\/(.*?)\/status(es)?\/\d+/i) {
58 0         0 $special_case = '

([^\<]+)';

59 0         0 $title = "twitter - ";
60              
61             } elsif ($url =~ /independent\.co\.uk/i) {
62 0         0 $special_case = '

(.+?)<';

63              
64             } elsif ($url =~ /www\.hs\.fi\/english\/article/i) {
65 0         0 $special_case = '

(.+?)

';
66              
67             } elsif ($url =~ /google.com/i and $data =~ /calc_img/) {
68             # google can be used as a calculator. Try to find the result.
69 0         0 $special_case = 'calc_img.*(.+?)
70              
71              
72             }
73             }
74              
75 1 50 33     16 if (!$found_title and $special_case) {
76 0         0 ($found_title) = $data =~ /$special_case/ims;
77             }
78 1 50       2 if (!$found_title) {
79 1         21 ($found_title) = $data =~ /$default_match/ims;
80             }
81 1 50       3 return unless $found_title;
82              
83 1         4 $found_title =~ s/(.+?)<\/sup>/^$1/g; # for the google math output
84 1         2 $found_title =~ s/<.*?>//g;
85 1         3 $title .= $found_title;
86              
87              
88 1         4 $title =~ s/\s+$//;
89 1         2 $title =~ s/^\s+//;
90 1         2 $title =~ s/\n+//g;
91 1         5 $title =~ s/\s+/ /g;
92              
93             #use Devel::Peek;
94             #Dump( $title );
95              
96 1         8 $title = decode_entities($title);
97              
98             #Dump( $title );
99              
100             # decode nasty number-encoded entities. Mostly works
101 1         3 $title =~ s/(&\#(\d+);?)/chr($2)/eg;
  0         0  
102              
103 1         24 return $title;
104             }
105              
106             1;
107              
108             __END__