4 # Copyright 2000-2002 Katipo Communications
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
24 use POSIX qw( strftime );
25 use C4::Auth qw( get_template_and_user );
26 use C4::Output qw( output_html_with_http_headers );
27 use C4::AuthoritiesMarc qw( AddAuthority ModAuthority GetAuthority GetTagsLabels GetAuthMARCFromKohaField FindDuplicateAuthority );
29 use Date::Calc qw( Today );
30 use MARC::File::USMARC;
32 use C4::Biblio qw( TransformHtmlToMarc );
33 use Koha::Authority::Types;
34 use Koha::Import::Records;
36 use vars qw( $tagslib);
37 use vars qw( $authorised_values_sth);
38 use vars qw( $is_a_modif );
40 our($authorised_values_sth,$is_a_modif,$usedTagsLib,$mandatory_z3950);
46 =item build_authorized_values_list
48 builds list, depending on authorised value...
52 sub build_authorized_values_list {
53 my ( $tag, $subfield, $value, $dbh, $authorised_values_sth,$index_tag,$index_subfield ) = @_;
55 my @authorised_values;
58 my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
59 push @authorised_values, q{} unless $tagslib->{$tag}->{$subfield}->{mandatory} && $value;
61 if ( $category eq "branches" ) {
62 my $sth = $dbh->prepare( "select branchcode,branchname from branches order by branchname" );
64 while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
65 push @authorised_values, $branchcode;
66 $authorised_lib{$branchcode} = $branchname;
69 elsif ( $category eq "itemtypes" ) {
70 my $itemtypes = Koha::ItemTypes->search_with_localization;
71 while ( my $itemtype = $itemtypes->next ) {
72 push @authorised_values, $itemtype->itemtype;
73 $authorised_lib{$itemtype->itemtype} = $itemtype->translated_description;
76 else { # "true" authorised value
77 $authorised_values_sth->execute(
78 $tagslib->{$tag}->{$subfield}->{authorised_value}
80 while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
81 push @authorised_values, $value;
82 $authorised_lib{$value} = $lib;
88 id => "tag_".$tag."_subfield_".$subfield."_".$index_tag."_".$index_subfield,
89 name => "tag_".$tag."_subfield_".$subfield."_".$index_tag."_".$index_subfield,
90 values => \@authorised_values,
91 labels => \%authorised_lib,
93 ( ( grep { $_ eq $category } ( qw(branches itemtypes cn_source) ) ) ? () : ( category => $category ) ),
99 builds the <input ...> entry for a subfield.
104 my ( $tag, $subfield, $value, $index_tag, $rec, $authorised_values_sth, $cgi ) = @_;
106 my $index_subfield = CreateKey(); # create a specific key for each subfield
108 # determine maximum length; 9999 bytes per ISO 2709 except for leader and MARC21 008
109 my $max_length = 9999;
112 } elsif ($tag eq '008' and C4::Context->preference('marcflavour') eq 'MARC21') {
116 # Apply optional framework default value when it is a new record,
117 # or when editing as new (duplicating a record),
118 # based on the ApplyFrameworkDefaults setting.
119 # Substitute date parts, user name
120 my $applydefaults = C4::Context->preference('ApplyFrameworkDefaults');
121 if ( $value eq '' && (
122 ( $applydefaults =~ /new/ && !$cgi->param('authid') ) ||
123 ( $applydefaults =~ /duplicate/ && $cgi->param('op') eq 'duplicate' ) ||
124 ( $applydefaults =~ /imported/ && $cgi->param('breedingid') )
126 $value = $tagslib->{$tag}->{$subfield}->{defaultvalue};
127 if (!defined $value) {
131 # get today date & replace YYYY, MM, DD if provided in the default value
132 my ( $year, $month, $day ) = Today();
133 $month = sprintf( "%02d", $month );
134 $day = sprintf( "%02d", $day );
135 $value =~ s/YYYY/$year/g;
136 $value =~ s/MM/$month/g;
137 $value =~ s/DD/$day/g;
139 my $dbh = C4::Context->dbh;
141 # map '@' as "subfield" label for fixed fields
142 # to something that's allowed in a div id.
143 my $id_subfield = $subfield;
144 $id_subfield = "00" if $id_subfield eq "@";
146 my %subfield_data = (
148 subfield => $id_subfield,
149 marc_lib => $tagslib->{$tag}->{$subfield}->{lib},
150 tag_mandatory => $tagslib->{$tag}->{mandatory},
151 mandatory => $tagslib->{$tag}->{$subfield}->{mandatory},
152 repeatable => $tagslib->{$tag}->{$subfield}->{repeatable},
153 kohafield => $tagslib->{$tag}->{$subfield}->{kohafield},
155 id => "tag_".$tag."_subfield_".$id_subfield."_".$index_tag."_".$index_subfield,
157 random => CreateKey(),
160 if(exists $mandatory_z3950->{$tag.$subfield}){
161 $subfield_data{z3950_mandatory} = $mandatory_z3950->{$tag.$subfield};
164 $subfield_data{visibility} = "display:none;"
165 if( $tagslib->{$tag}->{$subfield}->{hidden} and $value ne ''
166 or ($value eq '' and !$tagslib->{$tag}->{$subfield}->{mandatory})
169 # it's an authorised field
170 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
171 $subfield_data{marc_value} =
172 build_authorized_values_list( $tag, $subfield, $value, $dbh,
173 $authorised_values_sth,$index_tag,$index_subfield );
175 # it's a thesaurus / authority field
177 elsif ( $tagslib->{$tag}->{$subfield}->{authtypecode} ) {
178 $subfield_data{marc_value} = {
180 id => $subfield_data{id},
181 name => $subfield_data{id},
183 authtypecode => $tagslib->{$tag}->{$subfield}->{authtypecode},
186 elsif ( $tagslib->{$tag}->{$subfield}->{'value_builder'} ) { # plugin
187 require Koha::FrameworkPlugin;
188 my $plugin = Koha::FrameworkPlugin->new({
189 name => $tagslib->{$tag}->{$subfield}->{'value_builder'},
191 my $pars= { dbh => $dbh, record => $rec, tagslib =>$tagslib,
192 id => $subfield_data{id} };
193 $plugin->build( $pars );
194 if( !$plugin->errstr ) {
195 $subfield_data{marc_value} = {
197 id => $subfield_data{id},
198 name => $subfield_data{id},
200 maxlength => $max_length,
201 javascript => $plugin->javascript,
202 noclick => $plugin->noclick,
204 } else { # warn and supply default field
205 warn $plugin->errstr;
206 $subfield_data{marc_value} = {
208 id => $subfield_data{id},
209 name => $subfield_data{id},
211 maxlength => $max_length,
215 # it's an hidden field
216 elsif ( $tag eq '' ) {
217 $subfield_data{marc_value} = {
219 id => $subfield_data{id},
220 name => $subfield_data{id},
222 maxlength => $max_length,
225 elsif ( $tagslib->{$tag}->{$subfield}->{'hidden'} ) {
226 $subfield_data{marc_value} = {
228 id => $subfield_data{id},
229 name => $subfield_data{id},
231 maxlength => $max_length,
234 # it's a standard field
240 ( C4::Context->preference("marcflavour") eq "UNIMARC" && $tag >= 300
241 and $tag < 400 && $subfield eq 'a' )
244 && C4::Context->preference("marcflavour") eq "MARC21" )
247 $subfield_data{marc_value} = {
249 id => $subfield_data{id},
250 name => $subfield_data{id},
252 maxlength => $max_length,
257 $subfield_data{marc_value} = {
259 id => $subfield_data{id},
260 name => $subfield_data{id},
262 maxlength => $max_length,
267 if ($cgi->param('tagreport') && $subfield_data{tag} == $cgi->param('tagreport')) {
268 $subfield_data{marc_value}{value} = $cgi->param('tag'. $cgi->param('tagbiblio') . 'subfield' . $subfield_data{subfield});
270 $subfield_data{'index_subfield'} = $index_subfield;
271 return \%subfield_data;
274 =item format_indicator
276 Translate indicator value for output form - specifically, map
277 indicator = ' ' to ''. This is for the convenience of a cataloger
278 using a mouse to select an indicator input.
282 sub format_indicator {
283 my $ind_value = shift;
284 return '' if not defined $ind_value;
285 return '' if $ind_value eq ' ';
291 Create a random value to set it into the input name
296 return int(rand(1000000));
299 =item GetMandatoryFieldZ3950
301 This function returns a hashref which contains all mandatory field
302 to search with z3950 server.
306 sub GetMandatoryFieldZ3950 {
307 my $authtypecode = shift;
308 if ( C4::Context->preference('marcflavour') eq 'MARC21' ){
310 '100a' => 'authorpersonal',
311 '110a' => 'authorcorp',
312 '111a' => 'authormeetingcon',
313 '130a' => 'uniformtitle',
318 '200a' => 'authorpersonal',
319 '210a' => 'authorcorp', #210 in UNIMARC is used for both corporation and meeting
320 '230a' => 'uniformtitle',
326 my ( $template, $record, $dbh, $input ) = @_;
332 my $authorised_values_sth = $dbh->prepare(
333 "SELECT authorised_value,lib
334 FROM authorised_values
335 WHERE category=? ORDER BY lib"
338 # in this array, we will push all the 10 tabs
339 # to avoid having 10 tabs in the template : they will all be in the same BIG_LOOP
342 my @tab_data; # all tags to display
344 foreach my $used ( keys %$tagslib ){
345 push @tab_data,$used if not $seen{$used};
350 # loop through each tab 0 through 9
351 for ( my $tabloop = 0 ; $tabloop <= $max_num_tab ; $tabloop++ ) {
352 my @loop_data = (); #innerloop in the template.
354 foreach my $tag (sort @tab_data) {
357 my ($indicator1, $indicator2);
358 my $index_tag = CreateKey;
360 # if MARC::Record is not empty =>use it as master loop, then add missing subfields that should be in the tab.
361 # if MARC::Record is empty => use tab as master loop.
362 if ( $record && ( $record->field($tag) || $tag eq '000' ) ) {
364 if ( $tag ne '000' ) {
365 @fields = $record->field($tag);
368 push @fields, $record->leader(); # if tag == 000
370 # loop through each field
371 foreach my $field (@fields) {
375 my ( $value, $subfield );
376 if ( $tag ne '000' ) {
377 $value = $field->data();
384 next if ( $tagslib->{$tag}->{$subfield}->{tab} ne $tabloop );
385 next if $tagslib->{$tag}->{$subfield}->{hidden} && $subfield ne '9';
389 $tag, $subfield, $value, $index_tag, $record,
390 $authorised_values_sth,$input
395 my @subfields = $field->subfields();
396 foreach my $subfieldcount ( 0 .. $#subfields ) {
397 my $subfield = $subfields[$subfieldcount][0];
398 my $value = $subfields[$subfieldcount][1];
399 next if ( length $subfield != 1 );
400 next if ( $tagslib->{$tag}->{$subfield}->{tab} ne $tabloop );
401 next if $tagslib->{$tag}->{$subfield}->{hidden} && $subfield ne '9';
405 $tag, $subfield, $value, $index_tag,
406 $record, $authorised_values_sth,$input
412 # now, loop again to add parameter subfield that are not in the MARC::Record
413 foreach my $subfield ( sort( keys %{ $tagslib->{$tag} } ) )
415 next if ( length $subfield != 1 );
416 next if ( $tagslib->{$tag}->{$subfield}->{tab} ne $tabloop );
417 next if ( $tag < 10 );
418 next if $tagslib->{$tag}->{$subfield}->{hidden} && $subfield ne '9';
419 next if ( defined( $field->subfield($subfield) ) );
423 $tag, $subfield, '', $index_tag, $record,
424 $authorised_values_sth,$input
428 if ( $#subfields_data >= 0 ) {
429 # build the tag entry.
430 # note that the random() field is mandatory. Otherwise, on repeated fields, you'll
431 # have twice the same "name" value, and cgi->param() will return only one, making
432 # all subfields to be merged in a single field.
436 tag_lib => $tagslib->{$tag}->{lib},
437 repeatable => $tagslib->{$tag}->{repeatable},
438 mandatory => $tagslib->{$tag}->{mandatory},
439 subfield_loop => \@subfields_data,
440 fixedfield => ($tag < 10)?(1):(0),
443 if ($tag >= 10){ # no indicator for theses tag
444 $tag_data{indicator1} = format_indicator($field->indicator(1)),
445 $tag_data{indicator2} = format_indicator($field->indicator(2)),
447 push( @loop_data, \%tag_data );
449 } # foreach $field end
451 # if breeding is empty
455 foreach my $subfield (
456 sort { $a->{display_order} <=> $b->{display_order} || $a->{subfield} cmp $b->{subfield} }
457 grep { ref($_) && %$_ } # Not a subfield (values for "important", "lib", "mandatory", etc.) or empty
458 values %{ $tagslib->{$tag} } )
460 next if $subfield->{hidden} && $subfield->{subfield} ne '9';
461 next if ( $subfield->{tab} ne $tabloop );
465 $tag, $subfield->{subfield}, '', $index_tag, $record,
466 $authorised_values_sth,$input
470 if ( $#subfields_data >= 0 ) {
474 tag_lib => $tagslib->{$tag}->{lib},
475 repeatable => $tagslib->{$tag}->{repeatable},
476 mandatory => $tagslib->{$tag}->{mandatory},
477 indicator1 => $indicator1,
478 indicator2 => $indicator2,
479 subfield_loop => \@subfields_data,
480 tagfirstsubfield => $subfields_data[0],
481 fixedfield => ($tag < 10)?(1):(0)
484 push @loop_data, \%tag_data ;
488 if ( $#loop_data >= 0 ) {
491 innerloop => \@loop_data,
495 $template->param( BIG_LOOP => \@BIG_LOOP );
499 sub build_hidden_data {
500 # build hidden data =>
501 # we store everything, even if we show only requested subfields.
505 foreach my $tag (keys %{$tagslib}) {
506 my $previous_tag = '';
508 # loop through each subfield
509 foreach my $subfield (keys %{$tagslib->{$tag}}) {
510 next if ($subfield eq 'lib');
511 next if ($subfield eq 'tab');
512 next if ($subfield eq 'mandatory');
513 next if ($subfield eq 'repeatable');
514 next if ($tagslib->{$tag}->{$subfield}->{'tab'} ne "-1");
516 $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
517 $subfield_data{marc_mandatory}=$tagslib->{$tag}->{$subfield}->{mandatory};
518 $subfield_data{marc_repeatable}=$tagslib->{$tag}->{$subfield}->{repeatable};
519 $subfield_data{marc_value} = {
520 type => 'hidden_simple',
521 name => 'field_value[]',
523 push(@loop_data, \%subfield_data);
534 # ========================
536 #=========================
537 my $input = CGI->new;
538 my $z3950 = $input->param('z3950');
539 my $error = $input->param('error');
540 my $authid = $input->param('authid') =~ s/\D//gr
541 ; # if authid exists, it's a modif, not a new authority. We remove from authid all non-digit characters just in case the CGI parameter contains weird characters like spaces
542 my $op = $input->param('op');
543 my $nonav = $input->param('nonav');
544 my $myindex = $input->param('index');
545 my $linkid=$input->param('linkid');
546 my $authtypecode = $input->param('authtypecode');
547 my $breedingid = $input->param('breedingid');
548 my $changed_authtype = $input->param('changed_authtype') // q{};
551 my $dbh = C4::Context->dbh;
552 my $authobj = Koha::Authorities->find($authid);
553 if ( $authid && !$authobj ) {
554 print $input->redirect("/cgi-bin/koha/errors/404.pl"); # escape early
558 $authtypecode = $authid ? $authobj->authtypecode : '';
561 my $count = $authobj ? $authobj->get_usage_count : 0;
563 my ($template, $loggedinuser, $cookie)
564 = get_template_and_user({template_name => "authorities/authorities.tt",
567 flagsrequired => {editauthorities => 1},
569 $template->param(nonav => $nonav,index=>$myindex,authtypecode=>$authtypecode,breedingid=>$breedingid, count=>$count);
571 $tagslib = GetTagsLabels(1,$authtypecode);
572 $mandatory_z3950 = GetMandatoryFieldZ3950($authtypecode);
576 my $import_record = Koha::Import::Records->find($breedingid);
577 if ($import_record) {
578 $record = $import_record->get_marc_record();
581 $record = GetAuthority($authid);
584 my ($oldauthnumtagfield,$oldauthnumtagsubfield);
585 my ($oldauthtypetagfield,$oldauthtypetagsubfield);
589 ($oldauthnumtagfield,$oldauthnumtagsubfield) = GetAuthMARCFromKohaField("auth_header.authid",$authtypecode);
590 ($oldauthtypetagfield,$oldauthtypetagsubfield) = GetAuthMARCFromKohaField("auth_header.authtypecode",$authtypecode);
593 #------------------------------------------------------------------------------------------------------------------------------
595 #------------------------------------------------------------------------------------------------------------------------------
597 my @tags = $input->multi_param('tag');
598 my @subfields = $input->multi_param('subfield');
599 my @values = $input->multi_param('field_value');
600 # build indicator hash.
601 my @ind_tag = $input->multi_param('ind_tag');
602 my @indicator = $input->multi_param('indicator');
603 my $record = TransformHtmlToMarc($input, 0);
605 my ($duplicateauthid,$duplicateauthvalue);
606 ($duplicateauthid,$duplicateauthvalue) = FindDuplicateAuthority($record,$authtypecode) if ($op eq "add") && (!$is_a_modif);
607 my $confirm_not_duplicate = $input->param('confirm_not_duplicate');
608 # it is not a duplicate (determined either by Koha itself or by user checking it's not a duplicate)
609 if (!$duplicateauthid or $confirm_not_duplicate) {
611 ModAuthority($authid,$record,$authtypecode);
613 ($authid) = AddAuthority($record,$authid,$authtypecode);
616 print $input->redirect("blinddetail-biblio-search.pl?authid=$authid&index=$myindex");
618 print $input->redirect("detail.pl?authid=$authid");
622 # it may be a duplicate, warn the user and do nothing
623 build_tabs($template, $record, $dbh, $input);
625 $template->param(authid =>$authid,
626 duplicateauthid => $duplicateauthid,
627 duplicateauthvalue => $duplicateauthvalue->{'authorized'}->[0]->{'heading'},
630 } elsif ($op eq "delete") {
631 #------------------------------------------------------------------------------------------------------------------------------
632 DelAuthority({ authid => $authid });
634 print $input->redirect("auth_finder.pl");
636 print $input->redirect("authorities-home.pl?authid=0");
640 if ( $op eq "duplicate" ) {
642 if ( C4::Context->preference('marcflavour') eq 'MARC21' && $record && $record->field('008') ) {
643 my $s008 = $record->field('008')->data;
644 my $date = POSIX::strftime( "%y%m%d", localtime );
645 substr( $s008, 0, 6, $date );
646 $record->field('008')->update($s008);
647 } elsif ( C4::Context->preference('marcflavour') eq 'UNIMARC' && $record && $record->subfield( '100', 'a' ) ) {
648 my $s100a = $record->subfield( '100', 'a' );
649 my $date = POSIX::strftime( "%Y%m%d", localtime );
650 substr( $s100a, 0, 8, $date );
651 $record->field('100')->update( a => $s100a );
655 if ( $changed_authtype eq "changed" ) {
656 $record = TransformHtmlToMarc( $input, 0 );
659 build_tabs( $template, $record, $dbh, $input );
662 oldauthtypetagfield => $oldauthtypetagfield,
663 oldauthtypetagsubfield => $oldauthtypetagsubfield,
664 oldauthnumtagfield => $oldauthnumtagfield,
665 oldauthnumtagsubfield => $oldauthnumtagsubfield,
667 authtypecode => $authtypecode,
671 my $authority_types = Koha::Authority::Types->search( {}, { order_by => ['authtypetext'] } );
673 my $type = $authority_types->find($authtypecode);
675 authority_types => $authority_types,
676 authtypecode => $authtypecode,
679 authtypetext => $type ? $type->authtypetext : "",
680 hide_marc => C4::Context->preference('hide_marc'),
682 output_html_with_http_headers $input, $cookie, $template->output;