File Coverage

blib/lib/WWW/Shorten/SnipURL.pm
Criterion Covered Total %
statement 35 37 94.6
branch 6 12 50.0
condition n/a
subroutine 9 9 100.0
pod 2 2 100.0
total 52 60 86.7


line stmt bran cond sub pod time code
1             # $Id$
2              
3             =head1 NAME
4            
5             WWW::Shorten::SnipURL - Perl interface to SnipURL.com
6            
7             =head1 SYNOPSIS
8            
9             use WWW::Shorten::SnipURL;
10            
11             use WWW::Shorten 'SnipURL';
12            
13             $short_url = makeashorterlink($long_url);
14            
15             $long_url = makealongerlink($short_url);
16            
17             =head1 DESCRIPTION
18            
19             A Perl interface to the web service SnipURL.com. SnipURL maintains a
20             database of long URLs, each of which has a unique identifier or
21             nickname. For more features, please visit http://snipurl.com/features
22            
23             =cut
24              
25             package WWW::Shorten::SnipURL;
26              
27 2     2   131388 use 5.006;
  2         5  
  2         29  
28 2     2   6 use strict;
  2         2  
  2         31  
29 2     2   4 use warnings;
  2         2  
  2         46  
30              
31 2     2   7 use base qw( WWW::Shorten::generic Exporter );
  2         2  
  2         160  
32             our @EXPORT = qw(makeashorterlink makealongerlink);
33             our $VERSION = '2.00';
34              
35 2     2   44445 use Carp;
  2         3  
  2         67  
36 2     2   7 use URI;
  2         4  
  2         31  
37 2     2   375 use HTTP::Request::Common 'POST';
  2         2607  
  2         381  
38              
39             =head1 Functions
40            
41             =head2 makeashorterlink
42            
43             The function C<makeashorterlink> will call the SnipURL web site passing it
44             your long URL and will return the shorter SnipURL version. If used in a
45             list context, then it will return both the Snip URL and the password.
46            
47             =cut
48              
49             sub makeashorterlink {
50 1 50   1 1 100206   my $url = shift or croak 'No URL passed to makeashorterlink';
51 1         7   my $ua = __PACKAGE__->ua();
52              
53 1         1622   my $snipurl = 'http://snipurl.com/site/index';
54              
55 1         10   my $req = POST $snipurl,
56                 [
57                  url => $url,
58                 ];
59              
60 1         6483   my $resp = $ua->request($req);
61              
62 1 50       825607   return unless $resp->is_success;
63              
64 1 0       47   if ($resp->content =~ m|<input class="snipped textsnipped" type="text" value="(http://snipurl.com/\w+)"|) {
65 0         0     return $1;
66               }
67              
68 1         396   return;
69             }
70              
71             =head2 makealongerlink
72            
73             The function C<makealongerlink> does the reverse. C<makealongerlink>
74             will accept as an argument either the full Snip URL or just the
75             SnipURL identifier.
76            
77             If anything goes wrong, then either function will return C<undef>.
78            
79             =cut
80              
81             sub makealongerlink {
82 2 100   2 1 3194   my $code = shift
83                 or croak 'No SnipURL key / URL passed to makealongerlink';
84 1         33   my $ua = __PACKAGE__->ua();
85              
86 1 50       37   unless ($code =~ m|^http://|) {
87 0         0     $code = "http://snipurl.com/$code";
88               }
89              
90 1         17   my $resp = $ua->get($code);
91 1 50       337082   return unless $resp->is_redirect;
92              
93 1         16   return $resp->header('Location');
94             }
95              
96             1;
97              
98             __END__
99            
100             =head2 EXPORT
101            
102             makeashorterlink, makealongerlink
103            
104             =head1 SUPPORT, LICENCE, THANKS and SUCH
105            
106             See the main L<WWW::Shorten> docs.
107            
108             =head1 AUTHOR
109            
110             Dave Cross <dave@mag-sol.com>
111            
112             Original author Shashank Tripathi <shank@shank.com>.
113            
114             =head1 SEE ALSO
115            
116             L<WWW::Shorten>, L<perl>, L<http://snipurl.com/>
117            
118             =cut
119