File Coverage

blib/lib/WWW/Shorten/0rz.pm
Criterion Covered Total %
statement 21 49 42.8
branch 0 16 0.0
condition n/a
subroutine 7 11 63.6
pod 2 2 100.0
total 30 78 38.4


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