File Coverage

blib/lib/WWW/Shorten/Linkz.pm
Criterion Covered Total %
statement 15 29 51.7
branch 0 12 0.0
condition n/a
subroutine 5 7 71.4
pod 2 2 100.0
total 22 50 44.0


line stmt bran cond sub pod time code
1             # $Id$
2              
3             =head1 NAME
4            
5             WWW::Shorten::Linkz - Perl interface to lin.kz
6            
7             =head1 SYNOPSIS
8            
9             use WWW::Shorten 'Linkz';
10            
11             $short_url = makeashorterlink($long_url);
12            
13             $long_url = makealongerlink($short_url);
14             $long_url = makealongerlink($nickname);
15            
16             =head1 DESCRIPTION
17            
18             A Perl interface to the web site lin.kz. lin.kz simply
19             maintains a database of long URLs, each of which has a unique
20             identifier.
21            
22             =cut
23              
24             package WWW::Shorten::Linkz;
25              
26 2     2   24196 use 5.006;
  2         6  
  2         32  
27 2     2   7 use strict;
  2         1  
  2         30  
28 2     2   6 use warnings;
  2         3  
  2         57  
29              
30 2     2   6 use base qw( WWW::Shorten::generic Exporter );
  2         2  
  2         335  
31             our @EXPORT = qw(makeashorterlink makealongerlink);
32             our $VERSION = '1.90';
33              
34 2     2   7 use Carp;
  2         2  
  2         322  
35              
36             #POST http://lin.kz/make.php
37             # url=
38             # <NONAME>=Shorten URL! (submit)
39             # privkey=
40             #
41              
42             =head1 Functions
43            
44             =head2 makeashorterlink
45            
46             The function C<makeashorterlink> will call the lin.kz web site
47             passing it your long URL and will return the shorter (Linkz) version.
48            
49             Multiple submissions of the same URL will result in different codes
50             being returned.
51            
52             =cut
53              
54             sub makeashorterlink ($)
55             {
56 0 0   0 1       my $url = shift or croak 'No URL passed to makeashorterlink';
57 0               my $ua = __PACKAGE__->ua();
58 0               my $resp = $ua->post( 'http://lin.kz/make.php', [
59                     url => $url,
60                     ],
61                 );
62 0 0             return unless $resp->is_success;
63 0 0             if ($resp->content =~ m!
64             \Q<a href="\E(\Qhttp://lin.kz/?\E\w+)"
65             !x) {
66 0           return $1;
67                 }
68 0               return;
69             }
70              
71             =head2 makealongerlink
72            
73             The function C<makealongerlink> does the reverse. C<makealongerlink>
74             will accept as an argument either the full Linkz URL or just the
75             Linkz identifier/nickname.
76            
77             If anything goes wrong, then either function will return C<undef>.
78            
79             =cut
80              
81             sub makealongerlink ($)
82             {
83 0 0   0 1       my $code = shift
84             or croak 'No Linkz nickname/URL passed to makealongerlink';
85 0               my $ua = __PACKAGE__->ua();
86 0 0             $code = "http://lin.kz/?$code" unless $code =~ m!^http://!i;
87              
88 0               my $resp = $ua->get($code);
89 0               my $location = $resp->header('Location');
90 0 0             return $location if defined $location;
91 0               return;
92             }
93              
94             1;
95              
96             __END__
97            
98             =head2 EXPORT
99            
100             makeashorterlink, makealongerlink
101            
102             =head1 SUPPORT, LICENCE, THANKS and SUCH
103            
104             See the main L<WWW::Shorten> docs.
105            
106             =head1 AUTHOR
107            
108             Iain Truskett <spoon@cpan.org>
109            
110             =head1 SEE ALSO
111            
112             L<WWW::Shorten>, L<perl>, L<http://lin.kz/>
113            
114             =cut
115