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