line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WWW::Shorten::VGd; |
2
|
|
|
|
|
|
|
# ABSTRACT: shorten (or lengthen) URLs with http://v.gd |
3
|
1
|
|
|
1
|
|
31502
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
49
|
|
4
|
1
|
|
|
1
|
|
7
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
30
|
|
5
|
1
|
|
|
1
|
|
37
|
use 5.006; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
72
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.003'; # VERSION |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
10
|
use base qw( WWW::Shorten::generic Exporter ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
972
|
|
10
|
|
|
|
|
|
|
our @EXPORT = qw( makeashorterlink makealongerlink ); |
11
|
1
|
|
|
1
|
|
126951
|
use Carp; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
477
|
|
12
|
1
|
|
|
1
|
|
5194
|
use HTML::Entities; |
|
1
|
|
|
|
|
33124
|
|
|
1
|
|
|
|
|
570
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub makeashorterlink { |
16
|
3
|
100
|
|
3
|
1
|
1504
|
my $url = shift or croak 'No URL passed to makeashorterlink'; |
17
|
2
|
|
|
|
|
26
|
my $ua = __PACKAGE__->ua(); |
18
|
2
|
50
|
|
|
|
40113
|
my $response = $ua->post('http://v.gd/create.php', [ |
19
|
|
|
|
|
|
|
url => $url, |
20
|
|
|
|
|
|
|
source => 'PerlAPI-' . (defined __PACKAGE__->VERSION ? __PACKAGE__->VERSION : 'dev'), |
21
|
|
|
|
|
|
|
format => 'simple', |
22
|
|
|
|
|
|
|
]); |
23
|
2
|
50
|
|
|
|
213890
|
return unless $response->is_success; |
24
|
2
|
|
|
|
|
26
|
my $shorturl = $response->{_content}; |
25
|
2
|
50
|
|
|
|
12
|
return if $shorturl =~ m/Error/; |
26
|
2
|
50
|
|
|
|
14
|
if ($response->content =~ m{(\Qhttp://v.gd/\E[\w_]+)}) { |
27
|
2
|
|
|
|
|
77
|
return $1; |
28
|
|
|
|
|
|
|
} |
29
|
0
|
|
|
|
|
0
|
return; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub makealongerlink { |
34
|
3
|
100
|
|
3
|
1
|
933
|
my $url = shift or croak 'No v.gd key/URL passed to makealongerlink'; |
35
|
2
|
|
|
|
|
535
|
my $ua = __PACKAGE__->ua(); |
36
|
|
|
|
|
|
|
|
37
|
2
|
|
|
|
|
28
|
$url =~ s{\Qhttp://v.gd/\E}{}i; |
38
|
2
|
50
|
|
|
|
205
|
my $response = $ua->post('http://v.gd/forward.php', [ |
39
|
|
|
|
|
|
|
shorturl => $url, |
40
|
|
|
|
|
|
|
source => 'PerlAPI-' . (defined __PACKAGE__->VERSION ? __PACKAGE__->VERSION : 'dev'), |
41
|
|
|
|
|
|
|
format => 'simple', |
42
|
|
|
|
|
|
|
]); |
43
|
|
|
|
|
|
|
# use Data::Dumper; |
44
|
|
|
|
|
|
|
# print STDERR Dumper $response; |
45
|
2
|
50
|
|
|
|
84303
|
return unless $response->is_success; |
46
|
|
|
|
|
|
|
|
47
|
2
|
|
|
|
|
90
|
my $longurl = $response->{_content}; |
48
|
2
|
|
|
|
|
64
|
return decode_entities($longurl); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
1; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=pod |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=encoding utf-8 |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=head1 NAME |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
WWW::Shorten::VGd - shorten (or lengthen) URLs with http://v.gd |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head1 VERSION |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
version 0.003 |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head1 SYNOPSIS |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
use WWW::Shorten::VGd; |
70
|
|
|
|
|
|
|
use WWW::Shorten 'VGd'; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
my $url = q{http://averylong.link/wow?thats=really&really=long}; |
73
|
|
|
|
|
|
|
my $short_url = makeashorterlink($url); |
74
|
|
|
|
|
|
|
my $long_url = makealongerlink($short_url); # eq $url |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head1 DESCRIPTION |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
A Perl interface to the web site L. v.gd simply maintains |
79
|
|
|
|
|
|
|
a database of long URLs, each of which has a unique identifier. By default, |
80
|
|
|
|
|
|
|
this URL shortening service will show you a preview page before redirecting |
81
|
|
|
|
|
|
|
you. This can be turned off by setting a cookie at L. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head1 FUNCTIONS |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head2 makeashorterlink |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
The function C will call the v.gd web site passing |
88
|
|
|
|
|
|
|
it your long URL and will return the shortened link. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=head2 makealongerlink |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
The function C does the reverse. C |
93
|
|
|
|
|
|
|
will accept as an argument either the full TinyURL URL or just the |
94
|
|
|
|
|
|
|
TinyURL identifier. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
If anything goes wrong, then either function will return C. |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head1 AVAILABILITY |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
The project homepage is L. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
The latest version of this module is available from the Comprehensive Perl |
103
|
|
|
|
|
|
|
Archive Network (CPAN). Visit L to find a CPAN |
104
|
|
|
|
|
|
|
site near you, or see L. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
The development version lives at L |
107
|
|
|
|
|
|
|
and may be cloned from L. |
108
|
|
|
|
|
|
|
Instead of sending patches, please fork this project using the standard |
109
|
|
|
|
|
|
|
git and github infrastructure. |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=head1 SOURCE |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
The development version is on github at L |
114
|
|
|
|
|
|
|
and may be cloned from L |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
No bugs have been reported. |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
Please report any bugs or feature requests through the web interface at |
121
|
|
|
|
|
|
|
L. |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=head1 AUTHOR |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
Mike Doherty |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
This software is copyright (c) 2011 by Mike Doherty. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
132
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=cut |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
__END__ |