package C4::Installer::PerlModules; use warnings; use strict; use File::Basename qw( dirname ); use Module::CPANfile; sub new { my $invocant = shift; my $self = { missing_pm => [], upgrade_pm => [], current_pm => [], }; my $type = ref($invocant) || $invocant; bless ($self, $type); return $self; } sub prereqs { my $self = shift; unless (defined $self->{prereqs}) { my $filename = $INC{'C4/Installer/PerlModules.pm'}; my $path = dirname(dirname(dirname($filename))); $self->{prereqs} = Module::CPANfile->load("$path/cpanfile")->prereqs; } return $self->{prereqs}; } sub prereq_pm { my $self = shift; my $prereq_pm = {}; my $reqs = $self->prereqs->merged_requirements; foreach my $module ($reqs->required_modules) { $prereq_pm->{$module} = $reqs->requirements_for_module($module); } return $prereq_pm; } sub versions_info { my $self = shift; # Reset these arrayref each pass through to ensure current information $self->{'missing_pm'} = []; $self->{'upgrade_pm'} = []; $self->{'current_pm'} = []; foreach my $phase ($self->prereqs->phases) { foreach my $type ($self->prereqs->types_in($phase)) { my $reqs = $self->prereqs->requirements_for($phase, $type); foreach my $module (sort $reqs->required_modules) { my $module_infos = { cur_ver => 0, required => $type eq 'requires', }; my $vers = $reqs->structured_requirements_for_module($module); for my $req (@$vers) { if ( $req->[0] eq '>=' || $req->[0] eq '>' ) { $module_infos->{min_ver} = $req->[1]; } elsif ( $req->[0] eq '<=' || $req->[0] eq '<' ) { $module_infos->{max_ver} = $req->[1]; } else { push @{$module_infos->{exc_ver}}, $req->[1]; } } my $attr; { # ignore warnings from noisy modules local $SIG{__WARN__} = sub {}; eval "require $module"; } if ($@) { $attr = 'missing_pm'; } else { my $pkg_version = $module->can("VERSION") ? $module->VERSION : 0; $module_infos->{cur_ver} = $pkg_version; if ($reqs->accepts_module($module => $pkg_version)) { $attr = 'current_pm'; } else { $attr = 'upgrade_pm'; } } push @{ $self->{$attr} }, { $module => $module_infos }; } } } } sub get_attr { return $_[0]->{$_[1]}; } 1; __END__ =head1 NAME C4::Installer::PerlModules =head1 ABSTRACT A module for manipulating Koha Perl dependency list objects. =head1 METHODS =head2 new() Creates a new PerlModules object example: Cnew;> =head2 prereq_pm() Returns a hashref of a hash of module information suitable for use in Makefile.PL example: Cnew; ... PREREQ_PM => $perl_modules->prereq_pm,> =head2 versions_info C<$perl_modules->versions_info;> This loads info of required modules into three accessors: missing_pm, upgrade_pm, and current_pm. Each of these may be accessed by using the C 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.): [ { 'Text::CSV::Encoded' => { 'required' => 1, 'cur_ver' => 0.09, 'min_ver' => '0.09' } }, { 'Biblio::EndnoteStyle' => { 'required' => 1, 'cur_ver' => 0, 'min_ver' => '0.05' } }, } =head2 get_attr(attr_name) Returns an anonymous array containing the contents of the passed in accessor. Valid accessors are: missing_pm - Perl modules used by Koha but not currently installed. upgrade_pm - Perl modules currently installed but below the minimum version required by Koha. current_pm - Perl modules currently installed and up to date as required by Koha. example: Cget_attr('missing_pm');> =head1 AUTHOR Chris Nighswonger =head1 COPYRIGHT Copyright 2010 Foundations Bible College. =head1 LICENSE This file is part of Koha. 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 Foundation; either version 3 of the License, or (at your option) any later version. 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 A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with Koha; if not, see . =head1 DISCLAIMER OF WARRANTY 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 A PARTICULAR PURPOSE. See the GNU General Public License for more details. =cut