koha-dev.rot13.org Git - srvgit/blob - C4/Installer/PerlModules.pm

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