File Coverage

blib/lib/App/GitHub/FindRepository/Repository.pm
Criterion Covered Total %
statement 21 52 40.3
branch 0 8 0.0
condition 0 5 0.0
subroutine 7 16 43.7
pod 0 8 0.0
total 28 89 31.4


line stmt bran cond sub pod time code
1             package App::GitHub::FindRepository::Repository;
2              
3 2     2   15 use warnings;
  2         4  
  2         54  
4 2     2   10 use strict;
  2         4  
  2         57  
5              
6 2     2   10 use Scalar::Util qw/blessed/;
  2         4  
  2         303  
7              
8 2     2   12 use constant PUBLIC_PREFIX => 'git://github.com/';
  2         8  
  2         180  
9 2     2   12 use constant PRIVATE_PREFIX => 'git@github.com:';
  2         4  
  2         119  
10              
11             use overload
12 2         19 '""' => \&url,
13             fallack => 1,
14 2     2   3721 ;
  2         2340  
15              
16             {
17 2     2   1282 no strict 'refs';
  2         4  
  2         1301  
18             for my $attribute (qw/prefix origina base/) {
19             *$attribute = sub {
20 0     0     my $self = shift;
21 0 0         return $self->{$attribute} unless @_;
22 0           return $self->{$attribute} = shift;
23             };
24             }
25             }
26              
27             sub new {
28 0     0 0   my $class = shift;
29 0           return bless { @_ }, $class;
30             }
31              
32             sub parse {
33 0     0 0   my $class = shift;
34 0           my $repository = shift;
35              
36 0 0 0       return $repository if blessed $repository && $repository->isa( __PACKAGE__ );
37              
38 0 0         return unless $repository;
39              
40 0           my $base = $repository;
41 0           $base =~ s/ //g;
42 0           $base =~ s/,/\//g;
43 0           $base =~ s!^\s*((?:\w+[:/@]+)?github\.com(?:[:/]))!!;
44 0           my $prefix = $1;
45 0           $base =~ s/\.git$//;
46              
47 0 0         return unless $base;
48              
49 0           return $class->new( prefix => $prefix, base => $base, original => $repository );
50             }
51              
52             sub name {
53 0     0 0   my $self = shift;
54 0           my $name = $self->base;
55 0           $name =~ s!^.*/+!!;
56 0           return $name
57             }
58              
59             sub url {
60 0     0 0   my $self = shift;
61 0   0       return join '', ($self->prefix || PUBLIC_PREFIX), $self->base, '.git'
62             }
63              
64             sub test {
65 0     0 0   my $self = shift;
66 0           return $self->public;
67             }
68              
69             sub public {
70 0     0 0   my $self = shift;
71 0           return join '', PUBLIC_PREFIX, $self->base, '.git';
72             }
73              
74             sub private {
75 0     0 0   my $self = shift;
76 0           return join '', PRIVATE_PREFIX, $self->base, '.git';
77             }
78              
79             sub home {
80 0     0 0   my $self = shift;
81 0           return join '', 'http://github.com/', $self->base;
82             }
83              
84             1;