File Coverage

blib/lib/WWW/Shorten/TinyURL.pm
Criterion Covered Total %
statement 31 32 96.9
branch 9 14 64.3
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 49 55 89.1


line stmt bran cond sub pod time code
1             # $Id$
2              
3             =head1 NAME
4            
5             WWW::Shorten::TinyURL - Perl interface to tinyurl.com
6            
7             =head1 SYNOPSIS
8            
9             use WWW::Shorten::TinyURL;
10             use WWW::Shorten 'TinyURL';
11            
12             $short_url = makeashorterlink($long_url);
13            
14             $long_url = makealongerlink($short_url);
15            
16             =head1 DESCRIPTION
17            
18             A Perl interface to the web site tinyurl.com. TinyURL simply maintains
19             a database of long URLs, each of which has a unique identifier.
20            
21             =cut
22              
23             package WWW::Shorten::TinyURL;
24              
25 2     2   27277 use 5.006;
  2         6  
  2         29  
26 2     2   5 use strict;
  2         2  
  2         34  
27 2     2   5 use warnings;
  2         2  
  2         45  
28              
29 2     2   9 use base qw( WWW::Shorten::generic Exporter );
  2         3  
  2         191  
30             our @EXPORT = qw( makeashorterlink makealongerlink );
31             our $VERSION = '1.90';
32              
33 2     2   8 use Carp;
  2         2  
  2         387  
34              
35             =head1 Functions
36            
37             =head2 makeashorterlink
38            
39             The function C<makeashorterlink> will call the TinyURL web site passing
40             it your long URL and will return the shorter TinyURL version.
41            
42             =cut
43              
44             sub makeashorterlink ($)
45             {
46 3 100   3 1 104819     my $url = shift or croak 'No URL passed to makeashorterlink';
47 2         32     my $ua = __PACKAGE__->ua();
48 2         6     my $tinyurl = 'http://tinyurl.com/api-create.php';
49 2         23     my $resp = $ua->post($tinyurl, [
50             url => $url,
51             source => "PerlAPI-$VERSION",
52             ]);
53 2 50       825941     return undef unless $resp->is_success;
54 2         77     my $content = $resp->content;
55 2 50       62     return undef if $content =~ /Error/;
56 2 0       24     if ($resp->content =~ m!(\Qhttp://tinyurl.com/\E\w+)!x) {
57 2         385 return $1;
58                 }
59 0         0     return;
60             }
61              
62             =head2 makealongerlink
63            
64             The function C<makealongerlink> does the reverse. C<makealongerlink>
65             will accept as an argument either the full TinyURL URL or just the
66             TinyURL identifier.
67            
68             If anything goes wrong, then either function will return C<undef>.
69            
70             =cut
71              
72             sub makealongerlink ($)
73             {
74 3 100   3 1 895     my $tinyurl_url = shift
75             or croak 'No TinyURL key / URL passed to makealongerlink';
76 2         42     my $ua = __PACKAGE__->ua();
77              
78 2 100       19     $tinyurl_url = "http://tinyurl.com/$tinyurl_url"
79                 unless $tinyurl_url =~ m!^http://!i;
80              
81 2         29     my $resp = $ua->get($tinyurl_url);
82              
83 2 50       819716     return undef unless $resp->is_redirect;
84 2         52     my $url = $resp->header('Location');
85 2         115     return $url;
86              
87             }
88              
89             1;
90              
91             __END__
92            
93             =head2 EXPORT
94            
95             makeashorterlink, makealongerlink
96            
97             =head1 SUPPORT, LICENCE, THANKS and SUCH
98            
99             See the main L<WWW::Shorten> docs.
100            
101             =head1 AUTHOR
102            
103             Iain Truskett <spoon@cpan.org>
104            
105             =head1 SEE ALSO
106            
107             L<WWW::Shorten>, L<perl>, L<http://tinyurl.com/>
108            
109             =cut
110