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.
 
 
 
 
 
 

785 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 $c = Koha::Items->filter_by_visible_in_opac->count;
  175. my @warnings = C4::Context->dbh->selectrow_array('SHOW WARNINGS');
  176. my $warnPrefOpacHiddenItems = $warnings[2];
  177. my $invalid_yesno = Koha::Config::SysPrefs->search(
  178. {
  179. type => 'YesNo',
  180. value => { -or => { 'is' => undef, -not_in => [ "1", "0" ] } }
  181. }
  182. );
  183. $template->param( invalid_yesno => $invalid_yesno );
  184. my $errZebraConnection = C4::Context->Zconn("biblioserver",0)->errcode();
  185. my $warnIsRootUser = (! $loggedinuser);
  186. my $warnNoActiveCurrency = (! defined Koha::Acquisition::Currencies->get_active);
  187. my @xml_config_warnings;
  188. if ( C4::Context->config('zebra_bib_index_mode')
  189. and C4::Context->config('zebra_bib_index_mode') eq 'grs1' )
  190. {
  191. push @xml_config_warnings, { error => 'zebra_bib_index_mode_is_grs1' };
  192. }
  193. if ( C4::Context->config('zebra_auth_index_mode')
  194. and C4::Context->config('zebra_auth_index_mode') eq 'grs1' )
  195. {
  196. push @xml_config_warnings, { error => 'zebra_auth_index_mode_is_grs1' };
  197. }
  198. my $authorityserver = C4::Context->zebraconfig('authorityserver');
  199. if( ( C4::Context->config('zebra_auth_index_mode')
  200. and C4::Context->config('zebra_auth_index_mode') eq 'dom' )
  201. && ( $authorityserver->{config} !~ /zebra-authorities-dom.cfg/ ) )
  202. {
  203. push @xml_config_warnings, {
  204. error => 'zebra_auth_index_mode_mismatch_warn'
  205. };
  206. }
  207. if ( ! defined C4::Context->config('log4perl_conf') ) {
  208. push @xml_config_warnings, {
  209. error => 'log4perl_entry_missing'
  210. }
  211. }
  212. if ( ! defined C4::Context->config('lockdir') ) {
  213. push @xml_config_warnings, {
  214. error => 'lockdir_entry_missing'
  215. }
  216. }
  217. else {
  218. unless ( -w C4::Context->config('lockdir') ) {
  219. push @xml_config_warnings, {
  220. error => 'lockdir_not_writable',
  221. lockdir => C4::Context->config('lockdir')
  222. }
  223. }
  224. }
  225. if ( ! defined C4::Context->config('upload_path') ) {
  226. if ( Koha::Config::SysPrefs->find('OPACBaseURL')->value ) {
  227. # OPACBaseURL seems to be set
  228. push @xml_config_warnings, {
  229. error => 'uploadpath_entry_missing'
  230. }
  231. } else {
  232. push @xml_config_warnings, {
  233. error => 'uploadpath_and_opacbaseurl_entry_missing'
  234. }
  235. }
  236. }
  237. if ( ! C4::Context->config('tmp_path') ) {
  238. my $temporary_directory = C4::Context::temporary_directory;
  239. push @xml_config_warnings, {
  240. error => 'tmp_path_missing',
  241. effective_tmp_dir => $temporary_directory,
  242. }
  243. }
  244. # Test Zebra facets configuration
  245. if ( !defined C4::Context->config('use_zebra_facets') ) {
  246. push @xml_config_warnings, { error => 'use_zebra_facets_entry_missing' };
  247. }
  248. # ILL module checks
  249. if ( C4::Context->preference('ILLModule') ) {
  250. my $warnILLConfiguration = 0;
  251. my $ill_config_from_file = C4::Context->config("interlibrary_loans");
  252. my $ill_config = Koha::Illrequest::Config->new;
  253. my $available_ill_backends =
  254. ( scalar @{ $ill_config->available_backends } > 0 );
  255. # Check backends
  256. if ( !$available_ill_backends ) {
  257. $template->param( no_ill_backends => 1 );
  258. $warnILLConfiguration = 1;
  259. }
  260. # Check partner_code
  261. if ( !Koha::Patron::Categories->find($ill_config->partner_code) ) {
  262. $template->param( ill_partner_code_doesnt_exist => $ill_config->partner_code );
  263. $warnILLConfiguration = 1;
  264. }
  265. if ( !$ill_config_from_file->{partner_code} ) {
  266. # partner code not defined
  267. $template->param( ill_partner_code_not_defined => 1 );
  268. $warnILLConfiguration = 1;
  269. }
  270. if ( !$ill_config_from_file->{branch} ) {
  271. # branch not defined
  272. $template->param( ill_branch_not_defined => 1 );
  273. $warnILLConfiguration = 1;
  274. }
  275. $template->param( warnILLConfiguration => $warnILLConfiguration );
  276. }
  277. if ( C4::Context->preference('SearchEngine') eq 'Elasticsearch' ) {
  278. # Check ES configuration health and runtime status
  279. my $es_status;
  280. my $es_config_error;
  281. my $es_running = 1;
  282. my $es_conf;
  283. try {
  284. $es_conf = Koha::SearchEngine::Elasticsearch::_read_configuration();
  285. }
  286. catch {
  287. if ( ref($_) eq 'Koha::Exceptions::Config::MissingEntry' ) {
  288. $template->param( elasticsearch_fatal_config_error => $_->message );
  289. $es_config_error = 1;
  290. }
  291. };
  292. if ( !$es_config_error ) {
  293. my $biblios_index_name = $es_conf->{index_name} . "_" . $Koha::SearchEngine::BIBLIOS_INDEX;
  294. my $authorities_index_name = $es_conf->{index_name} . "_" . $Koha::SearchEngine::AUTHORITIES_INDEX;
  295. my @indexes = ($biblios_index_name, $authorities_index_name);
  296. # TODO: When new indexes get added, we could have other ways to
  297. # fetch the list of available indexes (e.g. plugins, etc)
  298. $es_status->{nodes} = $es_conf->{nodes};
  299. my $es = Search::Elasticsearch->new({ nodes => $es_conf->{nodes} });
  300. my $es_status->{version} = $es->info->{version}->{number};
  301. foreach my $index ( @indexes ) {
  302. my $count;
  303. try {
  304. $count = $es->indices->stats( index => $index )
  305. ->{_all}{primaries}{docs}{count};
  306. }
  307. catch {
  308. if ( ref($_) eq 'Search::Elasticsearch::Error::Missing' ) {
  309. push @{ $es_status->{errors} }, "Index not found ($index)";
  310. $count = -1;
  311. }
  312. elsif ( ref($_) eq 'Search::Elasticsearch::Error::NoNodes' ) {
  313. $es_running = 0;
  314. }
  315. else {
  316. # TODO: when time comes, we will cover more use cases
  317. die $_;
  318. }
  319. };
  320. push @{ $es_status->{indexes} },
  321. {
  322. index_name => $index,
  323. count => $count
  324. };
  325. }
  326. $es_status->{running} = $es_running;
  327. $template->param( elasticsearch_status => $es_status );
  328. }
  329. }
  330. if ( C4::Context->preference('RESTOAuth2ClientCredentials') ) {
  331. # Do we have the required deps?
  332. unless ( can_load( modules => { 'Net::OAuth2::AuthorizationServer' => undef }) ) {
  333. $template->param( oauth2_missing_deps => 1 );
  334. }
  335. }
  336. # Sco Patron should not contain any other perms than circulate => self_checkout
  337. if ( C4::Context->preference('WebBasedSelfCheck')
  338. and C4::Context->preference('AutoSelfCheckAllowed')
  339. ) {
  340. my $userid = C4::Context->preference('AutoSelfCheckID');
  341. my $all_permissions = C4::Auth::get_user_subpermissions( $userid );
  342. my ( $has_self_checkout_perm, $has_other_permissions );
  343. while ( my ( $module, $permissions ) = each %$all_permissions ) {
  344. if ( $module eq 'self_check' ) {
  345. while ( my ( $permission, $flag ) = each %$permissions ) {
  346. if ( $permission eq 'self_checkout_module' ) {
  347. $has_self_checkout_perm = 1;
  348. } else {
  349. $has_other_permissions = 1;
  350. }
  351. }
  352. } else {
  353. $has_other_permissions = 1;
  354. }
  355. }
  356. $template->param(
  357. AutoSelfCheckPatronDoesNotHaveSelfCheckPerm => not ( $has_self_checkout_perm ),
  358. AutoSelfCheckPatronHasTooManyPerm => $has_other_permissions,
  359. );
  360. }
  361. # Test YAML system preferences
  362. # FIXME: This is list of current YAML formatted prefs, should by type of preference
  363. my @yaml_prefs = (
  364. "UpdateNotForLoanStatusOnCheckin",
  365. "OpacHiddenItems",
  366. "BibtexExportAdditionalFields",
  367. "RisExportAdditionalFields",
  368. "UpdateItemWhenLostFromHoldList",
  369. "MarcFieldsToOrder",
  370. "MarcItemFieldsToOrder",
  371. "UpdateitemLocationOnCheckin",
  372. "ItemsDeniedRenewal"
  373. );
  374. my @bad_yaml_prefs;
  375. foreach my $syspref (@yaml_prefs) {
  376. my $yaml = C4::Context->preference( $syspref );
  377. if ( $yaml ) {
  378. eval { YAML::XS::Load( Encode::encode_utf8("$yaml\n\n") ); };
  379. if ($@) {
  380. push @bad_yaml_prefs, $syspref;
  381. }
  382. }
  383. }
  384. $template->param( 'bad_yaml_prefs' => \@bad_yaml_prefs ) if @bad_yaml_prefs;
  385. {
  386. my $dbh = C4::Context->dbh;
  387. my $patrons = $dbh->selectall_arrayref(
  388. q|select b.borrowernumber from borrowers b join deletedborrowers db on b.borrowernumber=db.borrowernumber|,
  389. { Slice => {} }
  390. );
  391. my $biblios = $dbh->selectall_arrayref(
  392. q|select b.biblionumber from biblio b join deletedbiblio db on b.biblionumber=db.biblionumber|,
  393. { Slice => {} }
  394. );
  395. my $items = $dbh->selectall_arrayref(
  396. q|select i.itemnumber from items i join deleteditems di on i.itemnumber=di.itemnumber|,
  397. { Slice => {} }
  398. );
  399. my $checkouts = $dbh->selectall_arrayref(
  400. q|select i.issue_id from issues i join old_issues oi on i.issue_id=oi.issue_id|,
  401. { Slice => {} }
  402. );
  403. my $holds = $dbh->selectall_arrayref(
  404. q|select r.reserve_id from reserves r join old_reserves o on r.reserve_id=o.reserve_id|,
  405. { Slice => {} }
  406. );
  407. if ( @$patrons or @$biblios or @$items or @$checkouts or @$holds ) {
  408. $template->param(
  409. has_ai_issues => 1,
  410. ai_patrons => $patrons,
  411. ai_biblios => $biblios,
  412. ai_items => $items,
  413. ai_checkouts => $checkouts,
  414. ai_holds => $holds,
  415. );
  416. }
  417. }
  418. # Circ rule warnings
  419. {
  420. my $dbh = C4::Context->dbh;
  421. my $units = Koha::CirculationRules->search({ rule_name => 'lengthunit', rule_value => { -not_in => ['days', 'hours'] } });
  422. if ( $units->count ) {
  423. $template->param(
  424. warnIssuingRules => 1,
  425. ir_units => $units,
  426. );
  427. }
  428. }
  429. # Guarantor relationships warnings
  430. {
  431. my $dbh = C4::Context->dbh;
  432. my ($bad_relationships_count) = $dbh->selectall_arrayref(q{
  433. SELECT COUNT(*)
  434. FROM (
  435. SELECT relationship FROM borrower_relationships WHERE relationship='_bad_data'
  436. UNION ALL
  437. SELECT relationship FROM borrowers WHERE relationship='_bad_data') a
  438. });
  439. $bad_relationships_count = $bad_relationships_count->[0]->[0];
  440. my $existing_relationships = $dbh->selectall_arrayref(q{
  441. SELECT DISTINCT(relationship)
  442. FROM (
  443. SELECT relationship FROM borrower_relationships WHERE relationship IS NOT NULL
  444. UNION ALL
  445. SELECT relationship FROM borrowers WHERE relationship IS NOT NULL) a
  446. });
  447. my %valid_relationships = map { $_ => 1 } split( /,|\|/, C4::Context->preference('borrowerRelationship') );
  448. $valid_relationships{ _bad_data } = 1; # we handle this case in another way
  449. my $wrong_relationships = [ grep { !$valid_relationships{ $_->[0] } } @{$existing_relationships} ];
  450. if ( @$wrong_relationships or $bad_relationships_count ) {
  451. $template->param(
  452. warnRelationships => 1,
  453. );
  454. if ( $wrong_relationships ) {
  455. $template->param(
  456. wrong_relationships => $wrong_relationships
  457. );
  458. }
  459. if ($bad_relationships_count) {
  460. $template->param(
  461. bad_relationships_count => $bad_relationships_count,
  462. );
  463. }
  464. }
  465. }
  466. {
  467. # Test 'bcrypt_settings' config for Pseudonymization
  468. $template->param( config_bcrypt_settings_no_set => 1 )
  469. if C4::Context->preference('Pseudonymization')
  470. and not C4::Context->config('bcrypt_settings');
  471. }
  472. {
  473. my @frameworkcodes = Koha::BiblioFrameworks->search->get_column('frameworkcode');
  474. my @hidden_biblionumbers;
  475. push @frameworkcodes, ""; # it's not in the biblio_frameworks table!
  476. for my $frameworkcode ( @frameworkcodes ) {
  477. my $shouldhidemarc_opac = Koha::Filter::MARC::ViewPolicy->should_hide_marc(
  478. {
  479. frameworkcode => $frameworkcode,
  480. interface => "opac"
  481. }
  482. );
  483. push @hidden_biblionumbers, { frameworkcode => $frameworkcode, interface => 'opac' }
  484. if $shouldhidemarc_opac->{biblionumber};
  485. my $shouldhidemarc_intranet = Koha::Filter::MARC::ViewPolicy->should_hide_marc(
  486. {
  487. frameworkcode => $frameworkcode,
  488. interface => "intranet"
  489. }
  490. );
  491. push @hidden_biblionumbers, { frameworkcode => $frameworkcode, interface => 'intranet' }
  492. if $shouldhidemarc_intranet->{biblionumber};
  493. }
  494. $template->param( warnHiddenBiblionumbers => \@hidden_biblionumbers );
  495. }
  496. {
  497. # BackgroundJob - test connection to message broker
  498. eval {
  499. Koha::BackgroundJob->connect;
  500. };
  501. if ( $@ ) {
  502. warn $@;
  503. $template->param( warnConnectBroker => $@ );
  504. }
  505. }
  506. my %versions = C4::Context::get_versions();
  507. $template->param(
  508. kohaVersion => $versions{'kohaVersion'},
  509. osVersion => $versions{'osVersion'},
  510. perlPath => $perl_path,
  511. perlVersion => $versions{'perlVersion'},
  512. perlIncPath => [ map { perlinc => $_ }, @INC ],
  513. mysqlVersion => $versions{'mysqlVersion'},
  514. apacheVersion => $versions{'apacheVersion'},
  515. zebraVersion => $zebraVersion,
  516. prefBiblioAddsAuthorities => $prefBiblioAddsAuthorities,
  517. prefAutoCreateAuthorities => $prefAutoCreateAuthorities,
  518. warnPrefBiblioAddsAuthorities => $warnPrefBiblioAddsAuthorities,
  519. warnPrefEasyAnalyticalRecords => $warnPrefEasyAnalyticalRecords,
  520. warnPrefAnonymousPatronOPACPrivacy => $warnPrefAnonymousPatronOPACPrivacy,
  521. warnPrefAnonymousPatronAnonSuggestions => $warnPrefAnonymousPatronAnonSuggestions,
  522. warnPrefAnonymousPatronOPACPrivacy_PatronDoesNotExist => $warnPrefAnonymousPatronOPACPrivacy_PatronDoesNotExist,
  523. warnPrefAnonymousPatronAnonSuggestions_PatronDoesNotExist => $warnPrefAnonymousPatronAnonSuggestions_PatronDoesNotExist,
  524. warnPrefKohaAdminEmailAddress => $warnPrefKohaAdminEmailAddress,
  525. warnPrefOpacHiddenItems => $warnPrefOpacHiddenItems,
  526. errZebraConnection => $errZebraConnection,
  527. warnIsRootUser => $warnIsRootUser,
  528. warnNoActiveCurrency => $warnNoActiveCurrency,
  529. warnNoTemplateCaching => ( C4::Context->config('template_cache_dir') ? 0 : 1 ),
  530. xml_config_warnings => \@xml_config_warnings,
  531. warnStatisticsFieldsError => $warnStatisticsFieldsError,
  532. );
  533. my @components = ();
  534. my $perl_modules = C4::Installer::PerlModules->new;
  535. $perl_modules->versions_info;
  536. my @pm_types = qw(missing_pm upgrade_pm current_pm);
  537. foreach my $pm_type(@pm_types) {
  538. my $modules = $perl_modules->get_attr($pm_type);
  539. foreach (@$modules) {
  540. my ($module, $stats) = each %$_;
  541. push(
  542. @components,
  543. {
  544. name => $module,
  545. version => $stats->{'cur_ver'},
  546. missing => ($pm_type eq 'missing_pm' ? 1 : 0),
  547. upgrade => ($pm_type eq 'upgrade_pm' ? 1 : 0),
  548. current => ($pm_type eq 'current_pm' ? 1 : 0),
  549. require => $stats->{'required'},
  550. reqversion => $stats->{'min_ver'},
  551. maxversion => $stats->{'max_ver'},
  552. excversion => $stats->{'exc_ver'}
  553. }
  554. );
  555. }
  556. }
  557. @components = sort {$a->{'name'} cmp $b->{'name'}} @components;
  558. my $counter=0;
  559. my $row = [];
  560. my $table = [];
  561. foreach (@components) {
  562. push (@$row, $_);
  563. unless (++$counter % 4) {
  564. push (@$table, {row => $row});
  565. $row = [];
  566. }
  567. }
  568. # Processing the last line (if there are any modules left)
  569. if (scalar(@$row) > 0) {
  570. # Extending $row to the table size
  571. $$row[3] = '';
  572. # Pushing the last line
  573. push (@$table, {row => $row});
  574. }
  575. ## ## $table
  576. $template->param( table => $table );
  577. ## ------------------------------------------
  578. ## Koha contributions
  579. my $docdir;
  580. if ( defined C4::Context->config('docdir') ) {
  581. $docdir = C4::Context->config('docdir');
  582. } else {
  583. # if no <docdir> is defined in koha-conf.xml, use the default location
  584. # this is a work-around to stop breakage on upgraded Kohas, bug 8911
  585. $docdir = C4::Context->config('intranetdir') . '/docs';
  586. }
  587. ## Release teams
  588. my $teams =
  589. -e "$docdir" . "/teams.yaml"
  590. ? YAML::XS::LoadFile( "$docdir" . "/teams.yaml" )
  591. : {};
  592. my $dev_team = (sort {$b <=> $a} (keys %{$teams->{team}}))[0];
  593. my $short_version = substr($versions{'kohaVersion'},0,5);
  594. my $minor = substr($versions{'kohaVersion'},3,2);
  595. my $development_version = ( $minor eq '05' || $minor eq '11' ) ? 0 : 1;
  596. $template->param( short_version => $short_version );
  597. $template->param( development_version => $development_version );
  598. ## Contributors
  599. my $contributors =
  600. -e "$docdir" . "/contributors.yaml"
  601. ? YAML::XS::LoadFile( "$docdir" . "/contributors.yaml" )
  602. : {};
  603. delete $contributors->{_others_};
  604. for my $version ( sort { $a <=> $b } keys %{$teams->{team}} ) {
  605. for my $role ( keys %{ $teams->{team}->{$version} } ) {
  606. my $normalized_role = "$role";
  607. $normalized_role =~ s/s$//;
  608. if ( ref( $teams->{team}->{$version}->{$role} ) eq 'ARRAY' ) {
  609. for my $contributor ( @{ $teams->{team}->{$version}->{$role} } ) {
  610. my $name = $contributor->{name};
  611. # Add role to contributors
  612. push @{ $contributors->{$name}->{roles}->{$normalized_role} },
  613. $version;
  614. # Add openhub to teams
  615. if ( exists( $contributors->{$name}->{openhub} ) ) {
  616. $contributor->{openhub} = $contributors->{$name}->{openhub};
  617. }
  618. }
  619. }
  620. elsif ( $role ne 'release_date' ) {
  621. my $name = $teams->{team}->{$version}->{$role}->{name};
  622. # Add role to contributors
  623. push @{ $contributors->{$name}->{roles}->{$normalized_role} },
  624. $version;
  625. # Add openhub to teams
  626. if ( exists( $contributors->{$name}->{openhub} ) ) {
  627. $teams->{team}->{$version}->{$role}->{openhub} =
  628. $contributors->{$name}->{openhub};
  629. }
  630. }
  631. else {
  632. $teams->{team}->{$version}->{$role} = DateTime->from_epoch( epoch => $teams->{team}->{$version}->{$role});
  633. }
  634. }
  635. }
  636. ## Create last name ordered array of people from contributors
  637. my @people = map {
  638. { name => $_, ( $contributors->{$_} ? %{ $contributors->{$_} } : () ) }
  639. } sort {
  640. my ($alast) = $a =~ /(\S+)$/;
  641. my ($blast) = $b =~ /(\S+)$/;
  642. my $cmp = lc($alast||"") cmp lc($blast||"");
  643. return $cmp if $cmp;
  644. my ($a2last) = $a =~ /(\S+)\s\S+$/;
  645. my ($b2last) = $b =~ /(\S+)\s\S+$/;
  646. lc($a2last||"") cmp lc($b2last||"");
  647. } keys %$contributors;
  648. $template->param( contributors => \@people );
  649. $template->param( maintenance_team => $teams->{team}->{$dev_team} );
  650. $template->param( release_team => $teams->{team}->{$short_version} );
  651. ## Timeline
  652. if ( open( my $file, "<:encoding(UTF-8)", "$docdir" . "/history.txt" ) ) {
  653. my $i = 0;
  654. my @rows2 = ();
  655. my $row2 = [];
  656. my @lines = <$file>;
  657. close($file);
  658. shift @lines; #remove header row
  659. foreach (@lines) {
  660. my ( $epoch, $date, $desc, $tag ) = split(/\t/);
  661. if(!$desc && $date=~ /(?<=\d{4})\s+/) {
  662. ($date, $desc)= ($`, $');
  663. }
  664. push(
  665. @rows2,
  666. {
  667. date => $date,
  668. desc => $desc,
  669. }
  670. );
  671. }
  672. my $table2 = [];
  673. #foreach my $row2 (@rows2) {
  674. foreach (@rows2) {
  675. push (@$row2, $_);
  676. push( @$table2, { row2 => $row2 } );
  677. $row2 = [];
  678. }
  679. $template->param( table2 => $table2 );
  680. } else {
  681. $template->param( timeline_read_error => 1 );
  682. }
  683. output_html_with_http_headers $query, $cookie, $template->output;