File Coverage

blib/lib/WWW/Shorten/Metamark.pm
Criterion Covered Total %
statement 27 27 100.0
branch 6 12 50.0
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 42 48 87.5


line stmt bran cond sub pod time code
1             # $Id$
2              
3             =head1 NAME
4            
5             WWW::Shorten::Metamark - Perl interface to metamark.net
6            
7             =head1 SYNOPSIS
8            
9             use WWW::Shorten::Metamark;
10            
11             use WWW::Shorten 'Metamark';
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 site metamark.net. Metamark simply maintains
20             a database of long URLs, each of which has a unique identifier.
21            
22             =cut
23              
24             package WWW::Shorten::Metamark;
25              
26 7     7   64487 use 5.006;
  7         20  
  7         113  
27 7     7   21 use strict;
  7         4  
  7         104  
28 7     7   19 use warnings;
  7         7  
  7         177  
29              
30 7     7   21 use base qw( WWW::Shorten::generic Exporter );
  7         5  
  7         661  
31             our @EXPORT = qw(makeashorterlink makealongerlink);
32             our $VERSION = '1.91';
33              
34 7     7   25 use Carp;
  7         10  
  7         1142  
35              
36             =head1 Functions
37            
38             =head2 makeashorterlink
39            
40             The function C<makeashorterlink> will call the Metamark web site passing it
41             your long URL and will return the shorter Metamark version.
42            
43             =cut
44              
45             sub makeashorterlink ($)
46             {
47 3 100   3 1 183165     my $url = shift or croak 'No URL passed to makeashorterlink';
48 1         8     my $ua = __PACKAGE__->ua();
49 1         6     my $resp = $ua->post( 'http://metamark.net/api/rest/simple', [
50                     long_url => $url,
51                 ] );
52 1 50       721160     return unless $resp->is_success;
53 1 0       22     return if $resp->content =~ /^ERROR:/;
54             # I love REST. It's so simple when done properly.
55 1         19     return $resp->content;
56             }
57              
58             =head2 makealongerlink
59            
60             The function C<makealongerlink> does the reverse. C<makealongerlink>
61             will accept as an argument either the full Metamark URL or just the
62             Metamark identifier.
63            
64             If anything goes wrong, then either function will return C<undef>.
65            
66             =cut
67              
68             sub makealongerlink ($)
69             {
70 4 100   4 1 1969     my $short_url = shift
71             or croak 'No Metamark key / URL passed to makealongerlink';
72 2         30     my $ua = __PACKAGE__->ua();
73              
74 2         20     my $resp = $ua->post( 'http://metamark.net/api/rest/simple', [
75                     short_url => $short_url,
76                 ] );
77 2 50       927779     return unless $resp->is_success;
78 2 0       57     return if $resp->content =~ /^ERROR:/;
79             # I love REST. It's so simple when done properly.
80 2         73     return $resp->content;
81             }
82              
83             1;
84              
85             __END__
86            
87             =head2 EXPORT
88            
89             makeashorterlink, makealongerlink
90            
91             =head1 SUPPORT, LICENCE, THANKS and SUCH
92            
93             See the main L<WWW::Shorten> docs.
94            
95             =head1 AUTHOR
96            
97             Iain Truskett <spoon@cpan.org>
98            
99             Based on WWW::MakeAShorterLink by Dave Cross <dave@dave.org.uk>
100            
101             =head1 SEE ALSO
102            
103             L<WWW::Shorten>, L<perl>, L<http://metamark.net/>
104            
105             =cut
106