File Coverage

blib/lib/OTRS/Repository.pm
Criterion Covered Total %
statement 19 21 90.4
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 26 28 92.8


line stmt bran cond sub pod time code
1             package OTRS::Repository;
2              
3             # ABSTRACT: parse OTRS repositories' otrs.xml files to search for add ons
4              
5 3     3   178889 use strict;
  3         25  
  3         91  
6 3     3   16 use warnings;
  3         8  
  3         82  
7              
8 3     3   1142 use Moo;
  3         30756  
  3         20  
9 3     3   3925 use List::Util qw(all);
  3         8  
  3         295  
10 3     3   23 use Scalar::Util qw(blessed);
  3         7  
  3         155  
11 3     3   1188 use Regexp::Common qw(URI);
  3         12286  
  3         17  
12              
13 3     3   70736 use OTRS::Repository::Source;
  0            
  0            
14              
15             our $VERSION = 0.07;
16              
17             our $ALLOWED_SCHEME = [ 'HTTP', 'file' ];
18              
19             has sources => ( is => 'ro', required => 1, isa => sub {
20             die "no valid URIs" unless
21             ref $_[0] eq 'ARRAY'
22             and
23             all { _check_uri( $_ ) } @{ $_[0] }
24             });
25              
26             has _objects => ( is => 'ro', isa => sub {
27             die "no valid objects" unless
28             ref $_[0] eq 'ARRAY'
29             and
30             all { blessed $_ and $_->isa( 'OTRS::Repository::Source' ) } @{ $_[0] }
31             });
32              
33             sub find {
34             my ($self, %params) = @_;
35              
36             my @found;
37             for my $source ( @{ $self->_objects || [] } ) {
38             my $found = $source->find( %params );
39             push @found, $found if $found;
40             }
41              
42             return @found;
43             }
44              
45             sub list {
46             my ($self, %params) = @_;
47              
48             my %found_packages;
49             for my $source ( @{ $self->_objects || [] } ) {
50             my @found = $source->list( %params );
51             @found_packages{@found} = (1) x @found;
52             }
53              
54             return sort keys %found_packages;
55             }
56              
57             sub BUILDARGS {
58             my ($class, @args) = @_;
59              
60             unshift @args, 'sources' if @args % 2;
61              
62             my %param = @args;
63              
64             for my $url ( @{ $param{sources} || [] } ) {
65             push @{ $param{_objects} }, OTRS::Repository::Source->new( url => $url );
66             }
67              
68             return \%param;
69             }
70              
71             sub _check_uri {
72             my @allowed_schemes = ref $ALLOWED_SCHEME ? @{ $ALLOWED_SCHEME } : $ALLOWED_SCHEME;
73              
74             my $matches;
75              
76             SCHEME:
77             for my $scheme ( @allowed_schemes ) {
78             my $regex = ( lc $scheme eq 'http' ) ?
79             $RE{URI}{HTTP}{-scheme => qr/https?/} :
80             $RE{URI}{$scheme};
81              
82             if ( $_[0] =~ m{\A$regex\z} ) {
83             $matches++;
84             last SCHEME;
85             }
86             }
87              
88             die "No valid URI" unless $matches;
89             return 1;
90             }
91              
92             1;
93              
94             __END__