C4/Installer/PerlModules.pm

   1 package C4::Installer::PerlModules;
   2
   3 use warnings;
   4 use strict;
   5
   6 use File::Spec;
   7 use File::Basename;
   8 use Module::CPANfile;
   9
  10 sub new {
  11     my $invocant = shift;
  12     my $self = {
  13         missing_pm  => [],
  14         upgrade_pm  => [],
  15         current_pm  => [],
  16     };
  17
  18     my $type = ref($invocant) || $invocant;
  19     bless ($self, $type);
  20     return $self;
  21 }
  22
  23 sub prereqs {
  24     my $self = shift;
  25
  26     unless (defined $self->{prereqs}) {
  27         my $filename = $INC{'C4/Installer/PerlModules.pm'};
  28         my $path = dirname(dirname(dirname($filename)));
  29         $self->{prereqs} = Module::CPANfile->load("$path/cpanfile")->prereqs;
  30     }
  31
  32     return $self->{prereqs};
  33 }
  34
  35 sub prereq_pm {
  36     my $self = shift;
  37
  38     my $prereq_pm = {};
  39     my $reqs = $self->prereqs->merged_requirements;
  40     foreach my $module ($reqs->required_modules) {
  41         $prereq_pm->{$module} = $reqs->requirements_for_module($module);
  42     }
  43
  44     return $prereq_pm;
  45 }
  46
  47 sub versions_info {
  48     my $self = shift;
  49
  50     #   Reset these arrayref each pass through to ensure current information
  51     $self->{'missing_pm'} = [];
  52     $self->{'upgrade_pm'} = [];
  53     $self->{'current_pm'} = [];
  54
  55     foreach my $phase ($self->prereqs->phases) {
  56         foreach my $type ($self->prereqs->types_in($phase)) {
  57             my $reqs = $self->prereqs->requirements_for($phase, $type);
  58             foreach my $module ($reqs->required_modules) {
  59                 no warnings;  # perl throws warns for invalid $VERSION numbers which some modules use
  60
  61                 my $module_infos = {
  62                     cur_ver  => 0,
  63                     min_ver  => $reqs->requirements_for_module($module),
  64                     required => $type eq 'requires',
  65                 };
  66
  67                 my $attr;
  68
  69                 $Readonly::XS::MAGIC_COOKIE="Do NOT use or require Readonly::XS unless you're me.";
  70                 eval "require $module";
  71                 if ($@) {
  72                     $attr = 'missing_pm';
  73                 } else {
  74                     my $pkg_version = $module->can("VERSION") ? $module->VERSION : 0;
  75                     $module_infos->{cur_ver} = $pkg_version;
  76                     if ($reqs->accepts_module($module => $pkg_version)) {
  77                         $attr = 'current_pm';
  78                     } else {
  79                         $attr = 'upgrade_pm';
  80                     }
  81                 }
  82
  83                 push @{ $self->{$attr} }, { $module => $module_infos };
  84             }
  85         }
  86     }
  87 }
  88
  89 sub get_attr {
  90     return $_[0]->{$_[1]};
  91 }
  92
  93 1;
  94 __END__
  95
  96 =head1 NAME
  97
  98 C4::Installer::PerlModules
  99
 100 =head1 ABSTRACT
 101
 102 A module for manipulating Koha Perl dependency list objects.
 103
 104 =head1 METHODS
 105
 106 =head2 new()
 107
 108     Creates a new PerlModules object
 109
 110     example:
 111         C<my $perl_modules = C4::Installer::PerlModules->new;>
 112
 113 =head2 prereq_pm()
 114
 115     Returns a hashref of a hash of module information suitable for use in Makefile.PL
 116
 117     example:
 118         C<my $perl_modules = C4::Installer::PerlModules->new;
 119
 120         ...
 121
 122         PREREQ_PM    => $perl_modules->prereq_pm,>
 123
 124
 125 =head2 versions_info
 126
 127         C<$perl_modules->versions_info;>
 128
 129         This loads info of required modules into three accessors: missing_pm,
 130         upgrade_pm, and current_pm. Each of these may be accessed by using the
 131         C<get_attr> method. Each accessor returns an anonymous array who's
 132         elements are anonymous hashes. They follow this format (NOTE: Upgrade
 133         status is indicated by the accessor name.):
 134
 135         [
 136                   {
 137                     'Text::CSV::Encoded' => {
 138                                               'required' => 1,
 139                                               'cur_ver' => 0.09,
 140                                               'min_ver' => '0.09'
 141                                             }
 142                   },
 143                   {
 144                     'Biblio::EndnoteStyle' => {
 145                                                 'required' => 1,
 146                                                 'cur_ver' => 0,
 147                                                 'min_ver' => '0.05'
 148                                               }
 149                   },
 150         }
 151
 152 =head2 get_attr(attr_name)
 153
 154     Returns an anonymous array containing the contents of the passed in accessor. Valid accessors are:
 155
 156     missing_pm - Perl modules used by Koha but not currently installed.
 157
 158     upgrade_pm - Perl modules currently installed but below the minimum version required by Koha.
 159
 160     current_pm - Perl modules currently installed and up to date as required by Koha.
 161
 162     example:
 163         C<my $missing_pm = $perl_modules->get_attr('missing_pm');>
 164
 165
 166 =head1 AUTHOR
 167
 168 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 169
 170 =head1 COPYRIGHT
 171
 172 Copyright 2010 Foundations Bible College.
 173
 174 =head1 LICENSE
 175
 176 This file is part of Koha.
 177
 178 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
 179 Foundation; either version 2 of the License, or (at your option) any later version.
 180
 181 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,
 182 Fifth Floor, Boston, MA 02110-1301 USA.
 183
 184 =head1 DISCLAIMER OF WARRANTY
 185
 186 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
 187 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 188
 189 =cut