File Coverage

blib/lib/CPAN/Access/AdHoc/Default/CPAN/CPANPLUS.pm
Criterion Covered Total %
statement 28 28 100.0
branch 5 8 62.5
condition n/a
subroutine 6 6 100.0
pod 1 1 100.0
total 40 43 93.0


line stmt bran cond sub pod time code
1             package CPAN::Access::AdHoc::Default::CPAN::CPANPLUS;
2              
3 4     4   3466 use 5.008;
  4         10  
  4         128  
4              
5 4     4   17 use strict;
  4         10  
  4         101  
6 4     4   15 use warnings;
  4         4  
  4         96  
7              
8 4     4   19 use CPAN::Access::AdHoc::Util qw{ __load };
  4         7  
  4         957  
9              
10             our $VERSION = '0.000_194';
11              
12             my $configured = eval {
13             __load( 'CPANPLUS::Configure' );
14             1;
15             };
16              
17             sub get_default {
18 2     2 1 3 my ( $class ) = @_;
19              
20 2 50       6 $configured
21             or return;
22              
23 2         9 my $cpp = CPANPLUS::Configure->new();
24 2 50       6 my $hosts = $cpp->get_conf( 'hosts' )
25             or return;
26 2 50       4 @{ $hosts }
  2         5  
27             or return;
28              
29 2         1 foreach my $host ( @{ $hosts } ) {
  2         10  
30 4 100       13 'file' eq $host->{scheme}
31             and return _make_url( $host );
32             }
33              
34 1         3 return _make_url( $hosts->[0] );
35             }
36              
37             sub _make_url {
38 2     2   3 my @arg = @_;
39 2         3 my @rslt;
40 2         3 foreach my $host ( @arg ) {
41 2         7 ( my $path = $host->{path} ) =~ s{ \A (?! / ) }{/}smx;
42 2         9 push @rslt, sprintf '%s://%s%s', $host->{scheme}, $host->{host}, $path;
43             }
44 2         14 return @rslt;
45             }
46              
47             1;
48              
49             __END__