about.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright Pat Eyler 2003
   4 # Copyright Biblibre 2006
   5 # Parts Copyright Liblime 2008
   6 # Parts Copyright Chris Nighswonger 2010
   7 #
   8 # This file is part of Koha.
   9 #
  10 # Koha is free software; you can redistribute it and/or modify it under the
  11 # terms of the GNU General Public License as published by the Free Software
  12 # Foundation; either version 2 of the License, or (at your option) any later
  13 # version.
  14 #
  15 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  17 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License along
  20 # with Koha; if not, write to the Free Software Foundation, Inc.,
  21 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  22
  23 use strict;
  24 use warnings;
  25
  26 use CGI;
  27 use LWP::Simple;
  28 use XML::Simple;
  29 use Config;
  30
  31 use C4::Output;
  32 use C4::Auth;
  33 use C4::Context;
  34 use C4::Installer;
  35 use C4::Update::Database;
  36
  37 #use Smart::Comments '####';
  38
  39 my $query = new CGI;
  40 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
  41     {
  42         template_name   => "about.tmpl",
  43         query           => $query,
  44         type            => "intranet",
  45         authnotrequired => 0,
  46         flagsrequired   => { catalogue => 1 },
  47         debug           => 1,
  48     }
  49 );
  50
  51 my $kohaVersion   = C4::Context->preference("Version");
  52 # restore ., for display consistency
  53 $kohaVersion =~ /(.)\.(..)(..)(...)/;
  54 # transform digits to Perl number, to display 3.6.1.2 instead of 3.06.01.002
  55 $kohaVersion = ($1+0).".".($2+0).".".($3+0).".".($4+0);
  56
  57 my $dbrev_applied=""; # the list of database revisions
  58
  59 # the $kohaVersion is duplicated since 3.7: the 3.6 (that uses the old mechanism) and the 3.7 (new mechanism).
  60 # Both versions reflects how the database has been upgraded
  61 my $already_applied = C4::Update::Database::list_versions_already_applied();
  62 # $last_known contains the previous DBrev applied number (all . removed). It's used to have a . instead of a number in case of continuous updates
  63 my $last_known=0;
  64 # $last_known_sep contains the previous DBrev applied with the separator (used for display)
  65 my $last_known_sep="";
  66 for my $v ( @$already_applied ) {
  67     my $current = $v->{version};
  68     $current =~s/\.//g;
  69     # if the current number is the previous one +1, then just add a ., for a better display N.........N+10, for example
  70     # (instead of N / N+1 / N+2 / ...)
  71     if ($current==$last_known+1) {
  72         $dbrev_applied.=".";
  73     } else { # we're not N+1, start a new range
  74         # if version don't end by a ., no need to add the current loop number
  75         # this avoid having N...N (in case of an isolated BDrev number)
  76         if ($last_known & $dbrev_applied =~ /\.$/) {
  77             $dbrev_applied .= "...".$last_known_sep;
  78         }
  79         # start a new range
  80         $dbrev_applied .= " ".$v->{version};
  81     }
  82     $last_known= $current;
  83     $last_known_sep=$v->{version};
  84 }
  85 # add the last DB rev number, we don't want to end with "..."
  86 if ($dbrev_applied =~ /\.$/) {
  87     $dbrev_applied .= "...".$last_known_sep;
  88 }
  89
  90 my $osVersion     = `uname -a`;
  91 my $perl_path = $^X;
  92 if ($^O ne 'VMS') {
  93     $perl_path .= $Config{_exe} unless $perl_path =~ m/$Config{_exe}$/i;
  94 }
  95 my $perlVersion   = $];
  96 my $mysqlVersion  = `mysql -V`;
  97 my $apacheVersion = `httpd -v 2> /dev/null`;
  98 $apacheVersion = `httpd2 -v 2> /dev/null` unless $apacheVersion;
  99 $apacheVersion = (`/usr/sbin/apache2 -V`)[0] unless $apacheVersion;
 100 my $zebraVersion = `zebraidx -V`;
 101
 102 # Additional system information for warnings
 103 my $prefNoZebra = C4::Context->preference('nozebra');
 104 my $prefAutoCreateAuthorities = C4::Context->preference('AutoCreateAuthorities');
 105 my $prefBiblioAddsAuthorities = C4::Context->preference('BiblioAddsAuthorities');
 106 my $warnPrefBiblioAddsAuthorities = ( $prefAutoCreateAuthorities && ( !$prefBiblioAddsAuthorities) );
 107
 108 my $prefEasyAnalyticalRecords  = C4::Context->preference('EasyAnalyticalRecords');
 109 my $prefUseControlNumber  = C4::Context->preference('UseControlNumber');
 110 my $warnPrefEasyAnalyticalRecords  = ( $prefEasyAnalyticalRecords  && $prefUseControlNumber );
 111
 112 my $errZebraConnection = C4::Context->Zconn("biblioserver",0)->errcode();
 113
 114 my $warnIsRootUser   = (! $loggedinuser);
 115
 116 $template->param(
 117     kohaVersion   => $kohaVersion,
 118     dbrev_applied => $dbrev_applied,
 119     osVersion     => $osVersion,
 120     perlPath      => $perl_path,
 121     perlVersion   => $perlVersion,
 122     perlIncPath   => [ map { perlinc => $_ }, @INC ],
 123     mysqlVersion  => $mysqlVersion,
 124     apacheVersion => $apacheVersion,
 125     zebraVersion  => $zebraVersion,
 126     prefNoZebra   => $prefNoZebra,
 127     prefBiblioAddsAuthorities => $prefBiblioAddsAuthorities,
 128     prefAutoCreateAuthorities => $prefAutoCreateAuthorities,
 129     warnPrefBiblioAddsAuthorities => $warnPrefBiblioAddsAuthorities,
 130     warnPrefEasyAnalyticalRecords  => $warnPrefEasyAnalyticalRecords,
 131     errZebraConnection => $errZebraConnection,
 132     warnIsRootUser => $warnIsRootUser,
 133 );
 134
 135 my @components = ();
 136
 137 my $perl_modules = C4::Installer::PerlModules->new;
 138 $perl_modules->version_info;
 139
 140 my @pm_types = qw(missing_pm upgrade_pm current_pm);
 141
 142 foreach my $pm_type(@pm_types) {
 143     my $modules = $perl_modules->get_attr($pm_type);
 144     foreach (@$modules) {
 145         my ($module, $stats) = each %$_;
 146         push(
 147             @components,
 148             {
 149                 name    => $module,
 150                 version => $stats->{'cur_ver'},
 151                 missing => ($pm_type eq 'missing_pm' ? 1 : 0),
 152                 upgrade => ($pm_type eq 'upgrade_pm' ? 1 : 0),
 153                 current => ($pm_type eq 'current_pm' ? 1 : 0),
 154                 require => $stats->{'required'},
 155             }
 156         );
 157     }
 158 }
 159
 160 @components = sort {$a->{'name'} cmp $b->{'name'}} @components;
 161
 162 my $counter=0;
 163 my $row = [];
 164 my $table = [];
 165 foreach (@components) {
 166     push (@$row, $_);
 167     unless (++$counter % 4) {
 168         push (@$table, {row => $row});
 169         $row = [];
 170     }
 171 }
 172 # Processing the last line (if there are any modules left)
 173 if (scalar(@$row) > 0) {
 174     # Extending $row to the table size
 175     $$row[3] = '';
 176     # Pushing the last line
 177     push (@$table, {row => $row});
 178 }
 179 ## ## $table
 180
 181 $template->param( table => $table );
 182
 183
 184 ## ------------------------------------------
 185 ## Koha time line code
 186
 187 #get file location
 188 my $dir = C4::Context->config('intranetdir');
 189 open( my $file, "<", "$dir" . "/docs/history.txt" );
 190 my $i = 0;
 191
 192 my @rows2 = ();
 193 my $row2  = [];
 194
 195 my @lines = <$file>;
 196 close($file);
 197
 198 shift @lines; #remove header row
 199
 200 foreach (@lines) {
 201     my ( $date, $desc, $tag ) = split(/\t/);
 202     if(!$desc && $date=~ /(?<=\d{4})\s+/) {
 203         ($date, $desc)= ($`, $');
 204     }
 205     push(
 206         @rows2,
 207         {
 208             date => $date,
 209             desc => $desc,
 210         }
 211     );
 212 }
 213
 214 my $table2 = [];
 215 #foreach my $row2 (@rows2) {
 216 foreach  (@rows2) {
 217     push (@$row2, $_);
 218     push( @$table2, { row2 => $row2 } );
 219     $row2 = [];
 220 }
 221
 222 $template->param( table2 => $table2 );
 223
 224 output_html_with_http_headers $query, $cookie, $template->output;