File Coverage

blib/lib/WWW/Shorten/V3.pm
Criterion Covered Total %
statement 6 6 100.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 8 8 100.0


line stmt bran cond sub pod time code
1             # $Id$
2             package WWW::Shorten::V3;
3              
4 1     1   1736 use strict;
  1         1  
  1         34  
5 1     1   3 use warnings;
  1         0  
  1         32  
6              
7             our $VERSION = '1.93';
8             require WWW::Shorten::_dead;
9              
10             0;
11             __END__
12            
13             =head1 NAME
14            
15             WWW::Shorten::V3 - Perl interface to v3.net
16            
17             =head1 SYNOPSIS
18            
19             # No appropriate synopsis.
20            
21             =head1 DESCRIPTION
22            
23             A Perl interface to the web site v3.net.
24            
25             Unfortunately, this service became inactive at some point between 1.90
26             and 1.91, so this module will merely give you an error if you try to use
27             it. Feel free to pick a different L<service|WWW::Shorten>.
28            
29             =head1 SUPPORT, LICENCE, THANKS and SUCH
30            
31             See the main L<WWW::Shorten> docs.
32            
33             =head1 AUTHORS
34            
35             Iain Truskett <spoon@cpan.org>, Dave Cross <dave@dave.org.uk>
36            
37             =head1 SEE ALSO
38            
39             L<WWW::Shorten>, L<perl>, L<http://makeurl.v3.net/>
40            
41             =cut
42            
43            
44             use 5.006;
45             use strict;
46             use warnings;
47            
48             use base qw( WWW::Shorten::generic Exporter );
49             our @EXPORT = qw(makeashorterlink makealongerlink);
50            
51             use Carp;
52            
53             =head1 Functions
54            
55             =head2 makeashorterlink
56            
57             The function C<makeashorterlink> will call the v3.net web site passing it
58             your long URL and will return the shorter (V3) version.
59            
60             Multiple submissions of the same URL will result in different codes
61             being returned.
62            
63             =cut
64            
65             sub makeashorterlink ($)
66             {
67             my $url = shift or croak 'No URL passed to makeashorterlink';
68             my $ua = __PACKAGE__->ua();
69            
70             my $resp = $ua->post( 'http://makeurl.v3.net/' , [
71             shorten => $url,
72             ],
73             );
74             return unless $resp->is_success;
75             if ($resp->content =~ m!
76             href="(http://\d+\.v3\.net/)"
77             [^>]+>
78             http://\d+\.v3\.net</a>
79             !xs) {
80             return $1;
81             }
82             return;
83             }
84            
85             =head2 makealongerlink
86            
87             The function C<makealongerlink> does the reverse. C<makealongerlink>
88             will accept as an argument either the full V3 URL or just the
89             V3 identifier/nickname.
90            
91             If anything goes wrong, then either function will return C<undef>.
92            
93             =cut
94            
95             sub makealongerlink ($)
96             {
97             my $code = shift
98             or croak 'No v3 nickname/URL passed to makealongerlink';
99             my $ua = __PACKAGE__->ua();
100            
101             $code = "http://$code.v3.net/" unless $code =~ m!^http://!i;
102            
103             my $resp = $ua->get($code);
104             return unless $resp->is_redirect;
105             my $url = $resp->header('Location');
106             return $url;
107             }
108            
109             1;
110            
111             __END__
112            
113             =head2 EXPORT
114            
115             makeashorterlink, makealongerlink
116            
117             =head1 SUPPORT, LICENCE, THANKS and SUCH
118            
119             See the main L<WWW::Shorten> docs.
120            
121             =head1 AUTHOR
122            
123             Iain Truskett <spoon@cpan.org>
124            
125             =head1 SEE ALSO
126            
127             L<WWW::Shorten>, L<perl>, L<http://v3.net/>
128            
129             =cut
130