koha_perl_deps.pl

   1 #!/usr/bin/perl
   2
   3 use Getopt::Long;
   4 use Pod::Usage;
   5 use Term::ANSIColor;
   6 use FindBin; # we need to enforce which C4::Installer is used in case more than one is installed
   7
   8 use lib $FindBin::Bin;
   9
  10 use C4::Installer::PerlModules;
  11
  12 use Modern::Perl;
  13
  14 my $help = 0;
  15 my $missing = 0;
  16 my $installed = 0;
  17 my $upgrade = 0;
  18 my $all = 0;
  19 my $color = 0;
  20 my $brief = 0;
  21 my $req = 0;
  22
  23 GetOptions(
  24             'h|help|?'    => \$help,
  25             'm|missing'   => \$missing,
  26             'i|installed' => \$installed,
  27             'u|upgrade'   => \$upgrade,
  28             'a|all'       => \$all,
  29             'b|brief'     => \$brief,
  30             'r|required'  => \$req,
  31             'c|color'     => \$color,
  32           );
  33
  34 pod2usage(1) if $help || (!$missing && !$installed && !$upgrade && !$all);
  35
  36 my $koha_pm = C4::Installer::PerlModules->new;
  37 $koha_pm->versions_info;
  38
  39 my @pm = ();
  40
  41 push @pm, 'missing_pm' if $missing || $all;
  42 push @pm, 'upgrade_pm' if $upgrade || $all;
  43 push @pm, 'current_pm' if $installed || $all;
  44
  45 if (!$brief) {
  46     print color 'bold blue' if $color;
  47     print"
  48                                               Installed         Required          Module is
  49 Module Name                                   Version           Version            Required
  50 --------------------------------------------------------------------------------------------
  51 ";
  52 }
  53
  54 my $count = 0;
  55 foreach my $type (@pm) {
  56     my $mod_type = $type;
  57     $mod_type =~ s/_pm$//;
  58     my $pm = $koha_pm->get_attr($type);
  59     foreach (@$pm) {
  60         foreach my $pm (keys(%$_)) {
  61             print color 'yellow' if $type eq 'upgrade_pm' && $color;
  62             print color 'red' if $type eq 'missing_pm' && $color;
  63             print color 'green' if $type eq 'current_pm' && $color;
  64             my $required = ($_->{$pm}->{'required'}?'Yes':'No');
  65             my $current_version = ($color ? $_->{$pm}->{'cur_ver'} :
  66                                    $type eq 'missing_pm' || $type eq 'upgrade_pm' ? $_->{$pm}->{'cur_ver'}." *" : $_->{$pm}->{'cur_ver'});
  67             if (!$brief) {
  68                 if (($req && $required eq 'Yes') || !$req) {
  69 format =
  70 @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<       @<<<<<
  71 $pm,                                          $current_version, $_->{$pm}->{'min_ver'},  $required
  72 .
  73 write;
  74                     $count++;
  75                 }
  76             }
  77             else {
  78                 if (($req && $required eq 'Yes') || !$req) {
  79                     print "$pm\n";
  80                     $count++;
  81                 }
  82             }
  83         }
  84     }
  85 }
  86
  87 if (!$brief) {
  88     print color 'bold blue' if $color;
  89     my $footer = "
  90 --------------------------------------------------------------------------------------------
  91 Total modules reported: $count                      ";
  92
  93     if ($color) {
  94         $footer .= "\n\n";
  95     }
  96     else {
  97         $footer .= "* Module is missing or requires an upgrade.\n\n";
  98     }
  99
 100     print $footer;
 101     print color 'reset' if $color;
 102 }
 103
 104 1;
 105
 106 __END__
 107
 108 =head1 NAME
 109
 110 koha_perl_deps.pl
 111
 112 =head1 SYNOPSIS
 113
 114  At least one of -a, -m, -i, or -u flags must specified to not trigger help.
 115  ./koha_perl_deps.pl -m [-b] [-r] [-c]
 116  ./koha_perl_deps.pl -u [-b] [-r] [-c]
 117  ./koha_perl_deps.pl -i [-b] [-r] [-c]
 118  ./koha_perl_deps.pl -a [-b] [-r] [-c]
 119  ./koha_perl_deps.pl [-[h?]]
 120
 121 =head1 OPTIONS
 122
 123 =over 8
 124
 125 =item B<-m|--missing>
 126
 127 lists all missing perl modules
 128
 129 =item B<-i|--installed>
 130
 131 lists all installed perl modules
 132
 133 =item B<-u|--upgrade>
 134
 135 lists all perl modules needing to be upgraded relative to Koha
 136
 137 =item B<-a|--all>
 138
 139  lists all koha perl dependencies
 140  This is equivalent to '-m -i -u'.
 141
 142 =item B<-b|--brief>
 143
 144 lists only the perl dependency name.
 145
 146 =item B<-r|--required>
 147
 148 filters list to only required perl dependencies.
 149
 150 =item B<-c|--color>
 151
 152 formats the output in color; red = module is missing, yellow = module requires upgrading, green = module is installed and current
 153
 154 =item B<-h|--help|?>
 155
 156 prints this help text
 157
 158 =back
 159
 160 =head1 AUTHOR
 161
 162 Chris Nighswonger <cnighswonger AT foundations DOT edu>
 163
 164 =head1 COPYRIGHT
 165
 166 Copyright 2010 Foundations Bible College.
 167
 168 =head1 LICENSE
 169
 170 This file is part of Koha.
 171
 172 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
 173 Foundation; either version 2 of the License, or (at your option) any later version.
 174
 175 You should have received a copy of the GNU General Public License along
 176 with Koha; if not, write to the Free Software Foundation, Inc.,
 177 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 178
 179 =head1 DISCLAIMER OF WARRANTY
 180
 181 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
 182 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 183
 184 =cut