File Coverage

blib/lib/WWW/Shorten/GitHub.pm
Criterion Covered Total %
statement 25 35 71.4
branch 5 14 35.7
condition 1 3 33.3
subroutine 7 7 100.0
pod 0 2 0.0
total 38 61 62.3


line stmt bran cond sub pod time code
1             package WWW::Shorten::GitHub;
2              
3             # ABSTRACT: Shorten GitHub URLs using GitHub's URL shortener - git.io
4              
5             =head1 NAME
6              
7             WWW::Shorten::GitHub - Shorten GitHub URLs using GitHub's URL shortener - git.io
8              
9             =head1 SYNOPSIS
10              
11             This module provides a perl interface to GitHub's URL shortening service, git.io.
12              
13             It allows you to shorten any GitHub URL, and also retrieve the original URL from
14             a pre-shortened URL
15              
16             =head1 USAGE
17              
18             use WWW::Shorten 'GitHub';
19              
20             my $long_url = 'https://github.com/LoonyPandora/WWW-Shorten-GitHub';
21              
22             my $short_url = makeashorterlink($long_url);
23              
24             =cut
25              
26              
27 3     3   152865 use strict;
  3         7  
  3         87  
28 3     3   18 use warnings;
  3         5  
  3         114  
29 3     3   22 use base qw(WWW::Shorten::generic Exporter);
  3         5  
  3         1070  
30              
31             our @EXPORT = qw(makeashorterlink makealongerlink);
32             our $VERSION = '0.1.6';
33              
34 3     3   49385 use Carp;
  3         5  
  3         178  
35 3     3   15 use URI;
  3         6  
  3         976  
36              
37             sub makeashorterlink {
38 1 50   1 0 10 my $url = shift or croak 'No URL passed to makeashorterlink';
39              
40 1         9 my $host = URI->new($url)->host();
41 1 50       17023 if ($host !~ m/^(gist\.)?github\.com$/) {
42 0         0 croak "Git.io only shortens URLs under the github.com domain";
43             }
44              
45 1         15 my $ua = __PACKAGE__->ua();
46 1 50       97763 my $response = $ua->post('https://git.io/create', [
47             url => $url,
48             source => 'PerlAPI-' . (defined __PACKAGE__->VERSION ? __PACKAGE__->VERSION : 'dev'),
49             format => 'simple',
50             ]);
51              
52 0 0       0 if ($response->header('Status') eq '200 OK') {
53 0         0 return 'http://git.io/' . $response->decoded_content;
54             }
55              
56 0         0 return;
57             }
58              
59              
60             sub makealongerlink {
61 1 50   1 0 11 my $token = shift or croak 'No URL / Git.io token passed to makealongerlink';
62              
63 1         10 my $url = URI->new($token);
64              
65 1 50 33     9778 unless ($url->scheme() && $url->host() eq 'git.io') {
66 0         0 $url->scheme('https');
67 0         0 $url->host('git.io');
68 0         0 $url->path($token);
69             }
70              
71 1         207 my $ua = __PACKAGE__->ua();
72 1         19067 my $response = $ua->get($url->as_string);
73              
74 0 0         if ($response->is_redirect) {
75 0           return $response->header('Location');
76             }
77              
78 0           return;
79             }
80              
81             1;
82              
83             =head1 CAVEATS
84              
85             Git.io only shortens URLs on github.com and its subdomains.
86              
87             It is not a general purpose URL shortener.
88              
89             =head1 SEE ALSO
90              
91             L, L
92              
93             =head1 AUTHOR
94              
95             James Aitken
96              
97             =head1 COPYRIGHT AND LICENSE
98              
99             This software is copyright (c) 2011 by James Aitken.
100              
101             This is free software; you can redistribute it and/or modify it under
102             the same terms as the Perl 5 programming language system itself.
103              
104             =cut