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                     required => $type eq 'requires',
  64                 };
  65
  66                 my $vers = $reqs->structured_requirements_for_module($module);
  67                 for my $req (@$vers) {
  68                     if ( $req->[0] eq '>=' || $req->[0] eq '>' ) {
  69                         $module_infos->{min_ver} = $req->[1];
  70                     } elsif ( $req->[0] eq '<=' || $req->[0] eq '<' ) {
  71                         $module_infos->{max_ver} = $req->[1];
  72                     } else {
  73                         push @{$module_infos->{exc_ver}}, $req->[1];
  74                     }
  75                 }
  76
  77                 my $attr;
  78
  79                 $Readonly::XS::MAGIC_COOKIE="Do NOT use or require Readonly::XS unless you're me.";
  80                 eval "require $module";
  81                 if ($@) {
  82                     $attr = 'missing_pm';
  83                 } else {
  84                     my $pkg_version = $module->can("VERSION") ? $module->VERSION : 0;
  85                     $module_infos->{cur_ver} = $pkg_version;
  86                     if ($reqs->accepts_module($module => $pkg_version)) {
  87                         $attr = 'current_pm';
  88                     } else {
  89                         $attr = 'upgrade_pm';
  90                     }
  91                 }
  92
  93                 push @{ $self->{$attr} }, { $module => $module_infos };
  94             }
  95         }
  96     }
  97 }
  98
  99 sub get_attr {
 100     return $_[0]->{$_[1]};
 101 }
 102
 103 1;
 104 __END__
 105
 106 =head1 NAME
 107
 108 C4::Installer::PerlModules
 109
 110 =head1 ABSTRACT
 111
 112 A module for manipulating Koha Perl dependency list objects.
 113
 114 =head1 METHODS
 115
 116 =head2 new()
 117
 118     Creates a new PerlModules object
 119
 120     example:
 121         C<my $perl_modules = C4::Installer::PerlModules->new;>
 122
 123 =head2 prereq_pm()
 124
 125     Returns a hashref of a hash of module information suitable for use in Makefile.PL
 126
 127     example:
 128         C<my $perl_modules = C4::Installer::PerlModules->new;
 129
 130         ...
 131
 132         PREREQ_PM    => $perl_modules->prereq_pm,>
 133
 134
 135 =head2 versions_info
 136
 137         C<$perl_modules->versions_info;>
 138
 139         This loads info of required modules into three accessors: missing_pm,
 140         upgrade_pm, and current_pm. Each of these may be accessed by using the
 141         C<get_attr> method. Each accessor returns an anonymous array who's
 142         elements are anonymous hashes. They follow this format (NOTE: Upgrade
 143         status is indicated by the accessor name.):
 144
 145         [
 146                   {
 147                     'Text::CSV::Encoded' => {
 148                                               'required' => 1,
 149                                               'cur_ver' => 0.09,
 150                                               'min_ver' => '0.09'
 151                                             }
 152                   },
 153                   {
 154                     'Biblio::EndnoteStyle' => {
 155                                                 'required' => 1,
 156                                                 'cur_ver' => 0,
 157                                                 'min_ver' => '0.05'
 158                                               }
 159                   },
 160         }
 161
 162 =head2 get_attr(attr_name)
 163
 164     Returns an anonymous array containing the contents of the passed in accessor. Valid accessors are:
 165
 166     missing_pm - Perl modules used by Koha but not currently installed.
 167
 168     upgrade_pm - Perl modules currently installed but below the minimum version required by Koha.
 169
 170     current_pm - Perl modules currently installed and up to date as required by Koha.
 171
 172     example:
 173         C<my $missing_pm = $perl_modules->get_attr('missing_pm');>
 174
 175
 176 =head1 AUTHOR
 177
 178 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 179
 180 =head1 COPYRIGHT
 181
 182 Copyright 2010 Foundations Bible College.
 183
 184 =head1 LICENSE
 185
 186 This file is part of Koha.
 187
 188 Koha is free software; you can redistribute it and/or modify it
 189 under the terms of the GNU General Public License as published by
 190 the Free Software Foundation; either version 3 of the License, or
 191 (at your option) any later version.
 192
 193 Koha is distributed in the hope that it will be useful, but
 194 WITHOUT ANY WARRANTY; without even the implied warranty of
 195 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 196 GNU General Public License for more details.
 197
 198 You should have received a copy of the GNU General Public License
 199 along with Koha; if not, see <http://www.gnu.org/licenses>.
 200
 201 =head1 DISCLAIMER OF WARRANTY
 202
 203 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
 204 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 205
 206 =cut