File Coverage

lib/WWW/Shorten/Miudin.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::Miudin - Perl interface to miud.in
6              
7             =head1 SYNOPSIS
8              
9             use WWW::Shorten::Miudin;
10             use WWW::Shorten 'Miudin';
11              
12             $short_url = makeashorterlink($long_url);
13              
14             $long_url = makealongerlink($short_url);
15              
16             =head1 DESCRIPTION
17              
18             A Perl interface to the web site miud.in. Miudin simply maintains
19             a database of long URLs, each of which has a unique identifier.
20              
21             =cut
22              
23             package WWW::Shorten::Miudin;
24              
25 1     1   71505 use 5.006;
  1         4  
  1         42  
26 1     1   5 use strict;
  1         1  
  1         32  
27 1     1   4 use warnings;
  1         6  
  1         43  
28              
29 1     1   4 use base qw( WWW::Shorten::generic Exporter );
  1         2  
  1         857  
30             our @EXPORT = qw( makeashorterlink makealongerlink );
31             our $VERSION = '1.0';
32              
33             use Carp;
34              
35             =head1 Functions
36              
37             =head2 makeashorterlink
38              
39             The function C will call the Miudin web site passing
40             it your long URL and will return the shorter Miudin version.
41              
42             =cut
43              
44             sub makeashorterlink ($)
45             {
46             my $url = shift or croak 'No URL passed to makeashorterlink';
47             my $ua = __PACKAGE__->ua();
48             my $tinyurl = 'http://miud.in/api-create.php';
49             my $resp = $ua->post($tinyurl, [
50             url => $url,
51             source => "PerlAPI-$VERSION",
52             ]);
53             return undef unless $resp->is_success;
54             my $content = $resp->content;
55             return undef if $content =~ /Error/;
56             if ($resp->content =~ m!(\Qhttp://miud.in/\E\w+)!x) {
57             return $1;
58             }
59             return;
60             }
61              
62             =head2 makealongerlink
63              
64             The function C does the reverse. C
65             will accept as an argument either the full Miudin URL or just the
66             Miudin identifier.
67              
68             If anything goes wrong, then either function will return C.
69              
70             =cut
71              
72             sub makealongerlink ($)
73             {
74             my $tinyurl_url = shift
75             or croak 'No Miudin key / URL passed to makealongerlink';
76             my $ua = __PACKAGE__->ua();
77              
78             $tinyurl_url = "http://miud.in/$tinyurl_url"
79             unless $tinyurl_url =~ m!^http://!i;
80              
81             my $resp = $ua->get($tinyurl_url);
82              
83             return undef unless $resp->is_redirect;
84             my $url = $resp->header('Location');
85             return $url;
86              
87             }
88              
89             1;
90              
91             __END__