File Coverage

blib/lib/WWW/Shorten/Smallr.pm
Criterion Covered Total %
statement 17 21 80.9
branch 1 6 16.6
condition n/a
subroutine 5 5 100.0
pod 1 1 100.0
total 24 33 72.7


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             WWW::Shorten::Smallr - Perl interface to Smallr.com
4              
5             =head1 SYNOPSIS
6              
7             use WWW::Shorten::Smallr;
8              
9             use WWW::Shorten 'Smallr';
10              
11             my $short_url = makeashorterlink($long_url);
12              
13             =head1 DESCRIPTION
14              
15             A Perl interface to the web site Smallr.com. Smallr maintains a
16             database of long URLs, each of which has a unique identifier.
17              
18             =cut
19              
20             package WWW::Shorten::Smallr;
21 3     3   117832 use strict;
  3         6  
  3         116  
22 3     3   19 use warnings;
  3         6  
  3         96  
23 3     3   27 use Carp;
  3         6  
  3         242  
24              
25 3     3   23 use base qw( WWW::Shorten::generic Exporter );
  3         6  
  3         2250  
26              
27             our @EXPORT = qw(makeashorterlink);
28             our $VERSION = '0.01';
29              
30             =head1 Functions
31              
32             =head2 makeashorterlink
33              
34             The function C will call the Smallr.com web site,
35             pass it your long URL, and return the shortened version.
36              
37             =cut
38              
39             sub makeashorterlink ($)
40             {
41 1     1 1 10 my $smallr = 'http://smallr.com/url/make';
42 1         2 my $base_url = 'http://smallr.com/';
43 1 50       5 my $url = shift or croak 'No URL passed to makeashorterlink';
44 1         21 my $ua = __PACKAGE__->ua();
45              
46 1         43067 my $resp = $ua->post($smallr,
47             [ url => $url, submit => 'submit' ]);
48              
49 0 0         return unless $resp->is_success;
50              
51 0 0         if ($resp->content =~ m!

52             #if ($resp->content =~ m!Your shorter link is: !) {
53 0           return "$base_url$1";
54             }
55 0           return;
56             }
57              
58             1;
59              
60             __END__