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 under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
22 #use warnings; FIXME - Bug 2505
28 use C4
::AuthoritiesMarc
;
32 use C4
::Koha
; # XXX subfield_is_koha_internal_p
33 use C4
::Branch
; # XXX subfield_is_koha_internal_p
38 use Date
::Calc
qw(Today);
39 use MARC
::File
::USMARC
;
42 if ( C4
::Context
->preference('marcflavour') eq 'UNIMARC' ) {
43 MARC
::File
::XML
->default_record_format('UNIMARC');
46 our($tagslib,$authorised_values_sth,$is_a_modif,$usedTagsLib,$mandatory_z3950);
50 =head2 MARCfindbreeding
52 $record = MARCfindbreeding($breedingid);
54 Look up the import record repository for the record with
55 record with id $breedingid. If found, returns the decoded
56 MARC::Record; otherwise, -1 is returned (FIXME).
57 Returns as second parameter the character encoding.
61 sub MARCfindbreeding
{
63 my ($marc, $encoding) = GetImportRecordMarc
($id);
64 # remove the - in isbn, koha store isbn without any -
66 my $record = MARC
::Record
->new_from_usmarc($marc);
67 my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField
('biblioitems.isbn','');
68 if ( $record->field($isbnfield) ) {
69 foreach my $field ( $record->field($isbnfield) ) {
70 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
71 my $newisbn = $field->subfield($isbnsubfield);
73 $field->update( $isbnsubfield => $newisbn );
77 # fix the unimarc 100 coded field (with unicode information)
78 if (C4
::Context
->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
79 my $f100a=$record->subfield(100,'a');
80 my $f100 = $record->field(100);
81 my $f100temp = $f100->as_string;
82 $record->delete_field($f100);
83 if ( length($f100temp) > 28 ) {
84 substr( $f100temp, 26, 2, "50" );
85 $f100->update( 'a' => $f100temp );
86 my $f100 = MARC
::Field
->new( '100', '', '', 'a' => $f100temp );
87 $record->insert_fields_ordered($f100);
91 if ( !defined(ref($record)) ) {
95 # normalize author : probably UNIMARC specific...
96 if ( C4
::Context
->preference("z3950NormalizeAuthor")
97 and C4
::Context
->preference("z3950AuthorAuthFields") )
99 my ( $tag, $subfield ) = GetMarcFromKohaField
("biblio.author", '');
101 # my $summary = C4::Context->preference("z3950authortemplate");
103 C4
::Context
->preference("z3950AuthorAuthFields");
104 my @auth_fields = split /,/, $auth_fields;
107 if ( $record->field($tag) ) {
108 foreach my $tmpfield ( $record->field($tag)->subfields ) {
110 # foreach my $subfieldcode ($tmpfield->subfields){
111 my $subfieldcode = shift @
$tmpfield;
112 my $subfieldvalue = shift @
$tmpfield;
114 $field->add_subfields(
115 "$subfieldcode" => $subfieldvalue )
116 if ( $subfieldcode ne $subfield );
120 MARC
::Field
->new( $tag, "", "",
121 $subfieldcode => $subfieldvalue )
122 if ( $subfieldcode ne $subfield );
126 $record->delete_field( $record->field($tag) );
127 foreach my $fieldtag (@auth_fields) {
128 next unless ( $record->field($fieldtag) );
129 my $lastname = $record->field($fieldtag)->subfield('a');
130 my $firstname = $record->field($fieldtag)->subfield('b');
131 my $title = $record->field($fieldtag)->subfield('c');
132 my $number = $record->field($fieldtag)->subfield('d');
135 # $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
136 $field->add_subfields(
137 "$subfield" => ucfirst($title) . " "
138 . ucfirst($firstname) . " "
143 # $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
144 $field->add_subfields(
145 "$subfield" => ucfirst($firstname) . ", "
146 . ucfirst($lastname) );
149 $record->insert_fields_ordered($field);
151 return $record, $encoding;
157 =head2 build_authorized_values_list
161 sub build_authorized_values_list
($$$$$$$) {
162 my ( $tag, $subfield, $value, $dbh, $authorised_values_sth,$index_tag,$index_subfield ) = @_;
164 my @authorised_values;
167 # builds list, depending on authorised value...
170 if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
171 #Use GetBranches($onlymine)
172 my $onlymine=C4
::Context
->preference('IndependantBranches') &&
173 C4
::Context
->userenv &&
174 C4
::Context
->userenv->{flags
} % 2 == 0 &&
175 C4
::Context
->userenv->{branch
};
176 my $branches = GetBranches
($onlymine);
178 foreach my $thisbranch ( sort keys %$branches ) {
179 push @authorised_values, $thisbranch;
180 $authorised_lib{$thisbranch} = $branches->{$thisbranch}->{'branchname'};
185 elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value
} eq "itemtypes" ) {
188 "select itemtype,description from itemtypes order by description");
190 push @authorised_values, ""
191 unless ( $tagslib->{$tag}->{$subfield}->{mandatory
} );
195 while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
196 push @authorised_values, $itemtype;
197 $authorised_lib{$itemtype} = $description;
199 $value = $itemtype unless ($value);
203 elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value
} eq "cn_source" ) {
204 push @authorised_values, ""
205 unless ( $tagslib->{$tag}->{$subfield}->{mandatory
} );
207 my $class_sources = GetClassSources
();
209 my $default_source = C4
::Context
->preference("DefaultClassificationSource");
211 foreach my $class_source (sort keys %$class_sources) {
212 next unless $class_sources->{$class_source}->{'used'} or
213 ($value and $class_source eq $value) or
214 ($class_source eq $default_source);
215 push @authorised_values, $class_source;
216 $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
217 $value = $class_source unless ($value);
218 $value = $default_source unless ($value);
220 #---- "true" authorised value
223 $authorised_values_sth->execute(
224 $tagslib->{$tag}->{$subfield}->{authorised_value
} );
226 push @authorised_values, ""
227 unless ( $tagslib->{$tag}->{$subfield}->{mandatory
} );
229 while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
230 push @authorised_values, $value;
231 $authorised_lib{$value} = $lib;
234 return CGI
::scrolling_list
(
235 -name
=> "tag_".$tag."_subfield_".$subfield."_".$index_tag."_".$index_subfield,
236 -values => \
@authorised_values,
238 -labels
=> \
%authorised_lib,
243 -id
=> "tag_".$tag."_subfield_".$subfield."_".$index_tag."_".$index_subfield,
244 -class => "input_marceditor",
250 Create a random value to set it into the input name
255 return int(rand(1000000));
258 =head2 GetMandatoryFieldZ3950
260 This function return an hashref which containts all mandatory field
261 to search with z3950 server.
265 sub GetMandatoryFieldZ3950
($){
266 my $frameworkcode = shift;
267 my @isbn = GetMarcFromKohaField
('biblioitems.isbn',$frameworkcode);
268 my @title = GetMarcFromKohaField
('biblio.title',$frameworkcode);
269 my @author = GetMarcFromKohaField
('biblio.author',$frameworkcode);
270 my @issn = GetMarcFromKohaField
('biblioitems.issn',$frameworkcode);
271 my @lccn = GetMarcFromKohaField
('biblioitems.lccn',$frameworkcode);
274 $isbn[0].$isbn[1] => 'isbn',
275 $title[0].$title[1] => 'title',
276 $author[0].$author[1] => 'author',
277 $issn[0].$issn[1] => 'issn',
278 $lccn[0].$lccn[1] => 'lccn',
284 builds the <input ...> entry for a subfield.
289 my ( $tag, $subfield, $value, $index_tag, $tabloop, $rec, $authorised_values_sth,$cgi ) = @_;
291 my $index_subfield = CreateKey
(); # create a specifique key for each subfield
293 $value =~ s/"/"/g;
295 # determine maximum length; 9999 bytes per ISO 2709 except for leader and MARC21 008
296 my $max_length = 9999;
299 } elsif ($tag eq '008' and C4
::Context
->preference('marcflavour') eq 'MARC21') {
303 # if there is no value provided but a default value in parameters, get it
304 if ( $value eq '' ) {
305 $value = $tagslib->{$tag}->{$subfield}->{defaultvalue
};
307 # get today date & replace YYYY, MM, DD if provided in the default value
308 my ( $year, $month, $day ) = Today
();
309 $month = sprintf( "%02d", $month );
310 $day = sprintf( "%02d", $day );
311 $value =~ s/YYYY/$year/g;
312 $value =~ s/MM/$month/g;
313 $value =~ s/DD/$day/g;
314 my $username=(C4
::Context
->userenv?C4
::Context
->userenv->{'surname'}:"superlibrarian");
315 $value=~s/user/$username/g;
318 my $dbh = C4
::Context
->dbh;
320 # map '@' as "subfield" label for fixed fields
321 # to something that's allowed in a div id.
322 my $id_subfield = $subfield;
323 $id_subfield = "00" if $id_subfield eq "@";
325 my %subfield_data = (
327 subfield
=> $id_subfield,
328 marc_lib
=> substr( $tagslib->{$tag}->{$subfield}->{lib
}, 0, 22 ),
329 marc_lib_plain
=> $tagslib->{$tag}->{$subfield}->{lib
},
330 tag_mandatory
=> $tagslib->{$tag}->{mandatory
},
331 mandatory
=> $tagslib->{$tag}->{$subfield}->{mandatory
},
332 repeatable
=> $tagslib->{$tag}->{$subfield}->{repeatable
},
333 kohafield
=> $tagslib->{$tag}->{$subfield}->{kohafield
},
335 id
=> "tag_".$tag."_subfield_".$id_subfield."_".$index_tag."_".$index_subfield,
337 random
=> CreateKey
(),
340 if(exists $mandatory_z3950->{$tag.$subfield}){
341 $subfield_data{z3950_mandatory
} = $mandatory_z3950->{$tag.$subfield};
343 # decide if the subfield must be expanded (visible) by default or not
344 # if it is mandatory, then expand. If it is hidden explicitly by the hidden flag, hidden anyway
345 $subfield_data{visibility
} = "display:none;"
346 if ( ($tagslib->{$tag}->{$subfield}->{hidden
} % 2 == 1) and $value ne ''
347 or ($value eq '' and !$tagslib->{$tag}->{$subfield}->{mandatory
})
349 # always expand all subfields of a mandatory field
350 $subfield_data{visibility
} = "" if $tagslib->{$tag}->{mandatory
};
351 # it's an authorised field
352 if ( $tagslib->{$tag}->{$subfield}->{authorised_value
} ) {
353 $subfield_data{marc_value
} =
354 build_authorized_values_list
( $tag, $subfield, $value, $dbh,
355 $authorised_values_sth,$index_tag,$index_subfield );
357 # it's a subfield $9 linking to an authority record - see bug 2206
359 elsif ($subfield eq "9" and
360 exists($tagslib->{$tag}->{'a'}->{authtypecode
}) and
361 defined($tagslib->{$tag}->{'a'}->{authtypecode
}) and
362 $tagslib->{$tag}->{'a'}->{authtypecode
} ne '') {
364 $subfield_data{marc_value
} =
365 "<input type=\"text\"
366 id=\"".$subfield_data{id
}."\"
367 name=\"".$subfield_data{id
}."\"
369 class=\"input_marceditor readonly\"
372 maxlength=\"$max_length\"
373 readonly=\"readonly\"
376 # it's a thesaurus / authority field
378 elsif ( $tagslib->{$tag}->{$subfield}->{authtypecode
} ) {
379 if (C4
::Context
->preference("BiblioAddsAuthorities")) {
380 $subfield_data{marc_value
} =
381 "<input type=\"text\"
382 id=\"".$subfield_data{id
}."\"
383 name=\"".$subfield_data{id
}."\"
385 class=\"input_marceditor readonly\"
388 maxlength=\"$max_length\"
390 <a href=\"#\" class=\"buttonDot\"
391 onclick=\"openAuth(this.parentNode.getElementsByTagName('input')[1].id,'".$tagslib->{$tag}->{$subfield}->{authtypecode
}."'); return false;\" tabindex=\"1\" title=\"Tag Editor\">...</a>
394 $subfield_data{marc_value
} =
395 "<input type=\"text\"
396 id=\"".$subfield_data{id
}."\"
397 name=\"".$subfield_data{id
}."\"
399 class=\"input_marceditor readonly\"
402 maxlength=\"$max_length\"
403 readonly=\"readonly\"
404 \/><a href=\"#\" class=\"buttonDot\"
405 onclick=\"openAuth(this.parentNode.getElementsByTagName('input')[1].id,'".$tagslib->{$tag}->{$subfield}->{authtypecode
}."'); return false;\" tabindex=\"1\" title=\"Tag Editor\">...</a>
408 # it's a plugin field
410 elsif ( $tagslib->{$tag}->{$subfield}->{'value_builder'} ) {
412 # opening plugin. Just check wether we are on a developper computer on a production one
413 # (the cgidir differs)
414 my $cgidir = C4
::Context
->intranetdir . "/cgi-bin/cataloguing/value_builder";
415 unless ( opendir( DIR
, "$cgidir" ) ) {
416 $cgidir = C4
::Context
->intranetdir . "/cataloguing/value_builder";
419 my $plugin = $cgidir . "/" . $tagslib->{$tag}->{$subfield}->{'value_builder'};
421 my $extended_param = plugin_parameters
( $dbh, $rec, $tagslib, $subfield_data{id
}, $tabloop );
422 my ( $function_name, $javascript ) = plugin_javascript
( $dbh, $rec, $tagslib, $subfield_data{id
}, $tabloop );
424 $subfield_data{marc_value
} =
425 "<input tabindex=\"1\"
427 id=\"".$subfield_data{id
}."\"
428 name=\"".$subfield_data{id
}."\"
430 class=\"input_marceditor\"
431 onfocus=\"Focus$function_name($index_tag)\"
433 maxlength=\"$max_length\"
434 onblur=\"Blur$function_name($index_tag); \" \/>
435 <a href=\"#\" class=\"buttonDot\" onclick=\"Clic$function_name('$subfield_data{id}'); return false;\" tabindex=\"1\" title=\"Tag Editor\">...</a>
438 warn "Plugin Failed: $plugin";
439 # supply default input form
440 $subfield_data{marc_value
} =
441 "<input type=\"text\"
442 id=\"".$subfield_data{id
}."\"
443 name=\"".$subfield_data{id
}."\"
447 maxlength=\"$max_length\"
448 class=\"input_marceditor\"
452 # it's an hidden field
454 elsif ( $tag eq '' ) {
455 $subfield_data{marc_value
} =
456 "<input tabindex=\"1\"
458 id=\"".$subfield_data{id
}."\"
459 name=\"".$subfield_data{id
}."\"
461 maxlength=\"$max_length\"
465 elsif ( $tagslib->{$tag}->{$subfield}->{'hidden'} ) {
466 $subfield_data{marc_value
} =
467 "<input type=\"text\"
468 id=\"".$subfield_data{id
}."\"
469 name=\"".$subfield_data{id
}."\"
470 class=\"input_marceditor\"
473 maxlength=\"$max_length\"
477 # it's a standard field
483 ( C4
::Context
->preference("marcflavour") eq "UNIMARC" && $tag >= 300
484 and $tag < 400 && $subfield eq 'a' )
487 && C4
::Context
->preference("marcflavour") eq "MARC21" )
490 $subfield_data{marc_value
} =
491 "<textarea cols=\"70\"
493 id=\"".$subfield_data{id
}."\"
494 name=\"".$subfield_data{id
}."\"
495 class=\"input_marceditor\"
501 $subfield_data{marc_value
} =
502 "<input type=\"text\"
503 id=\"".$subfield_data{id
}."\"
504 name=\"".$subfield_data{id
}."\"
508 maxlength=\"$max_length\"
509 class=\"input_marceditor\"
514 $subfield_data{'index_subfield'} = $index_subfield;
515 return \
%subfield_data;
519 =head2 format_indicator
521 Translate indicator value for output form - specifically, map
522 indicator = ' ' to ''. This is for the convenience of a cataloger
523 using a mouse to select an indicator input.
527 sub format_indicator
{
528 my $ind_value = shift;
529 return '' if not defined $ind_value;
530 return '' if $ind_value eq ' ';
534 sub build_tabs
($$$$$) {
535 my ( $template, $record, $dbh, $encoding,$input ) = @_;
541 my $authorised_values_sth = $dbh->prepare(
542 "select authorised_value,lib
543 from authorised_values
544 where category=? order by lib"
547 # in this array, we will push all the 10 tabs
548 # to avoid having 10 tabs in the template : they will all be in the same BIG_LOOP
551 my @tab_data; # all tags to display
553 foreach my $used ( @
$usedTagsLib ){
554 push @tab_data,$used->{tagfield
} if not $seen{$used->{tagfield
}};
555 $seen{$used->{tagfield
}}++;
559 foreach(@
$usedTagsLib){
560 if($_->{tab
} > -1 && $_->{tab
} >= $max_num_tab && $_->{tagfield
} != '995'){ # FIXME : MARC21 ?
561 $max_num_tab = $_->{tab
};
564 if($max_num_tab >= 9){
567 # loop through each tab 0 through 9
568 for ( my $tabloop = 0 ; $tabloop <= $max_num_tab ; $tabloop++ ) {
569 my @loop_data = (); #innerloop in the template.
571 foreach my $tag (@tab_data) {
574 my ($indicator1, $indicator2);
575 my $index_tag = CreateKey
;
577 # if MARC::Record is not empty =>use it as master loop, then add missing subfields that should be in the tab.
578 # if MARC::Record is empty => use tab as master loop.
579 if ( $record ne -1 && ( $record->field($tag) || $tag eq '000' ) ) {
581 if ( $tag ne '000' ) {
582 @fields = $record->field($tag);
585 push @fields, $record->leader(); # if tag == 000
587 # loop through each field
588 foreach my $field (@fields) {
592 my ( $value, $subfield );
593 if ( $tag ne '000' ) {
594 $value = $field->data();
601 next if ( $tagslib->{$tag}->{$subfield}->{tab
} ne $tabloop );
603 if ( $tagslib->{$tag}->{$subfield}->{kohafield
} eq
604 'biblio.biblionumber' );
608 $tag, $subfield, $value, $index_tag, $tabloop, $record,
609 $authorised_values_sth,$input
614 my @subfields = $field->subfields();
615 foreach my $subfieldcount ( 0 .. $#subfields ) {
616 my $subfield = $subfields[$subfieldcount][0];
617 my $value = $subfields[$subfieldcount][1];
618 next if ( length $subfield != 1 );
619 next if ( $tagslib->{$tag}->{$subfield}->{tab
} ne $tabloop );
623 $tag, $subfield, $value, $index_tag, $tabloop,
624 $record, $authorised_values_sth,$input
630 # now, loop again to add parameter subfield that are not in the MARC::Record
631 foreach my $subfield ( sort( keys %{ $tagslib->{$tag} } ) )
633 next if ( length $subfield != 1 );
634 next if ( $tagslib->{$tag}->{$subfield}->{tab
} ne $tabloop );
635 next if ( $tag < 10 );
637 if ( ( $tagslib->{$tag}->{$subfield}->{hidden
} <= -4 )
638 or ( $tagslib->{$tag}->{$subfield}->{hidden
} >= 5 ) )
639 and not ( $subfield eq "9" and
640 exists($tagslib->{$tag}->{'a'}->{authtypecode
}) and
641 defined($tagslib->{$tag}->{'a'}->{authtypecode
}) and
642 $tagslib->{$tag}->{'a'}->{authtypecode
} ne ""
644 ; #check for visibility flag
645 # if subfield is $9 in a field whose $a is authority-controlled,
646 # always include in the form regardless of the hidden setting - bug 2206
647 next if ( defined( $field->subfield($subfield) ) );
651 $tag, $subfield, '', $index_tag, $tabloop, $record,
652 $authorised_values_sth,$input
656 if ( $#subfields_data >= 0 ) {
657 # build the tag entry.
658 # note that the random() field is mandatory. Otherwise, on repeated fields, you'll
659 # have twice the same "name" value, and cgi->param() will return only one, making
660 # all subfields to be merged in a single field.
664 tag_lib
=> $tagslib->{$tag}->{lib
},
665 repeatable
=> $tagslib->{$tag}->{repeatable
},
666 mandatory
=> $tagslib->{$tag}->{mandatory
},
667 subfield_loop
=> \
@subfields_data,
668 fixedfield
=> $tag < 10?
1:0,
671 if ($tag >= 10){ # no indicator for 00x tags
672 $tag_data{indicator1
} = format_indicator
($field->indicator(1)),
673 $tag_data{indicator2
} = format_indicator
($field->indicator(2)),
675 push( @loop_data, \
%tag_data );
677 } # foreach $field end
679 # if breeding is empty
683 foreach my $subfield ( sort( keys %{ $tagslib->{$tag} } ) ) {
684 next if ( length $subfield != 1 );
686 if ( ( $tagslib->{$tag}->{$subfield}->{hidden
} <= -5 )
687 or ( $tagslib->{$tag}->{$subfield}->{hidden
} >= 4 ) )
688 and not ( $subfield eq "9" and
689 exists($tagslib->{$tag}->{'a'}->{authtypecode
}) and
690 defined($tagslib->{$tag}->{'a'}->{authtypecode
}) and
691 $tagslib->{$tag}->{'a'}->{authtypecode
} ne ""
693 ; #check for visibility flag
694 # if subfield is $9 in a field whose $a is authority-controlled,
695 # always include in the form regardless of the hidden setting - bug 2206
697 if ( $tagslib->{$tag}->{$subfield}->{tab
} ne $tabloop );
701 $tag, $subfield, '', $index_tag, $tabloop, $record,
702 $authorised_values_sth,$input
706 if ( $#subfields_data >= 0 ) {
710 tag_lib
=> $tagslib->{$tag}->{lib
},
711 repeatable
=> $tagslib->{$tag}->{repeatable
},
712 mandatory
=> $tagslib->{$tag}->{mandatory
},
713 indicator1
=> $indicator1,
714 indicator2
=> $indicator2,
715 subfield_loop
=> \
@subfields_data,
716 tagfirstsubfield
=> $subfields_data[0],
717 fixedfield
=> $tag < 10?
1:0,
720 push @loop_data, \
%tag_data ;
724 if ( $#loop_data >= 0 ) {
727 innerloop
=> \
@loop_data,
731 $template->param( BIG_LOOP
=> \
@BIG_LOOP );
735 # sub that tries to find authorities linked to the biblio
737 # - search in the authority DB for the same authid (in $9 of the biblio)
738 # - search in the authority DB for the same 001 (in $3 of the biblio in UNIMARC)
739 # - search in the authority DB for the same values (exactly) (in all subfields of the biblio)
740 # if the authority is found, the biblio is modified accordingly to be connected to the authority.
741 # if the authority is not found, it's added, and the biblio is then modified to be connected to the authority.
744 sub BiblioAddAuthorities
{
745 my ( $record, $frameworkcode ) = @_;
746 my $dbh=C4
::Context
->dbh;
747 my $query=$dbh->prepare(qq|
748 SELECT authtypecode
,tagfield
749 FROM marc_subfield_structure
750 WHERE frameworkcode
=?
751 AND
(authtypecode IS NOT NULL AND authtypecode
<>\"\")|);
752 # SELECT authtypecode,tagfield
753 # FROM marc_subfield_structure
754 # WHERE frameworkcode=?
755 # AND (authtypecode IS NOT NULL OR authtypecode<>\"\")|);
756 $query->execute($frameworkcode);
757 my ($countcreated,$countlinked);
758 while (my $data=$query->fetchrow_hashref){
759 foreach my $field ($record->field($data->{tagfield
})){
760 next if ($field->subfield('3')||$field->subfield('9'));
761 # No authorities id in the tag.
762 # Search if there is any authorities to link to.
763 my $query='at='.$data->{authtypecode
}.' ';
764 map {$query.= ' and he,ext="'.$_->[1].'"' if ($_->[0]=~/[A-z]/)} $field->subfields();
765 my ($error, $results, $total_hits)=SimpleSearch
( $query, undef, undef, [ "authorityserver" ] );
766 # there is only 1 result
768 warn "BIBLIOADDSAUTHORITIES: $error";
771 if ($results && scalar(@
$results)==1) {
772 my $marcrecord = MARC
::File
::USMARC
::decode
($results->[0]);
773 $field->add_subfields('9'=>$marcrecord->field('001')->data);
775 } elsif (scalar(@
$results)>1) {
776 #More than One result
777 #This can comes out of a lack of a subfield.
778 # my $marcrecord = MARC::File::USMARC::decode($results->[0]);
779 # $record->field($data->{tagfield})->add_subfields('9'=>$marcrecord->field('001')->data);
782 #There are no results, build authority record, add it to Authorities, get authid and add it to 9
783 ###NOTICE : This is only valid if a subfield is linked to one and only one authtypecode
784 ###NOTICE : This can be a problem. We should also look into other types and rejected forms.
785 my $authtypedata=GetAuthType
($data->{authtypecode
});
786 next unless $authtypedata;
787 my $marcrecordauth=MARC
::Record
->new();
788 if (C4
::Context
->preference('marcflavour') eq 'MARC21') {
789 $marcrecordauth->leader(' nz a22 o 4500');
790 SetMarcUnicodeFlag
($marcrecordauth, 'MARC21');
792 my $authfield=MARC
::Field
->new($authtypedata->{auth_tag_to_report
},'','',"a"=>"".$field->subfield('a'));
793 map { $authfield->add_subfields($_->[0]=>$_->[1]) if ($_->[0]=~/[A-z]/ && $_->[0] ne "a" )} $field->subfields();
794 $marcrecordauth->insert_fields_ordered($authfield);
796 # bug 2317: ensure new authority knows it's using UTF-8; currently
797 # only need to do this for MARC21, as MARC::Record->as_xml_record() handles
798 # automatically for UNIMARC (by not transcoding)
799 # FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
800 # use UTF-8, but as of 2008-08-05, did not want to introduce that kind
801 # of change to a core API just before the 3.0 release.
803 if (C4
::Context
->preference('marcflavour') eq 'MARC21') {
804 $marcrecordauth->insert_fields_ordered(MARC
::Field
->new('667','','','a'=>"Machine generated authority record."));
805 my $cite = $record->author() . ", " . $record->title_proper() . ", " . $record->publication_date() . " ";
806 $cite =~ s/^[\s\,]*//;
807 $cite =~ s/[\s\,]*$//;
808 $cite = "Work cat.: (" . C4
::Context
->preference('MARCOrgCode') . ")". $record->subfield('999','c') . ": " . $cite;
809 $marcrecordauth->insert_fields_ordered(MARC
::Field
->new('670','','','a'=>$cite));
812 # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
814 my $authid=AddAuthority
($marcrecordauth,'',$data->{authtypecode
});
816 $field->add_subfields('9'=>$authid);
820 return ($countlinked,$countcreated);
823 # ========================
825 #=========================
827 my $error = $input->param('error');
828 my $biblionumber = $input->param('biblionumber'); # if biblionumber exists, it's a modif, not a new biblio.
829 my $breedingid = $input->param('breedingid');
830 my $z3950 = $input->param('z3950');
831 my $op = $input->param('op');
832 my $mode = $input->param('mode');
833 my $frameworkcode = $input->param('frameworkcode');
834 my $redirect = $input->param('redirect');
835 my $dbh = C4
::Context
->dbh;
837 my $userflags = ($frameworkcode eq 'FA') ?
"fast_cataloging" : "edit_catalogue";
839 $frameworkcode = &GetFrameworkCode
($biblionumber)
840 if ( $biblionumber and not($frameworkcode) );
842 $frameworkcode = '' if ( $frameworkcode eq 'Default' );
843 my ( $template, $loggedinuser, $cookie ) = get_template_and_user
(
845 template_name
=> "cataloguing/addbiblio.tmpl",
848 authnotrequired
=> 0,
849 flagsrequired
=> { editcatalogue
=> $userflags },
853 # Getting the list of all frameworks
855 my $frameworks = getframeworks
;
856 my @frameworkcodeloop;
857 foreach my $thisframeworkcode ( keys %$frameworks ) {
859 value
=> $thisframeworkcode,
860 frameworktext
=> $frameworks->{$thisframeworkcode}->{'frameworktext'},
862 if ($frameworkcode eq $thisframeworkcode){
863 $row{'selected'}="selected=\"selected\"";
865 push @frameworkcodeloop, \
%row;
867 $template->param( frameworkcodeloop
=> \
@frameworkcodeloop,
868 breedingid
=> $breedingid );
871 $tagslib = &GetMarcStructure
( 1, $frameworkcode );
872 $usedTagsLib = &GetUsedMarcStructure
( $frameworkcode );
873 $mandatory_z3950 = GetMandatoryFieldZ3950
($frameworkcode);
879 $biblionumbertagfield,
880 $biblionumbertagsubfield,
881 $biblioitemnumtagfield,
882 $biblioitemnumtagsubfield,
887 if (($biblionumber) && !($breedingid)){
888 $record = GetMarcBiblio
($biblionumber);
891 ( $record, $encoding ) = MARCfindbreeding
( $breedingid ) ;
898 $template->param( title
=> $record->title(), );
900 # if it's a modif, retrieve bibli and biblioitem numbers for the future modification of old-DB.
901 ( $biblionumbertagfield, $biblionumbertagsubfield ) =
902 &GetMarcFromKohaField
( "biblio.biblionumber", $frameworkcode );
903 ( $biblioitemnumtagfield, $biblioitemnumtagsubfield ) =
904 &GetMarcFromKohaField
( "biblioitems.biblioitemnumber", $frameworkcode );
906 # search biblioitems value
907 my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
908 $sth->execute($biblionumber);
909 ($biblioitemnumber) = $sth->fetchrow;
912 #-------------------------------------------------------------------------------------
913 if ( $op eq "addbiblio" ) {
914 #-------------------------------------------------------------------------------------
916 my @params = $input->param();
917 $record = TransformHtmlToMarc
( \
@params , $input );
918 # check for a duplicate
919 my ($duplicatebiblionumber,$duplicatetitle) = FindDuplicate
($record) if (!$is_a_modif);
920 my $confirm_not_duplicate = $input->param('confirm_not_duplicate');
921 # it is not a duplicate (determined either by Koha itself or by user checking it's not a duplicate)
922 if ( !$duplicatebiblionumber or $confirm_not_duplicate ) {
925 if (C4
::Context
->preference("BiblioAddsAuthorities")){
926 my ($countlinked,$countcreated)=BiblioAddAuthorities
($record,$frameworkcode);
929 ModBiblioframework
( $biblionumber, $frameworkcode );
930 ModBiblio
( $record, $biblionumber, $frameworkcode );
933 ( $biblionumber, $oldbibitemnum ) = AddBiblio
( $record, $frameworkcode );
936 if (($mode ne "popup" && !$is_a_modif) || $redirect eq "items"){
937 print $input->redirect(
938 "/cgi-bin/koha/cataloguing/additem.pl?biblionumber=$biblionumber&frameworkcode=$frameworkcode"
942 elsif($is_a_modif || $redirect eq "view"){
943 my $defaultview = C4
::Context
->preference('IntranetBiblioDefaultView');
944 my $views = { C4
::Search
::enabled_staff_search_views
};
945 if ($defaultview eq 'isbd' && $views->{can_view_ISBD
}) {
946 print $input->redirect("/cgi-bin/koha/catalogue/ISBDdetail.pl?biblionumber=$biblionumber");
947 } elsif ($defaultview eq 'marc' && $views->{can_view_MARC
}) {
948 print $input->redirect("/cgi-bin/koha/catalogue/MARCdetail.pl?biblionumber=$biblionumber&frameworkcode=$frameworkcode");
949 } elsif ($defaultview eq 'labeled_marc' && $views->{can_view_labeledMARC
}) {
950 print $input->redirect("/cgi-bin/koha/catalogue/labeledMARCdetail.pl?biblionumber=$biblionumber");
952 print $input->redirect("/cgi-bin/koha/catalogue/detail.pl?biblionumber=$biblionumber");
958 biblionumber
=> $biblionumber,
962 $template->param( title
=> $record->subfield('200',"a") ) if ($record ne "-1" && C4
::Context
->preference('marcflavour') =~/unimarc/i);
963 $template->param( title
=> $record->title() ) if ($record ne "-1" && C4
::Context
->preference('marcflavour') eq "usmarc");
966 itemtype
=> $frameworkcode,
968 output_html_with_http_headers
$input, $cookie, $template->output;
972 # it may be a duplicate, warn the user and do nothing
973 build_tabs
($template, $record, $dbh,$encoding,$input);
975 biblionumber
=> $biblionumber,
976 biblioitemnumber
=> $biblioitemnumber,
977 duplicatebiblionumber
=> $duplicatebiblionumber,
978 duplicatebibid
=> $duplicatebiblionumber,
979 duplicatetitle
=> $duplicatetitle,
983 elsif ( $op eq "delete" ) {
985 my $error = &DelBiblio
($biblionumber);
987 warn "ERROR when DELETING BIBLIO $biblionumber : $error";
988 print "Content-Type: text/html\n\n<html><body><h1>ERROR when DELETING BIBLIO $biblionumber : $error</h1></body></html>";
992 print $input->redirect('/cgi-bin/koha/catalogue/search.pl');
996 #----------------------------------------------------------------------------
997 # If we're in a duplication case, we have to set to "" the biblionumber
998 # as we'll save the biblio as a new one.
999 if ( $op eq "duplicate" ) {
1003 #FIXME: it's kind of silly to go from MARC::Record to MARC::File::XML and then back again just to fix the encoding
1005 my $uxml = $record->as_xml;
1006 MARC
::Record
::default_record_format
("UNIMARC")
1007 if ( C4
::Context
->preference("marcflavour") eq "UNIMARC" );
1008 my $urecord = MARC
::Record
::new_from_xml
( $uxml, 'UTF-8' );
1011 build_tabs
( $template, $record, $dbh, $encoding,$input );
1013 biblionumber
=> $biblionumber,
1014 biblionumbertagfield
=> $biblionumbertagfield,
1015 biblionumbertagsubfield
=> $biblionumbertagsubfield,
1016 biblioitemnumtagfield
=> $biblioitemnumtagfield,
1017 biblioitemnumtagsubfield
=> $biblioitemnumtagsubfield,
1018 biblioitemnumber
=> $biblioitemnumber,
1022 $template->param( title
=> $record->title() ) if ( $record ne "-1" );
1023 if (C4
::Context
->preference("marcflavour") eq "MARC21"){
1024 $template->param(MARC21
=> 1);
1028 frameworkcode
=> $frameworkcode,
1029 itemtype
=> $frameworkcode,
1032 output_html_with_http_headers
$input, $cookie, $template->output;