blib/lib/WWW/Shorten/SnipURL.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::SnipURL - Perl interface to SnipURL.com | ||||||
6 | |||||||
7 | =head1 SYNOPSIS | ||||||
8 | |||||||
9 | use WWW::Shorten::SnipURL; | ||||||
10 | |||||||
11 | use WWW::Shorten 'SnipURL'; | ||||||
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 service SnipURL.com. SnipURL maintains a | ||||||
20 | database of long URLs, each of which has a unique identifier or | ||||||
21 | nickname. For more features, please visit http://snipurl.com/features | ||||||
22 | |||||||
23 | =cut | ||||||
24 | |||||||
25 | package WWW::Shorten::SnipURL; | ||||||
26 | |||||||
27 | 1 | 1 | 28981 | use 5.006; | |||
1 | 3 | ||||||
1 | 43 | ||||||
28 | 1 | 1 | 6 | use strict; | |||
1 | 2 | ||||||
1 | 42 | ||||||
29 | 1 | 1 | 6 | use warnings; | |||
1 | 2 | ||||||
1 | 41 | ||||||
30 | |||||||
31 | 1 | 1 | 6 | use base qw( WWW::Shorten::generic Exporter ); | |||
1 | 3 | ||||||
1 | 1224 | ||||||
32 | our @EXPORT = qw(makeashorterlink makealongerlink); | ||||||
33 | our $VERSION = '2.00'; | ||||||
34 | |||||||
35 | use Carp; | ||||||
36 | use URI; | ||||||
37 | use HTTP::Request::Common 'POST'; | ||||||
38 | |||||||
39 | =head1 Functions | ||||||
40 | |||||||
41 | =head2 makeashorterlink | ||||||
42 | |||||||
43 | The function C |
||||||
44 | your long URL and will return the shorter SnipURL version. If used in a | ||||||
45 | list context, then it will return both the Snip URL and the password. | ||||||
46 | |||||||
47 | =cut | ||||||
48 | |||||||
49 | sub makeashorterlink { | ||||||
50 | my $url = shift or croak 'No URL passed to makeashorterlink'; | ||||||
51 | my $ua = __PACKAGE__->ua(); | ||||||
52 | |||||||
53 | my $snipurl = 'http://snipurl.com/site/index'; | ||||||
54 | |||||||
55 | my $req = POST $snipurl, | ||||||
56 | [ | ||||||
57 | url => $url, | ||||||
58 | ]; | ||||||
59 | |||||||
60 | my $resp = $ua->request($req); | ||||||
61 | |||||||
62 | return unless $resp->is_success; | ||||||
63 | |||||||
64 | if ($resp->content =~ m| | ||||||
65 | return $1; | ||||||
66 | } | ||||||
67 | |||||||
68 | return; | ||||||
69 | } | ||||||
70 | |||||||
71 | =head2 makealongerlink | ||||||
72 | |||||||
73 | The function C |
||||||
74 | will accept as an argument either the full Snip URL or just the | ||||||
75 | SnipURL identifier. | ||||||
76 | |||||||
77 | If anything goes wrong, then either function will return C |
||||||
78 | |||||||
79 | =cut | ||||||
80 | |||||||
81 | sub makealongerlink { | ||||||
82 | my $code = shift | ||||||
83 | or croak 'No SnipURL key / URL passed to makealongerlink'; | ||||||
84 | my $ua = __PACKAGE__->ua(); | ||||||
85 | |||||||
86 | unless ($code =~ m|^http://|) { | ||||||
87 | $code = "http://snipurl.com/$code"; | ||||||
88 | } | ||||||
89 | |||||||
90 | my $resp = $ua->get($code); | ||||||
91 | return unless $resp->is_redirect; | ||||||
92 | |||||||
93 | return $resp->header('Location'); | ||||||
94 | } | ||||||
95 | |||||||
96 | 1; | ||||||
97 | |||||||
98 | __END__ |