File Coverage

lib/URI/Title/HTML.pm
Criterion Covered Total %
statement 42 58 72.4
branch 14 30 46.6
condition 5 15 33.3
subroutine 7 7 100.0
pod 0 2 0.0
total 68 112 60.7


line stmt bran cond sub pod time code
1             package URI::Title::HTML;
2             $URI::Title::HTML::VERSION = '1.901';
3 2     2   2390 use warnings;
  2         3  
  2         60  
4 2     2   6 use strict;
  2         3  
  2         32  
5 2     2   481 use HTML::Entities;
  2         4696  
  2         164  
6 2     2   14 use utf8;
  2         2  
  2         12  
7              
8             our $CAN_USE_ENCODE;
9             BEGIN {
10 2     2   119 eval { require Encode; Encode->import('decode') };
  2         559  
  2         7436  
11 2         1144 $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 3 my ($class, $url, $data, $type, $cset) = @_;
21              
22 1         1 my $title;
23             my $special_case;
24              
25 1         1 my $default_match = '(.+?)
26              
27             # special case for the iTMS.
28 1 0 33     4 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       21 if ($data =~ /charset=\"?([\w-]+)/i) {
34 1         5 $cset = lc($1);
35             }
36              
37 1 50       3 if ( $CAN_USE_ENCODE ) {
38 1   33     1 $data = eval { decode('utf-8', $data, 1) } || eval { decode($cset, $data, 1) } || $data;
39             }
40              
41 1         33 my $found_title;
42              
43 1 50       2 if ($url) {
44 1 50 33     17 if ($url =~ /use\.perl\.org\/~([^\/]+).*journal\/\d/i) {
    50          
    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             } elsif ($url =~ /spotify\.url\.fi/) {
72 0         0 $special_case = '\s*(.+?)\s+—\s+Decode\s+Spotify\s+URIs\s*';
73              
74             }
75             }
76              
77 1 50 33     4 if (!$found_title and $special_case) {
78 0         0 ($found_title) = $data =~ /$special_case/ims;
79             }
80 1 50       2 if (!$found_title) {
81 1         22 ($found_title) = $data =~ /$default_match/ims;
82             }
83 1 50       7 return unless $found_title;
84              
85 1         4 $found_title =~ s/(.+?)<\/sup>/^$1/g; # for the google math output
86 1         3 $found_title =~ s/<.*?>//g;
87 1         2 $title .= $found_title;
88              
89              
90 1         7 $title =~ s/\s+$//;
91 1         2 $title =~ s/^\s+//;
92 1         2 $title =~ s/\n+//g;
93 1         7 $title =~ s/\s+/ /g;
94              
95             #use Devel::Peek;
96             #Dump( $title );
97              
98 1         7 $title = decode_entities($title);
99              
100             #Dump( $title );
101              
102             # decode nasty number-encoded entities. Mostly works
103 1         2 $title =~ s/(&\#(\d+);?)/chr($2)/eg;
  0         0  
104              
105 1         8 return $title;
106             }
107              
108             1;
109              
110             __END__