File Coverage

blib/lib/OPM/Maker/Command/depcheck.pm
Criterion Covered Total %
statement 88 99 88.8
branch 25 36 69.4
condition 6 9 66.6
subroutine 11 14 78.5
pod 5 5 100.0
total 135 163 82.8


line stmt bran cond sub pod time code
1             package OPM::Maker::Command::depcheck;
2              
3             # ABSTRACT: Check if ticketsystem addon dependencies are installed (works for ((OTRS)) Community Edition, Znuny and OTOBO)
4              
5 6     6   4745 use v5.10;
  6         25  
6              
7 6     6   33 use strict;
  6         11  
  6         123  
8 6     6   26 use warnings;
  6         11  
  6         133  
9              
10 6     6   2698 use version;
  6         11784  
  6         33  
11              
12 6     6   443 use Carp qw(croak);
  6         15  
  6         311  
13 6     6   4279 use XML::LibXML;
  6         255699  
  6         43  
14              
15 6     6   3621 use OPM::Maker -command;
  6         281304  
  6         66  
16 6     6   41212 use OPM::Maker::Utils qw(check_args_sopm);
  6         57901  
  6         5823  
17              
18             sub abstract {
19 0     0 1 0 return "check if OPM package depencies are already installed";
20             }
21              
22             sub usage_desc {
23 0     0 1 0 return "opmbuild depcheck [--home ] ";
24             }
25              
26             sub opt_spec {
27             return (
28 0     0 1 0 [ 'home=s', 'Path to ticketsystem installation' ],
29             [ 'local_sopm', 'Checks if a .sopm for the required package exists in ' ],
30             );
31             }
32              
33             sub validate_args {
34 2     2 1 2711 my ($self, $opt, $args) = @_;
35              
36 2         20 my $sopm = check_args_sopm( $args, 1 );
37 2 100       2169 $self->usage_error( 'need path to .sopm or .opm' ) if
38             !$sopm;
39              
40 1 50       19 if ( !$opt->{home} ) {
41 0         0 for my $dir ( qw(otobo otrs znuny) ) {
42 0         0 my $path = '/opt/' . $dir;
43              
44 0 0       0 next if ! -d $path;
45              
46 0         0 $opt->{home} = $path;
47             }
48             }
49              
50 1 50       36 if ( !-d $opt->{home} ) {
51 1         14 $self->usage_error( "No ticketsystem found" );
52             }
53             }
54              
55             sub execute {
56 4     4 1 11200 my ($self, $opt, $args) = @_;
57            
58 4         28 my $file = check_args_sopm( $args, 1 );
59              
60 4         211 my %opts;
61 4 50       40 if ( !$ENV{OPM_UNSECURE} ) {
62 4         29 %opts = (
63             no_network => 1,
64             expand_entities => 0,
65             );
66             }
67              
68 4         41 my $size = -s $file;
69              
70             # if file is big, but not "too big"
71 4         12 my $max_size = 31_457_280;
72 4 50       80 if ( $ENV{OPM_MAX_SIZE} ) {
73 0         0 $max_size = reformat_size( $ENV{OPM_MAX_SIZE} );
74             }
75              
76 4 50       15 if ( $size > $max_size ) {
77 0         0 croak "$file too big (max size: $max_size bytes)";
78             }
79              
80 4 50       17 if ( $size > 10_000_000 ) {
81 0         0 $opts{huge} = 1;
82             }
83              
84 4         52 my $parser = XML::LibXML->new( %opts );
85 4         502 my $tree = $parser->parse_file( $file );
86            
87 4         1856 my $root_elem = $tree->getDocumentElement;
88              
89             # retrieve file information
90 4         50 my @package_req = $root_elem->findnodes( 'PackageRequired' );
91 4         334 my @modules_req = $root_elem->findnodes( 'ModuleRequired' );
92            
93 4         133 for my $subpath ( '', qw(/Kernel/cpan-lib Custom) ) {
94 12         64 push @INC, $opt->{home} . $subpath;
95             }
96              
97 4         8 my @missing;
98              
99             DEP:
100 4         8 for my $dependency ( @package_req, @modules_req ) {
101 8         62 my $type = $dependency->nodeName;
102 8         38 my $version = $dependency->findvalue( '@Version' );
103 8         1096 my $name = $dependency->textContent;
104            
105 8         25 my $result = _check_dep( $name, $version, $type );
106              
107 8 100 100     49 if ( $result && $opt->{local_sopm} && $type eq 'PackageRequired' ) {
      66        
108 1         3 my $path = $opt->{home} . '/' . $name . '.sopm';
109 1 50       32 if ( -f $path ) {
110 1         6 my $local_tree = $parser->parse_file( $path );
111 1         260 my $root_elem = $local_tree->getDocumentElement;
112              
113 1         4 my @local_names = $root_elem->findnodes('Name');
114 1         50 my $local_name = $local_names[0]->textContent;
115              
116 1         4 my @local_versions = $root_elem->findnodes('Version');
117 1         32 my $local_version = $local_versions[0]->textContent;
118              
119 1 50 33     9 if ( $local_name eq $name && version->new($local_version) > version->new( $version ) ) {
120 0         0 $result = '';
121             }
122             }
123             }
124              
125 8 100       113 push @missing, $result if $result;
126             }
127              
128 4 100       16 if ( !@missing ) {
129 1         36 say "Everything ok!";
130 1         17 return 0;
131             }
132             else {
133 3         113 say "Missing: $_" for @missing;
134 3         40 return 1;
135             }
136             }
137              
138             sub _check_dep {
139 8     8   21 my ($name, $version, $type) = @_;
140              
141 8 100       40 if ( $type eq 'ModuleRequired' ) {
    50          
142 4         28 my $path = $name . '.pm';
143 4         29 $path =~ s{::}{/}g;
144              
145 4 100       9 eval {
146 4         40 require $path;
147 4         95 $name->VERSION( $version )
148             } or return "CPAN-Module $name $version";
149             }
150             elsif ( $type eq 'PackageRequired' ) {
151 4         29 require Kernel::System::ObjectManager;
152              
153 4         29 local $Kernel::OM = Kernel::System::ObjectManager->new;
154 4         30 my $db_object = $Kernel::OM->Get('Kernel::System::DB');
155              
156 4         44 my $sql = 'SELECT id, version FROM package_repository WHERE name = ?';
157 4         25 $db_object->Prepare(
158             SQL => $sql,
159             Bind => [ \$name ],
160             );
161              
162 4         67 my $installed_version;
163 4         19 while ( my @row = $db_object->FetchrowArray() ) {
164 3         30 $installed_version = $row[1];
165             }
166              
167 4 100       52 return "Addon $name $version" if !$installed_version;
168              
169 3         32 my $installed = version->new( $installed_version );
170 3         14 my $required = version->new( $version );
171              
172 3 100       144 return "Addon $name $version (installed $installed_version)" if $installed < $required;
173             }
174              
175 5         15 return;
176             }
177              
178             1;
179              
180             __END__