File Coverage

blib/lib/WWW/Shorten/0rz.pm
Criterion Covered Total %
statement 39 49 79.5
branch 8 16 50.0
condition n/a
subroutine 10 11 90.9
pod 2 2 100.0
total 59 78 75.6


line stmt bran cond sub pod time code
1             package WWW::Shorten::0rz;
2              
3 3     3   60097 use strict;
  3         4  
  3         68  
4 3     3   8 use warnings;
  3         2  
  3         49  
5 3     3   7 use Carp ();
  3         3  
  3         26  
6 3     3   1449 use Mojo::DOM58 ();
  3         55919  
  3         71  
7 3     3   842 use Try::Tiny qw(try catch);
  3         2789  
  3         122  
8 3     3   1868 use WWW::Mechanize ();
  3         264047  
  3         63  
9              
10 3     3   17 use base qw( WWW::Shorten::generic Exporter );
  3         3  
  3         1156  
11             our @EXPORT = qw( makeashorterlink makealongerlink );
12              
13             our $_error_message = '';
14             our $VERSION = '0.073';
15             $VERSION = eval $VERSION;
16              
17             sub makeashorterlink {
18 2 100   2 1 345 my $url = shift or Carp::croak("No URL passed to makeashorterlink");
19 1         2 $_error_message = '';
20             return try {
21 1     1   24 my $mech = WWW::Mechanize->new;
22 1         9521 $mech->add_header('Accept' => 'text/html');
23 1         10 $mech->get('http://0rz.tw/create');
24 1         2198429 $mech->submit_form(
25             form_id => 'redirect-form',
26             fields => {url => $url,},
27             );
28 1 50       1516536 return undef unless $mech->response->is_success;
29 1         16 my $dom = Mojo::DOM58->new($mech->response->decoded_content);
30 1         10994 return $dom->find('div#doneurl > a')->last->attr('href');
31             }
32             catch {
33 0     0   0 $_error_message = $_;
34 0         0 return undef;
35 1         7 };
36             }
37              
38             sub makealongerlink {
39 3 100   3 1 5825 my $url = shift or Carp::croak('No URL passed to makealongerlink');
40 2         4 $_error_message = '';
41 2         26 my $ua = __PACKAGE__->ua();
42 2 100       342 $url = "http://0rz.tw/$url" unless $url =~ m!^http://!i;
43 2         9 my $resp = $ua->get($url);
44 2 50       1646458 unless ($resp->is_redirect) {
45 0         0 my $content = $resp->content;
46 0 0       0 if ($content =~ /Error/) {
47 0 0       0 if ($content =~ /
    0          
48 0         0 $_error_message = 'Error is a html page';
49             }
50             elsif (length($content) > 100) {
51 0         0 $_error_message = substr($content, 0, 100);
52             }
53             else {
54 0         0 $_error_message = $content;
55             }
56             }
57             else {
58 0         0 $_error_message = 'Unknown error';
59             }
60              
61 0         0 return undef;
62             }
63 2         24 my $long = $resp->header('Location');
64 2         71 return $long;
65             }
66              
67             1;
68              
69             __END__