C4/Installer/PerlModules.pm

   1 package C4::Installer::PerlModules;
   2
   3 use warnings;
   4 use strict;
   5
   6 use File::Spec;
   7
   8 use C4::Installer::PerlDependencies;
   9
  10
  11 our $PERL_DEPS = $C4::Installer::PerlDependencies::PERL_DEPS;
  12
  13 sub new {
  14     my $invocant = shift;
  15     my $self = {
  16         missing_pm  => [],
  17         upgrade_pm  => [],
  18         current_pm  => [],
  19     };
  20     my $type = ref($invocant) || $invocant;
  21     bless ($self, $type);
  22     return $self;
  23 }
  24
  25 sub prereq_pm {
  26     my $self = shift;
  27     my $prereq_pm = {};
  28     for (keys %$PERL_DEPS) {
  29         $prereq_pm->{$_} = $PERL_DEPS->{$_}->{'min_ver'};
  30     }
  31     return $prereq_pm;
  32 }
  33
  34 sub required {
  35     my $self = shift;
  36     my %params = @_;
  37     if ($params{'module'}) {
  38         return -1 unless grep {m/$params{'module'}/} keys(%$PERL_DEPS);
  39         return $PERL_DEPS->{$params{'module'}}->{'required'};
  40     }
  41     elsif ($params{'required'}) {
  42         my $required_pm = [];
  43         for (keys %$PERL_DEPS) {
  44             push (@$required_pm, $_) if $PERL_DEPS->{$_}->{'required'} == 1;
  45         }
  46         return $required_pm;
  47     }
  48     elsif ($params{'optional'}) {
  49         my $optional_pm = [];
  50         for (keys %$PERL_DEPS) {
  51             push (@$optional_pm, $_) if $PERL_DEPS->{$_}->{'required'} == 0;
  52         }
  53         return $optional_pm;
  54     }
  55     else {
  56         return -1; # unrecognized parameter passed in
  57     }
  58 }
  59
  60 sub version_info {
  61     no warnings; # perl throws warns for invalid $VERSION numbers which some modules use
  62     my $self = shift;
  63 #   Reset these arrayref each pass through to ensure current information
  64     $self->{'missing_pm'} = [];
  65     $self->{'upgrade_pm'} = [];
  66     $self->{'current_pm'} = [];
  67     my %params = @_;
  68     if ($params{'module'}) {
  69         return -1 unless grep {m/$params{'module'}/} keys(%$PERL_DEPS);
  70         eval "require $params{'module'}";
  71         my $pkg_version =  $params{'module'} &&  $params{'module'}->can("VERSION") ? $params{'module'}->VERSION : 0;
  72         my $min_version =  $PERL_DEPS->{$params{'module'}}->{'min_ver'} // 0;
  73         if ($@) {
  74             return {$params{'module'} => {cur_ver => 0, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, upgrade => 0, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}};
  75         }
  76         elsif (version->parse("$pkg_version") < version->parse("$min_version")) {
  77             return {$params{'module'} => {cur_ver => $params{'module'}->VERSION, min_ver => $PERL_DEPS->{$params{'module'}}->{'min_ver'}, upgrade => 1, required => $PERL_DEPS->{$params{'module'}}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}};
  78         }
  79         else {
  80             return {$params{'module'} => {cur_ver => $params{'module'}->VERSION, min_ver => $PERL_DEPS->{$params{'module'}}->{'min_ver'}, upgrade => 0, required => $PERL_DEPS->{$params{'module'}}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}};
  81         }
  82     }
  83     else {
  84         for (sort keys(%{$PERL_DEPS})) {
  85             my $pkg = $_;  #  $_ holds the string
  86             eval "require $pkg";
  87             my $pkg_version =  $params{'module'} &&  $params{'module'}->can("VERSION") ? $params{'module'}->VERSION : 0;
  88             my $min_version = $PERL_DEPS->{$_}->{'min_ver'} // 0;
  89             if ($@) {
  90                 push (@{$self->{'missing_pm'}}, {$_ => {cur_ver => 0, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}});
  91             }
  92             elsif (version->parse("$pkg_version") < version->parse("$min_version")) {
  93                 push (@{$self->{'upgrade_pm'}}, {$_ => {cur_ver => $pkg->VERSION, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}});
  94             }
  95             else {
  96                 push (@{$self->{'current_pm'}}, {$_ => {cur_ver => $pkg->VERSION, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}});
  97             }
  98         }
  99         return;
 100     }
 101 }
 102
 103 sub get_attr {
 104     return $_[0]->{$_[1]};
 105 }
 106
 107 sub module_count {
 108     return scalar(keys(%$PERL_DEPS));
 109 }
 110
 111 sub module_list {
 112     return keys(%$PERL_DEPS);
 113 }
 114
 115 1;
 116 __END__
 117
 118 =head1 NAME
 119
 120 C4::Installer::PerlModules
 121
 122 =head1 ABSTRACT
 123
 124 A module for manipulating Koha Perl dependency list objects.
 125
 126 =head1 METHODS
 127
 128 =head2 new()
 129
 130     Creates a new PerlModules object
 131
 132     example:
 133         C<my $perl_modules = C4::Installer::PerlModules->new;>
 134
 135 =head2 prereq_pm()
 136
 137     Returns a hashref of a hash of module information suitable for use in Makefile.PL
 138
 139     example:
 140         C<my $perl_modules = C4::Installer::PerlModules->new;
 141
 142         ...
 143
 144         PREREQ_PM    => $perl_modules->prereq_pm,>
 145
 146 =head2 required()
 147
 148     This method accepts a single parameter with three possible values: a module name, the keyword 'required,' the keyword 'optional.' If passed the name of a module, a boolean value is returned indicating whether the module is required (1) or not (0). If on of the two keywords is passed in, it returns an arrayref to an array who's elements are the names of the modules specified either required or optional.
 149
 150     example:
 151         C<my $is_required = $perl_modules->required(module => 'CGI::Carp');>
 152
 153         C<my $optional_pm_names = $perl_modules->required(optional => 1);>
 154
 155 =head2 version_info()
 156
 157     Depending on the parameters passed when invoking, this method will give the current status of modules currently used in Koha as well as the currently installed version if the module is installed, the current minimum required version, and the upgrade status. If passed C<module => module_name>, the method evaluates only that module. If passed C<all => 1>, all modules are evaluated.
 158
 159     example:
 160         C<my $module_status = $perl_modules->version_info(module => 'foo');>
 161
 162         This usage returns a hashref with a single key/value pair. The key is the module name. The value is an anonymous hash with the following keys:
 163
 164         cur_ver = version number of the currently installed version (This is 0 if the module is not currently installed.)
 165         min_ver = minimum version required by Koha
 166         upgrade = upgrade status of the module relative to Koha's requirements (0 if the installed module does not need upgrading; 1 if it does)
 167         required = 0 of the module is optional; 1 if required
 168
 169         {
 170           'CGI::Carp' => {
 171                            'required' => 1,
 172                            'cur_ver' => '1.30_01',
 173                            'upgrade' => 0,
 174                            'min_ver' => '1.29'
 175                          }
 176         };
 177
 178         C<$perl_modules->version_info;>
 179
 180         This usage loads the same basic data as the previous usage into three accessors: missing_pm, upgrade_pm, and current_pm. Each of these may be accessed by using the C<get_attr> method. Each accessor returns an anonymous array who's elements are anonymous hashes. They follow this format (NOTE: Upgrade status is indicated by the accessor name.):
 181
 182         [
 183                   {
 184                     'Text::CSV::Encoded' => {
 185                                               'required' => 1,
 186                                               'cur_ver' => 0.09,
 187                                               'min_ver' => '0.09'
 188                                             }
 189                   },
 190                   {
 191                     'Biblio::EndnoteStyle' => {
 192                                                 'required' => 1,
 193                                                 'cur_ver' => 0,
 194                                                 'min_ver' => '0.05'
 195                                               }
 196                   },
 197         }
 198
 199 =head2 get_attr(attr_name)
 200
 201     Returns an anonymous array containing the contents of the passed in accessor. Valid accessors are:
 202
 203     missing_pm - Perl modules used by Koha but not currently installed.
 204
 205     upgrade_pm - Perl modules currently installed but below the minimum version required by Koha.
 206
 207     current_pm - Perl modules currently installed and up to date as required by Koha.
 208
 209     example:
 210         C<my $missing_pm = $perl_modules->get_attr('missing_pm');>
 211
 212 =head2 module_count
 213
 214     Returns a scalar value representing the current number of Perl modules used by Koha.
 215
 216     example:
 217         C<my $module_count = $perl_modules->module_count;>
 218
 219 =head2 module_list
 220
 221     Returns an array who's elements are the names of the Perl modules used by Koha.
 222
 223     example:
 224         C<my @module_list = $perl_modules->module_list;>
 225
 226     This is useful for commandline exercises such as:
 227
 228         perl -MC4::Installer::PerlModules -e 'my $deps = C4::Installer::PerlModule->new; print (join("\n",$deps->module_list));'
 229
 230 =head1 AUTHOR
 231
 232 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 233
 234 =head1 COPYRIGHT
 235
 236 Copyright 2010 Foundations Bible College.
 237
 238 =head1 LICENSE
 239
 240 This file is part of Koha.
 241
 242 Koha is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software
 243 Foundation; either version 2 of the License, or (at your option) any later version.
 244
 245 You should have received a copy of the GNU General Public License along with Koha; if not, write to the Free Software Foundation, Inc., 51 Franklin Street,
 246 Fifth Floor, Boston, MA 02110-1301 USA.
 247
 248 =head1 DISCLAIMER OF WARRANTY
 249
 250 Koha is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
 251 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 252
 253 =cut