File Coverage

blib/lib/WWW/Shorten/Qurl.pm
Criterion Covered Total %
statement 31 32 96.9
branch 10 14 71.4
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 50 55 90.9


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