File Coverage

blib/lib/WWW/Shorten/SnipURL.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


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 1     1   28981 use 5.006;
  1         3  
  1         43  
28 1     1   6 use strict;
  1         2  
  1         42  
29 1     1   6 use warnings;
  1         2  
  1         41  
30              
31 1     1   6 use base qw( WWW::Shorten::generic Exporter );
  1         3  
  1         1224  
32             our @EXPORT = qw(makeashorterlink makealongerlink);
33             our $VERSION = '2.00';
34              
35             use Carp;
36             use URI;
37             use HTTP::Request::Common 'POST';
38              
39             =head1 Functions
40              
41             =head2 makeashorterlink
42              
43             The function C 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             my $url = shift or croak 'No URL passed to makeashorterlink';
51             my $ua = __PACKAGE__->ua();
52              
53             my $snipurl = 'http://snipurl.com/site/index';
54              
55             my $req = POST $snipurl,
56             [
57             url => $url,
58             ];
59              
60             my $resp = $ua->request($req);
61              
62             return unless $resp->is_success;
63              
64             if ($resp->content =~ m|
65             return $1;
66             }
67              
68             return;
69             }
70              
71             =head2 makealongerlink
72              
73             The function C does the reverse. C
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.
78              
79             =cut
80              
81             sub makealongerlink {
82             my $code = shift
83             or croak 'No SnipURL key / URL passed to makealongerlink';
84             my $ua = __PACKAGE__->ua();
85              
86             unless ($code =~ m|^http://|) {
87             $code = "http://snipurl.com/$code";
88             }
89              
90             my $resp = $ua->get($code);
91             return unless $resp->is_redirect;
92              
93             return $resp->header('Location');
94             }
95              
96             1;
97              
98             __END__