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