| 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__ |