File Coverage

blib/lib/OPM/Installer/Utils/File.pm
Criterion Covered Total %
statement 79 97 81.4
branch 19 30 63.3
condition 0 2 0.0
subroutine 18 21 85.7
pod 2 2 100.0
total 118 152 77.6


line stmt bran cond sub pod time code
1             package OPM::Installer::Utils::File;
2              
3             # ABSTRACT: File related utility functions
4              
5 10     10   600991 use v5.10;
  10         86  
6              
7 10     10   45 use strict;
  10         13  
  10         164  
8 10     10   37 use warnings;
  10         16  
  10         363  
9              
10             our $VERSION = '1.0.0'; # VERSION
11              
12 10     10   4173 use File::HomeDir;
  10         46661  
  10         430  
13 10     10   62 use File::Spec;
  10         28  
  10         152  
14 10     10   4754 use File::Temp;
  10         139779  
  10         633  
15 10     10   5270 use HTTP::Tiny;
  10         261069  
  10         297  
16 10     10   3445 use HTTP::Tiny::FileProtocol;
  10         204900  
  10         276  
17 10     10   3322 use IO::All;
  10         70769  
  10         64  
18 10     10   3714 use Moo;
  10         65793  
  10         57  
19 10     10   13305 use OPM::Installer::Logger;
  10         23  
  10         255  
20 10     10   3721 use OPM::Installer::Utils::Config;
  10         26  
  10         262  
21 10     10   3415 use OPM::Repository;
  10         585174  
  10         324  
22 10     10   70 use Regexp::Common qw(URI);
  10         20  
  10         48  
23 10     10   4692 use Types::Standard qw(ArrayRef Str Bool);
  10         465315  
  10         84  
24              
25             our $ALLOWED_SCHEME = [ 'HTTP', 'file' ];
26              
27             has repositories => ( is => 'ro', isa => ArrayRef[Str], default => \&_repository_list );
28             has package => ( is => 'ro', isa => Str, required => 1 );
29             has framework_version => ( is => 'ro', isa => Str, required => 1 );
30             has version => ( is => 'ro', isa => Str );
31             has verbose => ( is => 'ro', isa => Bool );
32             has logger => ( is => 'ro', default => sub{ OPM::Installer::Logger->new } );
33             has rc_config => ( is => 'ro', lazy => 1, default => \&_rc_config );
34             has conf => ( is => 'ro' );
35              
36             sub list_available {
37 0     0 1 0 my $self = shift;
38              
39 0 0       0 my @repositories = @{ $self->repositories || [] };
  0         0  
40              
41 0         0 for my $repo_url ( @repositories ) {
42 0 0       0 $repo_url .= '/otrs.xml' if '/otrs.xml' ne substr $repo_url, -9;
43             }
44              
45 0         0 my $repo = OPM::Repository->new(
46             sources => \@repositories,
47             );
48              
49 0         0 my $framework_version = $self->framework_version;
50 0         0 $framework_version =~ s{\.\d+$}{};
51              
52 0         0 return $repo->list(
53             framework => $framework_version,
54             details => 1,
55             );
56             }
57              
58             sub resolve_path {
59 12     12 1 49411 my ($self) = @_;
60              
61 12         23 my $path;
62              
63 12         42 my $package = $self->package;
64 12 100       38 if ( $self->_is_url( $package ) ) {
    100          
65             # download file
66 2         7 $path = $self->_download( $package );
67             }
68             elsif ( -f $package ) {
69             # do nothing, file already exists
70 1         3 $path = $package;
71             }
72             else {
73 9 50       24 my @repositories = @{ $self->repositories || [] };
  9         60  
74              
75 9         23 for my $repo ( @repositories ) {
76 9 100       87 $repo .= '/otrs.xml' if '/otrs.xml' ne substr $repo, -9;
77             }
78              
79 9 50       38 say "Searching these repositories: @repositories" if $self->verbose;
80              
81 9         120 my $repo = OPM::Repository->new(
82             sources => \@repositories,
83             );
84              
85 9         28271 my ($framework) = $self->framework_version =~ m{\A(\d+\.\d+)};
86              
87 9         50 my ($url) = $repo->find(
88             name => $package,
89             framework => $framework,
90             version => $self->version,
91             );
92              
93 9 50 0     22296 say "Found ", $url // '' if $self->verbose;
94              
95 9 100       46 return if !$url;
96              
97 6         17 $path = $self->_download( $url );
98             }
99              
100 9         213 return $path;
101             }
102              
103             sub _repository_list {
104 0     0   0 my ($self) = @_;
105              
106 0         0 my $config = $self->rc_config;
107 0         0 my $repositories = $config->{repository};
108              
109 0 0       0 return [] if !$repositories;
110 0         0 return $repositories;
111             }
112              
113             sub _is_url {
114 19     19   3078 my ($self, $package) = @_;
115              
116 19 50       61 my @allowed_schemes = ref $ALLOWED_SCHEME ? @{ $ALLOWED_SCHEME } : $ALLOWED_SCHEME;
  19         50  
117              
118 19         68 my $matches;
119              
120             SCHEME:
121 19         35 for my $scheme ( @allowed_schemes ) {
122             my $regex = ( lc $scheme eq 'http' ) ?
123             $RE{URI}{HTTP}{-scheme => qr/https?/} :
124 34 100       3962 $RE{URI}{$scheme};
125              
126 34 100       1692 if ( $package =~ m{\A$regex\z} ) {
127 7         1070 $matches++;
128 7         59 last SCHEME;
129             }
130             }
131              
132 19 100       1852 return if !$matches;
133 7         22 return 1;
134             }
135              
136             sub _download {
137 8     8   19 my ($self, $url) = @_;
138              
139 8         50 my $file = File::Temp->new->filename;
140 8         3059 my $response = HTTP::Tiny->new->mirror( $url, $file );
141              
142 8         12623 $self->logger->notice( area => 'download', file => $file, success => $response->{success} );
143              
144 8 50       3955 return if !$response->{success};
145 8         911 return $file;
146             }
147              
148             sub _rc_config {
149 0     0     my ($self) = @_;
150              
151 0           my $utils = OPM::Installer::Utils::Config->new( conf => $self->conf );
152 0           my $config = $utils->rc_config;
153              
154 0           return $config;
155             }
156              
157             1;
158              
159             __END__