File Coverage

blib/lib/WWW/Shorten/Linkz.pm
Criterion Covered Total %
statement 16 28 57.1
branch 2 12 16.6
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 27 49 55.1


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