File Coverage

blib/lib/WWW/Shorten/SnipURL.pm
Criterion Covered Total %
statement 18 37 48.6
branch 0 14 0.0
condition n/a
subroutine 6 8 75.0
pod 2 2 100.0
total 26 61 42.6


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   1659 use 5.006;
  1         2  
  1         75  
28 1     1   3 use strict;
  1         1  
  1         17  
29 1     1   6 use warnings;
  1         0  
  1         20  
30              
31 1     1   2 use base qw( WWW::Shorten::generic Exporter );
  1         4  
  1         79  
32             our @EXPORT = qw(makeashorterlink makealongerlink);
33             our $VERSION = '1.91';
34              
35 1     1   7 use Carp;
  1         1  
  1         39  
36 1     1   3 use URI;
  1         1  
  1         197  
37              
38             =head1 Functions
39            
40             =head2 makeashorterlink
41            
42             The function C<makeashorterlink> will call the SnipURL web site passing it
43             your long URL and will return the shorter SnipURL version. If used in a
44             list context, then it will return both the Snip URL and the password.
45            
46             =cut
47              
48             sub makeashorterlink ($;%)
49             {
50 0 0   0 1       my $url = shift or croak 'No URL passed to makeashorterlink';
51 0               my $ua = __PACKAGE__->ua();
52 0               my ($nick, $pass) = @_;
53 0               my $snipurl = "http://snipurl.com/site/snip?r=simple&link=$url";
54 0 0             $snipurl .= "&snipnick=$nick" if defined $nick;
55 0 0             $snipurl .= "&snippk=$pass" if defined $pass;
56 0               my $resp = $ua->get($snipurl);
57              
58 0 0             return unless $resp->is_success;
59 0               return $resp->content;
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 Snip URL or just the
66             SnipURL identifier.
67            
68             If anything goes wrong, then either function will return C<undef>.
69            
70             =cut
71              
72             sub makealongerlink ($)
73             {
74 0 0   0 1       my $code = shift
75             or croak 'No SnipURL key / URL passed to makealongerlink';
76 0               my $ua = __PACKAGE__->ua();
77              
78 0               $code =~ s{^ http:// .* / }{}x;
79 0               my $snipurl_url = URI->new('http://snipurl.com/resolveurl');
80 0               $snipurl_url->query_form(
81             id => $code,
82                 );
83              
84 0               my $resp = $ua->get($snipurl_url);
85 0 0             return undef unless $resp->is_success;
86              
87 0               my $content = $resp->content;
88 0 0             return undef if $content eq 'ERROR';
89 0               return $content;
90             }
91              
92             1;
93              
94             __END__
95            
96             =head2 EXPORT
97            
98             makeashorterlink, makealongerlink
99            
100             =head1 SUPPORT, LICENCE, THANKS and SUCH
101            
102             See the main L<WWW::Shorten> docs.
103            
104             =head1 AUTHOR
105            
106             Iain Truskett <spoon@cpan.org>
107            
108             =head1 SEE ALSO
109            
110             L<WWW::Shorten>, L<perl>, L<http://snipurl.com/>
111            
112             =cut
113