Bug 6679 - [SIGNED-OFF] fix 4 perlcritic violations in C4/Branch.pm
[koha.git] / about.pl
blob329618220fa22a019a4424774102439912673503
1 #!/usr/bin/perl
3 # Copyright Pat Eyler 2003
4 # Copyright Biblibre 2006
5 # Parts Copyright Liblime 2008
6 # Parts Copyright Chris Nighswonger 2010
8 # This file is part of Koha.
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.
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.
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.
23 use strict;
24 use warnings;
26 use CGI;
27 use LWP::Simple;
28 use XML::Simple;
29 use Config;
31 use C4::Output;
32 use C4::Auth;
33 use C4::Context;
34 use C4::Installer;
36 #use Smart::Comments '####';
38 my $query = new CGI;
39 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
41 template_name => "about.tmpl",
42 query => $query,
43 type => "intranet",
44 authnotrequired => 0,
45 flagsrequired => { catalogue => 1 },
46 debug => 1,
50 my $kohaVersion = C4::Context::KOHAVERSION;
51 my $osVersion = `uname -a`;
52 my $perl_path = $^X;
53 if ($^O ne 'VMS') {
54 $perl_path .= $Config{_exe} unless $perl_path =~ m/$Config{_exe}$/i;
56 my $perlVersion = $];
57 my $mysqlVersion = `mysql -V`;
58 my $apacheVersion = `httpd -v`;
59 $apacheVersion = `httpd2 -v` unless $apacheVersion;
60 $apacheVersion = (`/usr/sbin/apache2 -V`)[0] unless $apacheVersion;
61 my $zebraVersion = `zebraidx -V`;
63 # Additional system information for warnings
64 my $prefNoZebra = C4::Context->preference('nozebra');
65 my $prefAutoCreateAuthorities = C4::Context->preference('AutoCreateAuthorities');
66 my $prefBiblioAddsAuthorities = C4::Context->preference('BiblioAddsAuthorities');
67 my $warnPrefBiblioAddsAuthorities = ( $prefAutoCreateAuthorities && ( !$prefBiblioAddsAuthorities) );
69 my $prefEasyAnalyticalRecords = C4::Context->preference('EasyAnalyticalRecords');
70 my $prefUseControlNumber = C4::Context->preference('UseControlNumber');
71 my $warnPrefEasyAnalyticalRecords = ( $prefEasyAnalyticalRecords && $prefUseControlNumber );
73 my $errZebraConnection = C4::Context->Zconn("biblioserver",0)->errcode();
75 my $warnIsRootUser = (! $loggedinuser);
77 $template->param(
78 kohaVersion => $kohaVersion,
79 osVersion => $osVersion,
80 perlPath => $perl_path,
81 perlVersion => $perlVersion,
82 perlIncPath => [ map { perlinc => $_ }, @INC ],
83 mysqlVersion => $mysqlVersion,
84 apacheVersion => $apacheVersion,
85 zebraVersion => $zebraVersion,
86 prefNoZebra => $prefNoZebra,
87 prefBiblioAddsAuthorities => $prefBiblioAddsAuthorities,
88 prefAutoCreateAuthorities => $prefAutoCreateAuthorities,
89 warnPrefBiblioAddsAuthorities => $warnPrefBiblioAddsAuthorities,
90 warnPrefEasyAnalyticalRecords => $warnPrefEasyAnalyticalRecords,
91 errZebraConnection => $errZebraConnection,
92 warnIsRootUser => $warnIsRootUser,
95 my @components = ();
97 my $perl_modules = C4::Installer::PerlModules->new;
98 $perl_modules->version_info;
100 my @pm_types = qw(missing_pm upgrade_pm current_pm);
102 foreach my $pm_type(@pm_types) {
103 my $modules = $perl_modules->get_attr($pm_type);
104 foreach (@$modules) {
105 my ($module, $stats) = each %$_;
106 push(
107 @components,
109 name => $module,
110 version => $stats->{'cur_ver'},
111 missing => ($pm_type eq 'missing_pm' ? 1 : 0),
112 upgrade => ($pm_type eq 'upgrade_pm' ? 1 : 0),
113 current => ($pm_type eq 'current_pm' ? 1 : 0),
114 require => $stats->{'required'},
120 @components = sort {$a->{'name'} cmp $b->{'name'}} @components;
122 my $counter=0;
123 my $row = [];
124 my $table = [];
125 foreach (@components) {
126 push (@$row, $_);
127 unless (++$counter % 4) {
128 push (@$table, {row => $row});
129 $row = [];
132 # Processing the last line (if there are any modules left)
133 if (scalar(@$row) > 0) {
134 # Extending $row to the table size
135 $$row[3] = '';
136 # Pushing the last line
137 push (@$table, {row => $row});
139 ## ## $table
141 $template->param( table => $table );
144 ## ------------------------------------------
145 ## Koha time line code
147 #get file location
148 my $dir = C4::Context->config('intranetdir');
149 open( my $file, "<", "$dir" . "/docs/history.txt" );
150 my $i = 0;
152 my @rows2 = ();
153 my $row2 = [];
155 my @lines = <$file>;
156 close($file);
158 shift @lines; #remove header row
160 foreach (@lines) {
161 my ( $date, $desc, $tag ) = split(/\t/);
162 if(!$desc && $date=~ /(?<=\d{4})\s+/) {
163 ($date, $desc)= ($`, $');
165 push(
166 @rows2,
168 date => $date,
169 desc => $desc,
174 my $table2 = [];
175 #foreach my $row2 (@rows2) {
176 foreach (@rows2) {
177 push (@$row2, $_);
178 push( @$table2, { row2 => $row2 } );
179 $row2 = [];
182 $template->param( table2 => $table2 );
184 output_html_with_http_headers $query, $cookie, $template->output;