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.
 
 
 
 
 
 

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