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('1.0.0_1');
  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 (keys(%$PERL_DEPS)) {
  84             eval "require $_";
  85             if ($@) {
  86                 push (@{$self->{'missing_pm'}}, {$_ => {cur_ver => 0, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}});
  87             }
  88             elsif ($_->VERSION lt $PERL_DEPS->{$_}->{'min_ver'}) {
  89                 push (@{$self->{'upgrade_pm'}}, {$_ => {cur_ver => $_->VERSION, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}});
  90             }
  91             else {
  92                 push (@{$self->{'current_pm'}}, {$_ => {cur_ver => $_->VERSION, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}});
  93             }
  94         }
  95         return;
  96     }
  97 }
  98
  99 sub get_attr {
 100     return $_[0]->{$_[1]};
 101 }
 102
 103 sub module_count {
 104     return scalar(keys(%$PERL_DEPS));
 105 }
 106
 107 sub module_list {
 108     return keys(%$PERL_DEPS);
 109 }
 110
 111 1;
 112 __END__
 113
 114 =head1 NAME
 115
 116 C4::Installer::PerlModules
 117
 118 =head1 ABSTRACT
 119
 120 A module for manipulating Koha Perl dependency list objects.
 121
 122 =head1 METHODS
 123
 124 =head2 new()
 125
 126     Creates a new PerlModules object
 127
 128     example:
 129         C<my $perl_modules = C4::Installer::PerlModules->new;>
 130
 131 =head2 prereq_pm()
 132
 133     Returns a hashref of a hash of module information suitable for use in Makefile.PL
 134
 135     example:
 136         C<my $perl_modules = C4::Installer::PerlModules->new;
 137
 138         ...
 139
 140         PREREQ_PM    => $perl_modules->prereq_pm,>
 141
 142 =head2 required()
 143
 144     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.
 145
 146     example:
 147         C<my $is_required = $perl_modules->required(module => 'CGI::Carp');>
 148
 149         C<my $optional_pm_names = $perl_modules->required(optional => 1);>
 150
 151 =head2 version_info()
 152
 153     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.
 154
 155     example:
 156         C<my $module_status = $perl_modules->version_info(module => 'foo');>
 157
 158         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:
 159
 160         cur_ver = version number of the currently installed version (This is 0 if the module is not currently installed.)
 161         min_ver = minimum version required by Koha
 162         upgrade = upgrade status of the module relative to Koha's requirements (0 if the installed module does not need upgrading; 1 if it does)
 163         required = 0 of the module is optional; 1 if required
 164
 165         {
 166           'CGI::Carp' => {
 167                            'required' => 1,
 168                            'cur_ver' => '1.30_01',
 169                            'upgrade' => 0,
 170                            'min_ver' => '1.29'
 171                          }
 172         };
 173
 174         C<$perl_modules->version_info;>
 175
 176         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.):
 177
 178         [
 179                   {
 180                     'Text::CSV::Encoded' => {
 181                                               'required' => 1,
 182                                               'cur_ver' => 0.09,
 183                                               'min_ver' => '0.09'
 184                                             }
 185                   },
 186                   {
 187                     'Biblio::EndnoteStyle' => {
 188                                                 'required' => 1,
 189                                                 'cur_ver' => 0,
 190                                                 'min_ver' => '0.05'
 191                                               }
 192                   },
 193         }
 194
 195 =head2 get_attr(attr_name)
 196
 197     Returns an anonymous array containing the contents of the passed in accessor. Valid accessors are:
 198
 199     missing_pm - Perl modules used by Koha but not currently installed.
 200
 201     upgrade_pm - Perl modules currently installed but below the minimum version required by Koha.
 202
 203     current_pm - Perl modules currently installed and up to date as required by Koha.
 204
 205     example:
 206         C<my $missing_pm = $perl_modules->get_attr('missing_pm');>
 207
 208 =head2 module_count
 209
 210     Returns a scalar value representing the current number of Perl modules used by Koha.
 211
 212     example:
 213         C<my $module_count = $perl_modules->module_count;>
 214
 215 =head2 module_list
 216
 217     Returns an array who's elements are the names of the Perl modules used by Koha.
 218
 219     example:
 220         C<my @module_list = $perl_modules->module_list;>
 221
 222     This is useful for commandline exercises such as:
 223
 224         perl -MC4::Installer::PerlModules -e 'my $deps = C4::Installer::PerlModule->new; print (join("\n",$deps->module_list));'
 225
 226 =head1 AUTHOR
 227
 228 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 229
 230 =head1 COPYRIGHT
 231
 232 Copyright 2010 Foundations Bible College.
 233
 234 =head1 LICENSE
 235
 236 This file is part of Koha.
 237
 238 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
 239 Foundation; either version 2 of the License, or (at your option) any later version.
 240
 241 You should have received a copy of the GNU General Public License along with Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
 242 Suite 330, Boston, MA  02111-1307 USA
 243
 244 =head1 DISCLAIMER OF WARRANTY
 245
 246 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
 247 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 248
 249 =cut