Main Koha release repository https://koha-community.org
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

771 lines
26 KiB

  1. #!/usr/bin/perl
  2. # Copyright Pat Eyler 2003
  3. # Copyright Biblibre 2006
  4. # Parts Copyright Liblime 2008
  5. # Parts Copyright Chris Nighswonger 2010
  6. #
  7. # This file is part of Koha.
  8. #
  9. # Koha is free software; you can redistribute it and/or modify it
  10. # under the terms of the GNU General Public License as published by
  11. # the Free Software Foundation; either version 3 of the License, or
  12. # (at your option) any later version.
  13. #
  14. # Koha is distributed in the hope that it will be useful, but
  15. # WITHOUT ANY WARRANTY; without even the implied warranty of
  16. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17. # GNU General Public License for more details.
  18. #
  19. # You should have received a copy of the GNU General Public License
  20. # along with Koha; if not, see <http://www.gnu.org/licenses>.
  21. use Modern::Perl;
  22. use CGI qw ( -utf8 );
  23. use DateTime::TimeZone;
  24. use File::Spec;
  25. use File::Slurp;
  26. use List::MoreUtils qw/ any /;
  27. use LWP::Simple;
  28. use Module::Load::Conditional qw(can_load);
  29. use XML::Simple;
  30. use Config;
  31. use Search::Elasticsearch;
  32. use Try::Tiny;
  33. use YAML::XS;
  34. use Encode;
  35. use C4::Output;
  36. use C4::Auth;
  37. use C4::Context;
  38. use C4::Installer::PerlModules;
  39. use Koha;
  40. use Koha::DateUtils qw(dt_from_string output_pref);
  41. use Koha::Acquisition::Currencies;
  42. use Koha::BackgroundJob;
  43. use Koha::BiblioFrameworks;
  44. use Koha::Email;
  45. use Koha::Patron::Categories;
  46. use Koha::Patrons;
  47. use Koha::Caches;
  48. use Koha::Config::SysPrefs;
  49. use Koha::Illrequest::Config;
  50. use Koha::SearchEngine::Elasticsearch;
  51. use Koha::Logger;
  52. use Koha::Filter::MARC::ViewPolicy;
  53. use C4::Members::Statistics;
  54. #use Smart::Comments '####';
  55. my $query = CGI->new;
  56. my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
  57. {
  58. template_name => "about.tt",
  59. query => $query,
  60. type => "intranet",
  61. flagsrequired => { catalogue => 1 },
  62. debug => 1,
  63. }
  64. );
  65. my $config_timezone = C4::Context->config('timezone') // '';
  66. my $config_invalid = !DateTime::TimeZone->is_valid_name( $config_timezone );
  67. my $env_timezone = $ENV{TZ} // '';
  68. my $env_invalid = !DateTime::TimeZone->is_valid_name( $env_timezone );
  69. my $actual_bad_tz_fallback = 0;
  70. if ( $config_timezone ne '' &&
  71. $config_invalid ) {
  72. # Bad config
  73. $actual_bad_tz_fallback = 1;
  74. }
  75. elsif ( $config_timezone eq '' &&
  76. $env_timezone ne '' &&
  77. $env_invalid ) {
  78. # No config, but bad ENV{TZ}
  79. $actual_bad_tz_fallback = 1;
  80. }
  81. my $time_zone = {
  82. actual => C4::Context->tz->name,
  83. actual_bad_tz_fallback => $actual_bad_tz_fallback,
  84. config => $config_timezone,
  85. config_invalid => $config_invalid,
  86. environment => $env_timezone,
  87. environment_invalid => $env_invalid
  88. };
  89. { # Logger checks
  90. my $log4perl_config = C4::Context->config("log4perl_conf");
  91. my @log4perl_errors;
  92. if ( ! $log4perl_config ) {
  93. push @log4perl_errors, 'missing_config_entry'
  94. }
  95. else {
  96. my @lines = read_file($log4perl_config) or push @log4perl_errors, 'cannot_read_config_file';
  97. for my $line ( @lines ) {
  98. next unless $line =~ m|log4perl.appender.\w+.filename=(.*)|;
  99. push @log4perl_errors, 'logfile_not_writable' unless -w $1;
  100. }
  101. }
  102. eval {Koha::Logger->get};
  103. push @log4perl_errors, 'cannot_init_module' and warn $@ if $@;
  104. $template->param( log4perl_errors => @log4perl_errors );
  105. }
  106. $template->param(
  107. time_zone => $time_zone,
  108. current_date_and_time => output_pref({ dt => dt_from_string(), dateformat => 'iso' })
  109. );
  110. my $perl_path = $^X;
  111. if ($^O ne 'VMS') {
  112. $perl_path .= $Config{_exe} unless $perl_path =~ m/$Config{_exe}$/i;
  113. }
  114. my $zebraVersion = `zebraidx -V`;
  115. # Check running PSGI env
  116. if ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) {
  117. $template->param(
  118. is_psgi => 1,
  119. psgi_server => ($ENV{ PLACK_ENV }) ? "Plack ($ENV{PLACK_ENV})" :
  120. ($ENV{ MOD_PERL }) ? "mod_perl ($ENV{MOD_PERL})" :
  121. 'Unknown'
  122. );
  123. }
  124. # Memcached configuration
  125. my $memcached_servers = $ENV{MEMCACHED_SERVERS} || C4::Context->config('memcached_servers');
  126. my $memcached_namespace = $ENV{MEMCACHED_NAMESPACE} || C4::Context->config('memcached_namespace') // 'koha';
  127. my $cache = Koha::Caches->get_instance;
  128. my $effective_caching_method = ref($cache->cache);
  129. # Memcached may have been running when plack has been initialized but could have been stopped since
  130. # FIXME What are the consequences of that??
  131. my $is_memcached_still_active = $cache->set_in_cache('test_for_about_page', "just a simple value");
  132. my $where_is_memcached_config = 'nowhere';
  133. if ( $ENV{MEMCACHED_SERVERS} and C4::Context->config('memcached_servers') ) {
  134. $where_is_memcached_config = 'both';
  135. } elsif ( $ENV{MEMCACHED_SERVERS} and not C4::Context->config('memcached_servers') ) {
  136. $where_is_memcached_config = 'ENV_only';
  137. } elsif ( C4::Context->config('memcached_servers') ) {
  138. $where_is_memcached_config = 'config_only';
  139. }
  140. $template->param(
  141. effective_caching_method => $effective_caching_method,
  142. memcached_servers => $memcached_servers,
  143. memcached_namespace => $memcached_namespace,
  144. is_memcached_still_active => $is_memcached_still_active,
  145. where_is_memcached_config => $where_is_memcached_config,
  146. memcached_running => Koha::Caches->get_instance->memcached_cache,
  147. );
  148. # Additional system information for warnings
  149. my $warnStatisticsFieldsError;
  150. my $prefStatisticsFields = C4::Context->preference('StatisticsFields');
  151. if ($prefStatisticsFields) {
  152. $warnStatisticsFieldsError = $prefStatisticsFields
  153. unless ( $prefStatisticsFields eq C4::Members::Statistics->get_fields() );
  154. }
  155. my $prefAutoCreateAuthorities = C4::Context->preference('AutoCreateAuthorities');
  156. my $prefBiblioAddsAuthorities = C4::Context->preference('BiblioAddsAuthorities');
  157. my $warnPrefBiblioAddsAuthorities = ( $prefAutoCreateAuthorities && ( !$prefBiblioAddsAuthorities) );
  158. my $prefEasyAnalyticalRecords = C4::Context->preference('EasyAnalyticalRecords');
  159. my $prefUseControlNumber = C4::Context->preference('UseControlNumber');
  160. my $warnPrefEasyAnalyticalRecords = ( $prefEasyAnalyticalRecords && $prefUseControlNumber );
  161. my $AnonymousPatron = C4::Context->preference('AnonymousPatron');
  162. my $warnPrefAnonymousPatronOPACPrivacy = (
  163. C4::Context->preference('OPACPrivacy')
  164. and not $AnonymousPatron
  165. );
  166. my $warnPrefAnonymousPatronAnonSuggestions = (
  167. C4::Context->preference('AnonSuggestions')
  168. and not $AnonymousPatron
  169. );
  170. my $anonymous_patron = Koha::Patrons->find( $AnonymousPatron );
  171. my $warnPrefAnonymousPatronAnonSuggestions_PatronDoesNotExist = ( $AnonymousPatron && C4::Context->preference('AnonSuggestions') && not $anonymous_patron );
  172. my $warnPrefAnonymousPatronOPACPrivacy_PatronDoesNotExist = ( not $anonymous_patron and Koha::Patrons->search({ privacy => 2 })->count );
  173. my $warnPrefKohaAdminEmailAddress = not Email::Valid->address(C4::Context->preference('KohaAdminEmailAddress'));
  174. my $errZebraConnection = C4::Context->Zconn("biblioserver",0)->errcode();
  175. my $warnIsRootUser = (! $loggedinuser);
  176. my $warnNoActiveCurrency = (! defined Koha::Acquisition::Currencies->get_active);
  177. my @xml_config_warnings;
  178. my $context = C4::Context->new;
  179. if ( C4::Context->config('zebra_bib_index_mode')
  180. and C4::Context->config('zebra_bib_index_mode') eq 'grs1' )
  181. {
  182. push @xml_config_warnings, { error => 'zebra_bib_index_mode_is_grs1' };
  183. }
  184. if ( C4::Context->config('zebra_auth_index_mode')
  185. and C4::Context->config('zebra_auth_index_mode') eq 'grs1' )
  186. {
  187. push @xml_config_warnings, { error => 'zebra_auth_index_mode_is_grs1' };
  188. }
  189. if( ( C4::Context->config('zebra_auth_index_mode')
  190. and C4::Context->config('zebra_auth_index_mode') eq 'dom' )
  191. && ( $context->{'server'}->{'authorityserver'}->{'config'} !~ /zebra-authorities-dom.cfg/ ) )
  192. {
  193. push @xml_config_warnings, {
  194. error => 'zebra_auth_index_mode_mismatch_warn'
  195. };
  196. }
  197. if ( ! defined C4::Context->config('log4perl_conf') ) {
  198. push @xml_config_warnings, {
  199. error => 'log4perl_entry_missing'
  200. }
  201. }
  202. if ( ! defined C4::Context->config('lockdir') ) {
  203. push @xml_config_warnings, {
  204. error => 'lockdir_entry_missing'
  205. }
  206. }
  207. else {
  208. unless ( -w C4::Context->config('lockdir') ) {
  209. push @xml_config_warnings, {
  210. error => 'lockdir_not_writable',
  211. lockdir => C4::Context->config('lockdir')
  212. }
  213. }
  214. }
  215. if ( ! defined C4::Context->config('upload_path') ) {
  216. if ( Koha::Config::SysPrefs->find('OPACBaseURL')->value ) {
  217. # OPACBaseURL seems to be set
  218. push @xml_config_warnings, {
  219. error => 'uploadpath_entry_missing'
  220. }
  221. } else {
  222. push @xml_config_warnings, {
  223. error => 'uploadpath_and_opacbaseurl_entry_missing'
  224. }
  225. }
  226. }
  227. if ( ! C4::Context->config('tmp_path') ) {
  228. my $temporary_directory = C4::Context::temporary_directory;
  229. push @xml_config_warnings, {
  230. error => 'tmp_path_missing',
  231. effective_tmp_dir => $temporary_directory,
  232. }
  233. }
  234. # Test Zebra facets configuration
  235. if ( !defined C4::Context->config('use_zebra_facets') ) {
  236. push @xml_config_warnings, { error => 'use_zebra_facets_entry_missing' };
  237. }
  238. # ILL module checks
  239. if ( C4::Context->preference('ILLModule') ) {
  240. my $warnILLConfiguration = 0;
  241. my $ill_config_from_file = C4::Context->config("interlibrary_loans");
  242. my $ill_config = Koha::Illrequest::Config->new;
  243. my $available_ill_backends =
  244. ( scalar @{ $ill_config->available_backends } > 0 );
  245. # Check backends
  246. if ( !$available_ill_backends ) {
  247. $template->param( no_ill_backends => 1 );
  248. $warnILLConfiguration = 1;
  249. }
  250. # Check partner_code
  251. if ( !Koha::Patron::Categories->find($ill_config->partner_code) ) {
  252. $template->param( ill_partner_code_doesnt_exist => $ill_config->partner_code );
  253. $warnILLConfiguration = 1;
  254. }
  255. if ( !$ill_config_from_file->{partner_code} ) {
  256. # partner code not defined
  257. $template->param( ill_partner_code_not_defined => 1 );
  258. $warnILLConfiguration = 1;
  259. }
  260. if ( !$ill_config_from_file->{branch} ) {
  261. # branch not defined
  262. $template->param( ill_branch_not_defined => 1 );
  263. $warnILLConfiguration = 1;
  264. }
  265. $template->param( warnILLConfiguration => $warnILLConfiguration );
  266. }
  267. if ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' ) {
  268. # Check ES configuration health and runtime status
  269. my $es_status;
  270. my $es_config_error;
  271. my $es_running = 1;
  272. my $es_conf;
  273. try {
  274. $es_conf = Koha::SearchEngine::Elasticsearch::_read_configuration();
  275. }
  276. catch {
  277. if ( ref($_) eq 'Koha::Exceptions::Config::MissingEntry' ) {
  278. $template->param( elasticsearch_fatal_config_error => $_->message );
  279. $es_config_error = 1;
  280. }
  281. };
  282. if ( !$es_config_error ) {
  283. my $biblios_index_name = $es_conf->{index_name} . "_" . $Koha::SearchEngine::BIBLIOS_INDEX;
  284. my $authorities_index_name = $es_conf->{index_name} . "_" . $Koha::SearchEngine::AUTHORITIES_INDEX;
  285. my @indexes = ($biblios_index_name, $authorities_index_name);
  286. # TODO: When new indexes get added, we could have other ways to
  287. # fetch the list of available indexes (e.g. plugins, etc)
  288. $es_status->{nodes} = $es_conf->{nodes};
  289. my $es = Search::Elasticsearch->new({ nodes => $es_conf->{nodes} });
  290. my $es_status->{version} = $es->info->{version}->{number};
  291. foreach my $index ( @indexes ) {
  292. my $count;
  293. try {
  294. $count = $es->indices->stats( index => $index )
  295. ->{_all}{primaries}{docs}{count};
  296. }
  297. catch {
  298. if ( ref($_) eq 'Search::Elasticsearch::Error::Missing' ) {
  299. push @{ $es_status->{errors} }, "Index not found ($index)";
  300. $count = -1;
  301. }
  302. elsif ( ref($_) eq 'Search::Elasticsearch::Error::NoNodes' ) {
  303. $es_running = 0;
  304. }
  305. else {
  306. # TODO: when time comes, we will cover more use cases
  307. die $_;
  308. }
  309. };
  310. push @{ $es_status->{indexes} },
  311. {
  312. index_name => $index,
  313. count => $count
  314. };
  315. }
  316. $es_status->{running} = $es_running;
  317. $template->param( elasticsearch_status => $es_status );
  318. }
  319. }
  320. if ( C4::Context->preference('RESTOAuth2ClientCredentials') ) {
  321. # Do we have the required deps?
  322. unless ( can_load( modules => { 'Net::OAuth2::AuthorizationServer' => undef }) ) {
  323. $template->param( oauth2_missing_deps => 1 );
  324. }
  325. }
  326. # Sco Patron should not contain any other perms than circulate => self_checkout
  327. if ( C4::Context->preference('WebBasedSelfCheck')
  328. and C4::Context->preference('AutoSelfCheckAllowed')
  329. ) {
  330. my $userid = C4::Context->preference('AutoSelfCheckID');
  331. my $all_permissions = C4::Auth::get_user_subpermissions( $userid );
  332. my ( $has_self_checkout_perm, $has_other_permissions );
  333. while ( my ( $module, $permissions ) = each %$all_permissions ) {
  334. if ( $module eq 'self_check' ) {
  335. while ( my ( $permission, $flag ) = each %$permissions ) {
  336. if ( $permission eq 'self_checkout_module' ) {
  337. $has_self_checkout_perm = 1;
  338. } else {
  339. $has_other_permissions = 1;
  340. }
  341. }
  342. } else {
  343. $has_other_permissions = 1;
  344. }
  345. }
  346. $template->param(
  347. AutoSelfCheckPatronDoesNotHaveSelfCheckPerm => not ( $has_self_checkout_perm ),
  348. AutoSelfCheckPatronHasTooManyPerm => $has_other_permissions,
  349. );
  350. }
  351. if ( C4::Context->preference('EnablePayPalOpacPayments') ) {
  352. $template->param( paypal_enabled => 1 );
  353. }
  354. # Test YAML system preferences
  355. # FIXME: This is list of current YAML formatted prefs, should by type of preference
  356. my @yaml_prefs = (
  357. "UpdateNotForLoanStatusOnCheckin",
  358. "OpacHiddenItems",
  359. "BibtexExportAdditionalFields",
  360. "RisExportAdditionalFields",
  361. "UpdateItemWhenLostFromHoldList",
  362. "MarcFieldsToOrder",
  363. "MarcItemFieldsToOrder",
  364. "UpdateitemLocationOnCheckin",
  365. "ItemsDeniedRenewal"
  366. );
  367. my @bad_yaml_prefs;
  368. foreach my $syspref (@yaml_prefs) {
  369. my $yaml = C4::Context->preference( $syspref );
  370. if ( $yaml ) {
  371. eval { YAML::XS::Load( Encode::encode_utf8("$yaml\n\n") ); };
  372. if ($@) {
  373. push @bad_yaml_prefs, $syspref;
  374. }
  375. }
  376. }
  377. $template->param( 'bad_yaml_prefs' => \@bad_yaml_prefs ) if @bad_yaml_prefs;
  378. {
  379. my $dbh = C4::Context->dbh;
  380. my $patrons = $dbh->selectall_arrayref(
  381. q|select b.borrowernumber from borrowers b join deletedborrowers db on b.borrowernumber=db.borrowernumber|,
  382. { Slice => {} }
  383. );
  384. my $biblios = $dbh->selectall_arrayref(
  385. q|select b.biblionumber from biblio b join deletedbiblio db on b.biblionumber=db.biblionumber|,
  386. { Slice => {} }
  387. );
  388. my $items = $dbh->selectall_arrayref(
  389. q|select i.itemnumber from items i join deleteditems di on i.itemnumber=di.itemnumber|,
  390. { Slice => {} }
  391. );
  392. my $checkouts = $dbh->selectall_arrayref(
  393. q|select i.issue_id from issues i join old_issues oi on i.issue_id=oi.issue_id|,
  394. { Slice => {} }
  395. );
  396. my $holds = $dbh->selectall_arrayref(
  397. q|select r.reserve_id from reserves r join old_reserves o on r.reserve_id=o.reserve_id|,
  398. { Slice => {} }
  399. );
  400. if ( @$patrons or @$biblios or @$items or @$checkouts or @$holds ) {
  401. $template->param(
  402. has_ai_issues => 1,
  403. ai_patrons => $patrons,
  404. ai_biblios => $biblios,
  405. ai_items => $items,
  406. ai_checkouts => $checkouts,
  407. ai_holds => $holds,
  408. );
  409. }
  410. }
  411. # Circ rule warnings
  412. {
  413. my $dbh = C4::Context->dbh;
  414. my $units = Koha::CirculationRules->search({ rule_name => 'lengthunit', rule_value => { -not_in => ['days', 'hours'] } });
  415. if ( $units->count ) {
  416. $template->param(
  417. warnIssuingRules => 1,
  418. ir_units => $units,
  419. );
  420. }
  421. }
  422. # Guarantor relationships warnings
  423. {
  424. my $dbh = C4::Context->dbh;
  425. my ($bad_relationships_count) = $dbh->selectall_arrayref(q{
  426. SELECT COUNT(*)
  427. FROM (
  428. SELECT relationship FROM borrower_relationships WHERE relationship='_bad_data'
  429. UNION ALL
  430. SELECT relationship FROM borrowers WHERE relationship='_bad_data') a
  431. });
  432. $bad_relationships_count = $bad_relationships_count->[0]->[0];
  433. my $existing_relationships = $dbh->selectall_arrayref(q{
  434. SELECT DISTINCT(relationship)
  435. FROM (
  436. SELECT relationship FROM borrower_relationships WHERE relationship IS NOT NULL
  437. UNION ALL
  438. SELECT relationship FROM borrowers WHERE relationship IS NOT NULL) a
  439. });
  440. my %valid_relationships = map { $_ => 1 } split( /,|\|/, C4::Context->preference('borrowerRelationship') );
  441. $valid_relationships{ _bad_data } = 1; # we handle this case in another way
  442. my $wrong_relationships = [ grep { !$valid_relationships{ $_->[0] } } @{$existing_relationships} ];
  443. if ( @$wrong_relationships or $bad_relationships_count ) {
  444. $template->param(
  445. warnRelationships => 1,
  446. );
  447. if ( $wrong_relationships ) {
  448. $template->param(
  449. wrong_relationships => $wrong_relationships
  450. );
  451. }
  452. if ($bad_relationships_count) {
  453. $template->param(
  454. bad_relationships_count => $bad_relationships_count,
  455. );
  456. }
  457. }
  458. }
  459. {
  460. # Test 'bcrypt_settings' config for Pseudonymization
  461. $template->param( config_bcrypt_settings_no_set => 1 )
  462. if C4::Context->preference('Pseudonymization')
  463. and not C4::Context->config('bcrypt_settings');
  464. }
  465. {
  466. my @frameworkcodes = Koha::BiblioFrameworks->search->get_column('frameworkcode');
  467. my @hidden_biblionumbers;
  468. push @frameworkcodes, ""; # it's not in the biblio_frameworks table!
  469. for my $frameworkcode ( @frameworkcodes ) {
  470. my $shouldhidemarc_opac = Koha::Filter::MARC::ViewPolicy->should_hide_marc(
  471. {
  472. frameworkcode => $frameworkcode,
  473. interface => "opac"
  474. }
  475. );
  476. push @hidden_biblionumbers, { frameworkcode => $frameworkcode, interface => 'opac' }
  477. if $shouldhidemarc_opac->{biblionumber};
  478. my $shouldhidemarc_intranet = Koha::Filter::MARC::ViewPolicy->should_hide_marc(
  479. {
  480. frameworkcode => $frameworkcode,
  481. interface => "intranet"
  482. }
  483. );
  484. push @hidden_biblionumbers, { frameworkcode => $frameworkcode, interface => 'intranet' }
  485. if $shouldhidemarc_intranet->{biblionumber};
  486. }
  487. $template->param( warnHiddenBiblionumbers => \@hidden_biblionumbers );
  488. }
  489. {
  490. # BackgroundJob - test connection to message broker
  491. eval {
  492. Koha::BackgroundJob->connect;
  493. };
  494. if ( $@ ) {
  495. warn $@;
  496. $template->param( warnConnectBroker => $@ );
  497. }
  498. }
  499. my %versions = C4::Context::get_versions();
  500. $template->param(
  501. kohaVersion => $versions{'kohaVersion'},
  502. osVersion => $versions{'osVersion'},
  503. perlPath => $perl_path,
  504. perlVersion => $versions{'perlVersion'},
  505. perlIncPath => [ map { perlinc => $_ }, @INC ],
  506. mysqlVersion => $versions{'mysqlVersion'},
  507. apacheVersion => $versions{'apacheVersion'},
  508. zebraVersion => $zebraVersion,
  509. prefBiblioAddsAuthorities => $prefBiblioAddsAuthorities,
  510. prefAutoCreateAuthorities => $prefAutoCreateAuthorities,
  511. warnPrefBiblioAddsAuthorities => $warnPrefBiblioAddsAuthorities,
  512. warnPrefEasyAnalyticalRecords => $warnPrefEasyAnalyticalRecords,
  513. warnPrefAnonymousPatronOPACPrivacy => $warnPrefAnonymousPatronOPACPrivacy,
  514. warnPrefAnonymousPatronAnonSuggestions => $warnPrefAnonymousPatronAnonSuggestions,
  515. warnPrefAnonymousPatronOPACPrivacy_PatronDoesNotExist => $warnPrefAnonymousPatronOPACPrivacy_PatronDoesNotExist,
  516. warnPrefAnonymousPatronAnonSuggestions_PatronDoesNotExist => $warnPrefAnonymousPatronAnonSuggestions_PatronDoesNotExist,
  517. warnPrefKohaAdminEmailAddress => $warnPrefKohaAdminEmailAddress,
  518. errZebraConnection => $errZebraConnection,
  519. warnIsRootUser => $warnIsRootUser,
  520. warnNoActiveCurrency => $warnNoActiveCurrency,
  521. warnNoTemplateCaching => ( C4::Context->config('template_cache_dir') ? 0 : 1 ),
  522. xml_config_warnings => \@xml_config_warnings,
  523. warnStatisticsFieldsError => $warnStatisticsFieldsError,
  524. );
  525. my @components = ();
  526. my $perl_modules = C4::Installer::PerlModules->new;
  527. $perl_modules->versions_info;
  528. my @pm_types = qw(missing_pm upgrade_pm current_pm);
  529. foreach my $pm_type(@pm_types) {
  530. my $modules = $perl_modules->get_attr($pm_type);
  531. foreach (@$modules) {
  532. my ($module, $stats) = each %$_;
  533. push(
  534. @components,
  535. {
  536. name => $module,
  537. version => $stats->{'cur_ver'},
  538. missing => ($pm_type eq 'missing_pm' ? 1 : 0),
  539. upgrade => ($pm_type eq 'upgrade_pm' ? 1 : 0),
  540. current => ($pm_type eq 'current_pm' ? 1 : 0),
  541. require => $stats->{'required'},
  542. reqversion => $stats->{'min_ver'},
  543. maxversion => $stats->{'max_ver'},
  544. excversion => $stats->{'exc_ver'}
  545. }
  546. );
  547. }
  548. }
  549. @components = sort {$a->{'name'} cmp $b->{'name'}} @components;
  550. my $counter=0;
  551. my $row = [];
  552. my $table = [];
  553. foreach (@components) {
  554. push (@$row, $_);
  555. unless (++$counter % 4) {
  556. push (@$table, {row => $row});
  557. $row = [];
  558. }
  559. }
  560. # Processing the last line (if there are any modules left)
  561. if (scalar(@$row) > 0) {
  562. # Extending $row to the table size
  563. $$row[3] = '';
  564. # Pushing the last line
  565. push (@$table, {row => $row});
  566. }
  567. ## ## $table
  568. $template->param( table => $table );
  569. ## ------------------------------------------
  570. ## Koha contributions
  571. my $docdir;
  572. if ( defined C4::Context->config('docdir') ) {
  573. $docdir = C4::Context->config('docdir');
  574. } else {
  575. # if no <docdir> is defined in koha-conf.xml, use the default location
  576. # this is a work-around to stop breakage on upgraded Kohas, bug 8911
  577. $docdir = C4::Context->config('intranetdir') . '/docs';
  578. }
  579. ## Release teams
  580. my $teams =
  581. -e "$docdir" . "/teams.yaml"
  582. ? YAML::XS::LoadFile( "$docdir" . "/teams.yaml" )
  583. : {};
  584. my $dev_team = (sort {$b <=> $a} (keys %{$teams->{team}}))[0];
  585. my $short_version = substr($versions{'kohaVersion'},0,5);
  586. my $minor = substr($versions{'kohaVersion'},3,2);
  587. my $development_version = ( $minor eq '05' || $minor eq '11' ) ? 0 : 1;
  588. $template->param( short_version => $short_version );
  589. $template->param( development_version => $development_version );
  590. ## Contributors
  591. my $contributors =
  592. -e "$docdir" . "/contributors.yaml"
  593. ? YAML::XS::LoadFile( "$docdir" . "/contributors.yaml" )
  594. : {};
  595. for my $version ( sort { $a <=> $b } keys %{$teams->{team}} ) {
  596. for my $role ( keys %{ $teams->{team}->{$version} } ) {
  597. my $normalized_role = "$role";
  598. $normalized_role =~ s/s$//;
  599. if ( ref( $teams->{team}->{$version}->{$role} ) eq 'ARRAY' ) {
  600. for my $contributor ( @{ $teams->{team}->{$version}->{$role} } ) {
  601. my $name = $contributor->{name};
  602. # Add role to contributors
  603. push @{ $contributors->{$name}->{roles}->{$normalized_role} },
  604. $version;
  605. # Add openhub to teams
  606. if ( exists( $contributors->{$name}->{openhub} ) ) {
  607. $contributor->{openhub} = $contributors->{$name}->{openhub};
  608. }
  609. }
  610. }
  611. elsif ( $role ne 'release_date' ) {
  612. my $name = $teams->{team}->{$version}->{$role}->{name};
  613. # Add role to contributors
  614. push @{ $contributors->{$name}->{roles}->{$normalized_role} },
  615. $version;
  616. # Add openhub to teams
  617. if ( exists( $contributors->{$name}->{openhub} ) ) {
  618. $teams->{team}->{$version}->{$role}->{openhub} =
  619. $contributors->{$name}->{openhub};
  620. }
  621. }
  622. else {
  623. $teams->{team}->{$version}->{$role} = DateTime->from_epoch( epoch => $teams->{team}->{$version}->{$role});
  624. }
  625. }
  626. }
  627. ## Create last name ordered array of people from contributors
  628. my @people = map {
  629. { name => $_, ( $contributors->{$_} ? %{ $contributors->{$_} } : () ) }
  630. } sort {
  631. my ($alast) = ( split( /\s/, $a ) )[-1];
  632. my ($blast) = ( split( /\s/, $b ) )[-1];
  633. lc($alast) cmp lc($blast)
  634. } keys %{$contributors};
  635. $template->param( contributors => \@people );
  636. $template->param( maintenance_team => $teams->{team}->{$dev_team} );
  637. $template->param( release_team => $teams->{team}->{$short_version} );
  638. ## Timeline
  639. if ( open( my $file, "<:encoding(UTF-8)", "$docdir" . "/history.txt" ) ) {
  640. my $i = 0;
  641. my @rows2 = ();
  642. my $row2 = [];
  643. my @lines = <$file>;
  644. close($file);
  645. shift @lines; #remove header row
  646. foreach (@lines) {
  647. my ( $epoch, $date, $desc, $tag ) = split(/\t/);
  648. if(!$desc && $date=~ /(?<=\d{4})\s+/) {
  649. ($date, $desc)= ($`, $');
  650. }
  651. push(
  652. @rows2,
  653. {
  654. date => $date,
  655. desc => $desc,
  656. }
  657. );
  658. }
  659. my $table2 = [];
  660. #foreach my $row2 (@rows2) {
  661. foreach (@rows2) {
  662. push (@$row2, $_);
  663. push( @$table2, { row2 => $row2 } );
  664. $row2 = [];
  665. }
  666. $template->param( table2 => $table2 );
  667. } else {
  668. $template->param( timeline_read_error => 1 );
  669. }
  670. output_html_with_http_headers $query, $cookie, $template->output;