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