d216757b0c2c68b470c5f9c512ac7acce0ecaaa8
[koha.git] / cataloguing / addbiblio.pl
1 #!/usr/bin/perl 
2
3
4 # Copyright 2000-2002 Katipo Communications
5 #
6 # This file is part of Koha.
7 #
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
11 # version.
12 #
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.
16 #
17 # You should have received a copy of the GNU General Public License along with
18 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
19 # Suite 330, Boston, MA  02111-1307 USA
20
21 use strict;
22 use CGI;
23 use C4::Output;
24 use C4::Auth;
25 use C4::Biblio;
26 use C4::Search;
27 use C4::AuthoritiesMarc;
28 use C4::Context;
29 use MARC::Record;
30 use C4::Log;
31 use C4::Koha;    # XXX subfield_is_koha_internal_p
32 use Date::Calc qw(Today);
33 use MARC::File::USMARC;
34 use MARC::File::XML;
35
36 if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
37     MARC::File::XML->default_record_format('UNIMARC');
38 }
39
40 our($tagslib,$authorised_values_sth,$is_a_modif,$usedTagsLib,$mandatory_z3950);
41
42 =item MARCfindbreeding
43
44     $record = MARCfindbreeding($dbh, $breedingid);
45
46 Look up the breeding farm with database handle $dbh, for the
47 record with id $breedingid.  If found, returns the decoded
48 MARC::Record; otherwise, -1 is returned (FIXME).
49 Returns as second parameter the character encoding.
50
51 =cut
52
53 sub MARCfindbreeding {
54     my ( $dbh, $id ) = @_;
55     my $sth =
56       $dbh->prepare("select file,marc,encoding from marc_breeding where id=?");
57     $sth->execute($id);
58     my ( $file, $marc, $encoding ) = $sth->fetchrow;
59     # remove the - in isbn, koha store isbn without any -
60     if ($marc) {
61         my $record = MARC::Record->new_from_usmarc($marc);
62         my ($isbnfield,$isbnsubfield) = GetMarcFromKohaField('biblioitems.isbn','');
63         if ( $record->field($isbnfield) ) {
64             foreach my $field ( $record->field($isbnfield) ) {
65                 foreach my $subfield ( $field->subfield($isbnsubfield) ) {
66                     my $newisbn = $field->subfield($isbnsubfield);
67                     $newisbn =~ s/-//g;
68                     $field->update( $isbnsubfield => $newisbn );
69                 }
70             }
71         }
72         # fix the unimarc 100 coded field (with unicode information)
73         if (C4::Context->preference('marcflavour') eq 'UNIMARC' && $record->subfield(100,'a')) {
74             my $f100a=$record->subfield(100,'a');
75             my $f100 = $record->field(100);
76             my $f100temp = $f100->as_string;
77             $record->delete_field($f100);
78             if ( length($f100temp) > 28 ) {
79                 substr( $f100temp, 26, 2, "50" );
80                 $f100->update( 'a' => $f100temp );
81                 my $f100 = MARC::Field->new( '100', '', '', 'a' => $f100temp );
82                 $record->insert_fields_ordered($f100);
83             }
84         }
85                 
86         if ( ref($record) eq undef ) {
87             return -1;
88         }
89         else {
90             # normalize author : probably UNIMARC specific...
91             if (    C4::Context->preference("z3950NormalizeAuthor")
92                 and C4::Context->preference("z3950AuthorAuthFields") )
93             {
94                 my ( $tag, $subfield ) = GetMarcFromKohaField("biblio.author");
95
96  #                 my $summary = C4::Context->preference("z3950authortemplate");
97                 my $auth_fields =
98                   C4::Context->preference("z3950AuthorAuthFields");
99                 my @auth_fields = split /,/, $auth_fields;
100                 my $field;
101
102                 if ( $record->field($tag) ) {
103                     foreach my $tmpfield ( $record->field($tag)->subfields ) {
104
105        #                        foreach my $subfieldcode ($tmpfield->subfields){
106                         my $subfieldcode  = shift @$tmpfield;
107                         my $subfieldvalue = shift @$tmpfield;
108                         if ($field) {
109                             $field->add_subfields(
110                                 "$subfieldcode" => $subfieldvalue )
111                               if ( $subfieldcode ne $subfield );
112                         }
113                         else {
114                             $field =
115                               MARC::Field->new( $tag, "", "",
116                                 $subfieldcode => $subfieldvalue )
117                               if ( $subfieldcode ne $subfield );
118                         }
119                     }
120                 }
121                 $record->delete_field( $record->field($tag) );
122                 foreach my $fieldtag (@auth_fields) {
123                     next unless ( $record->field($fieldtag) );
124                     my $lastname  = $record->field($fieldtag)->subfield('a');
125                     my $firstname = $record->field($fieldtag)->subfield('b');
126                     my $title     = $record->field($fieldtag)->subfield('c');
127                     my $number    = $record->field($fieldtag)->subfield('d');
128                     if ($title) {
129
130 #                         $field->add_subfields("$subfield"=>"[ ".ucfirst($title).ucfirst($firstname)." ".$number." ]");
131                         $field->add_subfields(
132                                 "$subfield" => ucfirst($title) . " "
133                               . ucfirst($firstname) . " "
134                               . $number );
135                     }
136                     else {
137
138 #                       $field->add_subfields("$subfield"=>"[ ".ucfirst($firstname).", ".ucfirst($lastname)." ]");
139                         $field->add_subfields(
140                             "$subfield" => ucfirst($firstname) . ", "
141                               . ucfirst($lastname) );
142                     }
143                 }
144                 $record->insert_fields_ordered($field);
145             }
146             return $record, $encoding;
147         }
148     }
149     return -1;
150 }
151
152 =item build_authorized_values_list
153
154 =cut
155
156 sub build_authorized_values_list ($$$$$$$) {
157     my ( $tag, $subfield, $value, $dbh, $authorised_values_sth,$index_tag,$index_subfield ) = @_;
158
159     my @authorised_values;
160     my %authorised_lib;
161
162     # builds list, depending on authorised value...
163
164     #---- branch
165     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
166         my $sth =
167           $dbh->prepare(
168             "select branchcode,branchname from branches order by branchname");
169         $sth->execute;
170         push @authorised_values, ""
171           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
172
173         while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
174             push @authorised_values, $branchcode;
175             $authorised_lib{$branchcode} = $branchname;
176         }
177
178         #----- itemtypes
179     }
180     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes" ) {
181         my $sth =
182           $dbh->prepare(
183             "select itemtype,description from itemtypes order by description");
184         $sth->execute;
185         push @authorised_values, ""
186           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
187           
188         my $itemtype;
189         
190         while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
191             push @authorised_values, $itemtype;
192             $authorised_lib{$itemtype} = $description;
193         }
194         $value = $itemtype unless ($value);
195
196         #---- "true" authorised value
197     }
198     else {
199         $authorised_values_sth->execute(
200             $tagslib->{$tag}->{$subfield}->{authorised_value} );
201
202         push @authorised_values, ""
203           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
204
205         while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
206             push @authorised_values, $value;
207             $authorised_lib{$value} = $lib;
208         }
209     }
210     return CGI::scrolling_list(
211         -name     => "tag_".$tag."_subfield_".$subfield."_".$index_tag."_".$index_subfield,
212         -values   => \@authorised_values,
213         -default  => $value,
214         -labels   => \%authorised_lib,
215         -override => 1,
216         -size     => 1,
217         -multiple => 0,
218         -tabindex => 1,
219         -id       => "tag_".$tag."_subfield_".$subfield."_".$index_tag."_".$index_subfield,
220         -class    => "input_marceditor",
221     );
222 }
223
224 =item CreateKey
225
226     Create a random value to set it into the input name
227
228 =cut
229
230 sub CreateKey(){
231     return int(rand(1000000));
232 }
233
234 =item GetMandatoryFieldZ3950
235
236     This function return an hashref which containts all mandatory field
237     to search with z3950 server.
238     
239 =cut
240
241 sub GetMandatoryFieldZ3950($){
242     my $frameworkcode = shift;
243     my @isbn   = GetMarcFromKohaField('biblioitems.isbn',$frameworkcode);
244     my @title  = GetMarcFromKohaField('biblio.title',$frameworkcode);
245     my @author = GetMarcFromKohaField('biblio.author',$frameworkcode);
246     my @issn   = GetMarcFromKohaField('biblioitems.issn',$frameworkcode);
247     
248     return {
249         $isbn[0].$isbn[1]     => 'isbn',
250         $title[0].$title[1]   => 'title',
251         $author[0].$author[1] => 'author',
252         $issn[0].$issn[1]     => 'issn',
253     };
254 }
255
256 =item create_input
257
258  builds the <input ...> entry for a subfield.
259
260 =cut
261
262 sub create_input {
263     my ( $tag, $subfield, $value, $index_tag, $tabloop, $rec, $authorised_values_sth,$cgi ) = @_;
264     
265     my $index_subfield = CreateKey(); # create a specifique key for each subfield
266
267     $value =~ s/"/&quot;/g;
268
269     # if there is no value provided but a default value in parameters, get it
270     unless ($value) {
271         $value = $tagslib->{$tag}->{$subfield}->{defaultvalue};
272
273         # get today date & replace YYYY, MM, DD if provided in the default value
274         my ( $year, $month, $day ) = Today();
275         $month = sprintf( "%02d", $month );
276         $day   = sprintf( "%02d", $day );
277         $value =~ s/YYYY/$year/g;
278         $value =~ s/MM/$month/g;
279         $value =~ s/DD/$day/g;
280     }
281     my $dbh = C4::Context->dbh;
282     my %subfield_data = (
283         tag        => $tag,
284         subfield   => $subfield,
285         marc_lib   => substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 22 ),
286         marc_lib_plain => $tagslib->{$tag}->{$subfield}->{lib}, 
287         tag_mandatory  => $tagslib->{$tag}->{mandatory},
288         mandatory      => $tagslib->{$tag}->{$subfield}->{mandatory},
289         repeatable     => $tagslib->{$tag}->{$subfield}->{repeatable},
290         kohafield      => $tagslib->{$tag}->{$subfield}->{kohafield},
291         index          => $index_tag,
292         id             => "tag_".$tag."_subfield_".$subfield."_".$index_tag."_".$index_subfield,
293         value          => $value,
294         random         => CreateKey(),
295     );
296     # deal with a <010 tag
297     if($subfield eq '@'){
298         $subfield_data{id} = "tag_".$tag."_subfield_00_".$index_tag."_".$index_subfield;
299     } else {
300          $subfield_data{id} = "tag_".$tag."_subfield_".$subfield."_".$index_tag."_".$index_subfield;
301     }
302
303     if(exists $mandatory_z3950->{$tag.$subfield}){
304         $subfield_data{z3950_mandatory} = $mandatory_z3950->{$tag.$subfield};
305     }
306     # decide if the subfield must be expanded (visible) by default or not
307     # if it is mandatory, then expand. If it is hidden explicitly by the hidden flag, hidden anyway
308     $subfield_data{visibility} = "display:none;"
309         if (    ($tagslib->{$tag}->{$subfield}->{hidden} % 2 == 1) and $value ne ''
310             or ($value eq '' and !$tagslib->{$tag}->{$subfield}->{mandatory})
311         );
312     # always expand all subfields of a mandatory field
313     $subfield_data{visibility} = "" if $tagslib->{$tag}->{mandatory};
314     # it's an authorised field
315     if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
316         $subfield_data{marc_value} =
317           build_authorized_values_list( $tag, $subfield, $value, $dbh,
318             $authorised_values_sth,$index_tag,$index_subfield );
319
320     # it's a thesaurus / authority field
321     }
322     elsif ( $tagslib->{$tag}->{$subfield}->{authtypecode} ) {
323         $subfield_data{marc_value} =
324             "<input type=\"text\"
325                     id=\"".$subfield_data{id}."\"
326                     name=\"".$subfield_data{id}."\"
327                     value=\"$value\"
328                     class=\"input_marceditor\"
329                     tabindex=\"1\"
330                     size=\"67\"
331                     maxlength=\"255\" 
332                     \/>
333                     <a href=\"#\" class=\"buttonDot\"
334                         onclick=\"Dopop('/cgi-bin/koha/authorities/auth_finder.pl?authtypecode=".$tagslib->{$tag}->{$subfield}->{authtypecode}."&index=$subfield_data{id}','$subfield_data{id}'); return false;\" title=\"Tag Editor\">...</a>
335                 ";
336     # it's a plugin field
337     }
338     elsif ( $tagslib->{$tag}->{$subfield}->{'value_builder'} ) {
339
340         # opening plugin. Just check wether we are on a developper computer on a production one
341         # (the cgidir differs)
342         my $cgidir = C4::Context->intranetdir . "/cgi-bin/cataloguing/value_builder";
343         unless ( opendir( DIR, "$cgidir" ) ) {
344             $cgidir = C4::Context->intranetdir . "/cataloguing/value_builder";
345         }
346         my $plugin = $cgidir . "/" . $tagslib->{$tag}->{$subfield}->{'value_builder'};
347         do $plugin || die "Plugin Failed: ".$plugin;
348         my $extended_param = plugin_parameters( $dbh, $rec, $tagslib, $subfield_data{id}, $tabloop );
349         my ( $function_name, $javascript ) = plugin_javascript( $dbh, $rec, $tagslib, $subfield_data{id}, $tabloop );
350 #         my ( $function_name, $javascript,$extended_param );
351         
352         $subfield_data{marc_value} =
353                 "<input tabindex=\"1\"
354                         type=\"text\"
355                         id=\"".$subfield_data{id}."\"
356                         name=\"".$subfield_data{id}."\"
357                         value=\"$value\"
358                         class=\"input_marceditor\"
359                         onfocus=\"Focus$function_name($index_tag)\"
360                         size=\"67\"
361                         maxlength=\"255\" 
362                         onblur=\"Blur$function_name($index_tag); \" \/>
363                         <a href=\"#\" class=\"buttonDot\" onclick=\"Clic$function_name('$subfield_data{id}'; return false;)\" title=\"Tag Editor\">...</a>
364                 $javascript";
365         # it's an hidden field
366     }
367     elsif ( $tag eq '' ) {
368         $subfield_data{marc_value} =
369             "<input tabindex=\"1\"
370                     type=\"hidden\"
371                     id=\"".$subfield_data{id}."\"
372                     name=\"".$subfield_data{id}."\"
373                     size=\"67\"
374                     maxlength=\"255\" 
375                     value=\"$value\" \/>
376             ";
377     }
378     elsif ( $tagslib->{$tag}->{$subfield}->{'hidden'} ) {
379         $subfield_data{marc_value} =
380             "<input type=\"text\"
381                     id=\"".$subfield_data{id}."\"
382                     name=\"".$subfield_data{id}."\"
383                     class=\"input_marceditor\"
384                     tabindex=\"1\"
385                     size=\"67\"
386                     maxlength=\"255\" 
387                     value=\"$value\"
388             \/>";
389
390         # it's a standard field
391     }
392     else {
393         if (
394             length($value) > 100
395             or
396             ( C4::Context->preference("marcflavour") eq "UNIMARC" && $tag >= 300
397                 and $tag < 400 && $subfield eq 'a' )
398             or (    $tag >= 500
399                 and $tag < 600
400                 && C4::Context->preference("marcflavour") eq "MARC21" )
401           )
402         {
403             $subfield_data{marc_value} =
404                 "<textarea cols=\"70\"
405                            rows=\"4\"
406                            id=\"".$subfield_data{id}."\"
407                            name=\"".$subfield_data{id}."\"
408                            class=\"input_marceditor\"
409                            tabindex=\"1\"
410                             size=\"67\"
411                             maxlength=\"255\" 
412                            >$value</textarea>
413                 ";
414         }
415         else {
416             $subfield_data{marc_value} =
417                 "<input type=\"text\"
418                         id=\"".$subfield_data{id}."\"
419                         name=\"".$subfield_data{id}."\"
420                         value=\"$value\"
421                         tabindex=\"1\"
422                         size=\"67\"
423                         maxlength=\"255\" 
424                         class=\"input_marceditor\"
425                 \/>
426                 ";
427         }
428     }
429     $subfield_data{'index_subfield'} = $index_subfield;
430     return \%subfield_data;
431 }
432
433 sub build_tabs ($$$$$) {
434     my ( $template, $record, $dbh, $encoding,$input ) = @_;
435
436     # fill arrays
437     my @loop_data = ();
438     my $tag;
439
440     my $authorised_values_sth = $dbh->prepare(
441         "select authorised_value,lib
442         from authorised_values
443         where category=? order by lib"
444     );
445     
446     # in this array, we will push all the 10 tabs
447     # to avoid having 10 tabs in the template : they will all be in the same BIG_LOOP
448     my @BIG_LOOP;
449     my %seen;
450     my @tab_data; # all tags to display
451     
452     foreach my $used ( @$usedTagsLib ){
453         push @tab_data,$used->{tagfield} if not $seen{$used->{tagfield}};
454         $seen{$used->{tagfield}}++;
455     }
456         
457     my $max_num_tab=-1;
458     foreach(@$usedTagsLib){
459         if($_->{tab} > -1 && $_->{tab} >= $max_num_tab && $_->{tagfield} != '995'){ # FIXME : MARC21 ?
460             $max_num_tab = $_->{tab}; 
461         }
462     }
463     if($max_num_tab >= 9){
464         $max_num_tab = 9;
465     }
466     # loop through each tab 0 through 9
467     for ( my $tabloop = 0 ; $tabloop <= $max_num_tab ; $tabloop++ ) {
468         my @loop_data = (); #innerloop in the template.
469         my $i = 0;
470         foreach my $tag (@tab_data) {
471             $i++;
472             next if ! $tag;
473             my $indicator;
474             my $index_tag = CreateKey;
475
476             # if MARC::Record is not empty =>use it as master loop, then add missing subfields that should be in the tab.
477             # if MARC::Record is empty => use tab as master loop.
478             if ( $record ne -1 && ( $record->field($tag) || $tag eq '000' ) ) {
479                 my @fields;
480                 if ( $tag ne '000' ) {
481                     @fields = $record->field($tag);
482                 }
483                 else {
484                    push @fields, $record->leader(); # if tag == 000
485                 }
486                 # loop through each field
487                 foreach my $field (@fields) {
488                     
489                     my @subfields_data;
490                     if ( $tag < 10 ) {
491                         my ( $value, $subfield );
492                         if ( $tag ne '000' ) {
493                             $value    = $field->data();
494                             $subfield = "@";
495                         }
496                         else {
497                             $value    = $field;
498                             $subfield = '@';
499                         }
500                         next if ( $tagslib->{$tag}->{$subfield}->{tab} ne $tabloop );
501                         next
502                           if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
503                             'biblio.biblionumber' );
504                         push(
505                             @subfields_data,
506                             &create_input(
507                                 $tag, $subfield, $value, $index_tag, $tabloop, $record,
508                                 $authorised_values_sth,$input
509                             )
510                         );
511                     }
512                     else {
513                         my @subfields = $field->subfields();
514                         foreach my $subfieldcount ( 0 .. $#subfields ) {
515                             my $subfield = $subfields[$subfieldcount][0];
516                             my $value    = $subfields[$subfieldcount][1];
517                             next if ( length $subfield != 1 );
518                             next if ( $tagslib->{$tag}->{$subfield}->{tab} ne $tabloop );
519                             push(
520                                 @subfields_data,
521                                 &create_input(
522                                     $tag, $subfield, $value, $index_tag, $tabloop,
523                                     $record, $authorised_values_sth,$input
524                                 )
525                             );
526                         }
527                     }
528
529                     # now, loop again to add parameter subfield that are not in the MARC::Record
530                     foreach my $subfield ( sort( keys %{ $tagslib->{$tag} } ) )
531                     {
532                         next if ( length $subfield != 1 );
533                         next if ( $tagslib->{$tag}->{$subfield}->{tab} ne $tabloop );
534                         next if ( $tag < 10 );
535                         next
536                           if ( ( $tagslib->{$tag}->{$subfield}->{hidden} <= -4 )
537                             or ( $tagslib->{$tag}->{$subfield}->{hidden} >= 5 )
538                           );    #check for visibility flag
539                         next if ( defined( $field->subfield($subfield) ) );
540                         push(
541                             @subfields_data,
542                             &create_input(
543                                 $tag, $subfield, '', $index_tag, $tabloop, $record,
544                                 $authorised_values_sth,$input
545                             )
546                         );
547                     }
548                     if ( $#subfields_data >= 0 ) {
549                         # build the tag entry.
550                         # note that the random() field is mandatory. Otherwise, on repeated fields, you'll 
551                         # have twice the same "name" value, and cgi->param() will return only one, making
552                         # all subfields to be merged in a single field.
553                         my %tag_data = (
554                             tag           => $tag,
555                             index         => $index_tag,
556                             tag_lib       => $tagslib->{$tag}->{lib},
557                             repeatable       => $tagslib->{$tag}->{repeatable},
558                             subfield_loop => \@subfields_data,
559                             fixedfield    => $tag < 10?1:0,
560                             random        => CreateKey,
561                         );
562                         if ($tag >= 010){ # no indicator for theses tag
563                            $tag_data{indicator} = $field->indicator(1).$field->indicator(2);
564                         }
565                         push( @loop_data, \%tag_data );
566                     }
567                  } # foreach $field end
568
569             # if breeding is empty
570             }
571             else {
572                 my @subfields_data;
573                 foreach my $subfield ( sort( keys %{ $tagslib->{$tag} } ) ) {
574                     next if ( length $subfield != 1 );
575                     next
576                       if ( ( $tagslib->{$tag}->{$subfield}->{hidden} <= -5 )
577                         or ( $tagslib->{$tag}->{$subfield}->{hidden} >= 4 ) )
578                       ;    #check for visibility flag
579                     next
580                       if ( $tagslib->{$tag}->{$subfield}->{tab} ne $tabloop );
581                     push(
582                         @subfields_data,
583                         &create_input(
584                             $tag, $subfield, '', $index_tag, $tabloop, $record,
585                             $authorised_values_sth,$input
586                         )
587                     );
588                 }
589                 if ( $#subfields_data >= 0 ) {
590                     my %tag_data = (
591                         tag              => $tag,
592                         index            => $index_tag,
593                         tag_lib          => $tagslib->{$tag}->{lib},
594                         repeatable       => $tagslib->{$tag}->{repeatable},
595                         indicator        => $indicator,
596                         subfield_loop    => \@subfields_data,
597                         tagfirstsubfield => $subfields_data[0],
598                         fixedfield       => $tag < 10?1:0,
599                     );
600                     
601                     push @loop_data, \%tag_data ;
602                 }
603             }
604         }
605         if ( $#loop_data >= 0 ) {
606             push @BIG_LOOP, {
607                 number    => $tabloop,
608                 innerloop => \@loop_data,
609             };
610         }
611     }
612     $template->param( BIG_LOOP => \@BIG_LOOP );
613 }
614
615 sub BiblioAddAuthorities{
616   my ( $record, $frameworkcode ) = @_;
617   my $dbh=C4::Context->dbh;
618   my $query=$dbh->prepare(qq|
619 SELECT authtypecode,tagfield
620 FROM marc_subfield_structure 
621 WHERE frameworkcode=? 
622 AND (authtypecode IS NOT NULL AND authtypecode<>\"\")|);
623 # SELECT authtypecode,tagfield
624 # FROM marc_subfield_structure 
625 # WHERE frameworkcode=? 
626 # AND (authtypecode IS NOT NULL OR authtypecode<>\"\")|);
627   $query->execute($frameworkcode);
628   my ($countcreated,$countlinked);
629   while (my $data=$query->fetchrow_hashref){
630     if ($record->field($data->{tagfield})){
631       next if ($record->subfield($data->{tagfield},'3')||$record->subfield($data->{tagfield},'9'));
632       # No authorities id in the tag.
633       # Search if there is any authorities to link to.
634       my $query='at='.$data->{authtypecode}.' ';
635       map {$query.= " and he=".$_->[1] if ($_->[0]=~/[A-z]/)}  $record->field($data->{tagfield})->subfields();
636       my ($error,$results)=SimpleSearch($query,"authorityserver");
637     # there is at least 1 result => return the 1st one
638       if (@$results>1) {
639         my $marcrecord = MARC::File::USMARC::decode($results->[0]);
640         $record->field($data->{tagfield})->add_subfields('9'=>$marcrecord->field('001')->data);
641   $countlinked++;
642       } else {
643   #There are no results, build authority record, add it to Authorities, get authid and add it to 9
644   ###NOTICE : This is only valid if a subfield is linked to one and only one authtypecode
645      
646         my $authtypedata=GetAuthType($data->{authtypecode});
647         my $marcrecordauth=MARC::Record->new();
648         my $field=MARC::Field->new($authtypedata->{auth_tag_to_report},'','',"a"=>"".$record->subfield($data->{tagfield},'a'));
649         map { $field->add_subfields($_->[0]=>$_->[1]) if ($_->[0]=~/[A-z]/ && $_->[0] ne "a" )}  $record->field($data->{tagfield})->subfields();
650         $marcrecordauth->insert_fields_ordered($field);
651         my $authid=AddAuthority($marcrecordauth,'',$data->{authtypecode});
652         $countcreated++;
653         $record->field($data->{tagfield})->add_subfields('9'=>$authid);
654       }
655     }  
656   }
657   return ($countlinked,$countcreated);
658 }
659
660 # ========================
661 #          MAIN
662 #=========================
663 my $input = new CGI;
664 my $error = $input->param('error');
665 my $biblionumber  = $input->param('biblionumber'); # if biblionumber exists, it's a modif, not a new biblio.
666 my $breedingid    = $input->param('breedingid');
667 my $z3950         = $input->param('z3950');
668 my $op            = $input->param('op');
669 my $mode          = $input->param('mode');
670 my $frameworkcode = $input->param('frameworkcode');
671 my $dbh           = C4::Context->dbh;
672
673 $frameworkcode = &GetFrameworkCode($biblionumber)
674   if ( $biblionumber and not($frameworkcode) );
675
676 $frameworkcode = '' if ( $frameworkcode eq 'Default' );
677 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
678     {
679         template_name   => "cataloguing/addbiblio.tmpl",
680         query           => $input,
681         type            => "intranet",
682         authnotrequired => 0,
683         flagsrequired   => { editcatalogue => 1 },
684     }
685 );
686
687 #Getting the list of all frameworks
688 my $queryfwk = $dbh->prepare("select frameworktext, frameworkcode from biblio_framework");
689 $queryfwk->execute;
690 my %select_fwk;
691 my @select_fwk;
692 my $curfwk;
693 push @select_fwk, "Default";
694 $select_fwk{"Default"} = "Default";
695
696 while ( my ( $description, $fwk ) = $queryfwk->fetchrow ) {
697     push @select_fwk, $fwk;
698     $select_fwk{$fwk} = $description;
699 }
700 $curfwk = $frameworkcode;
701 my $framework = CGI::scrolling_list(
702     -name     => 'Frameworks',
703     -id       => 'Frameworks',
704     -default  => $curfwk,
705     -onchange => 'Changefwk(this);',
706     -values   => \@select_fwk,
707     -labels   => \%select_fwk,
708     -size     => 1,
709     -multiple => 0
710 );
711 $template->param( framework => $framework, breedingid => $breedingid );
712
713 # ++ Global
714 $tagslib         = &GetMarcStructure( 1, $frameworkcode );
715 $usedTagsLib     = &GetUsedMarcStructure( $frameworkcode );
716 $mandatory_z3950 = GetMandatoryFieldZ3950($frameworkcode);
717 # -- Global
718
719 my $record   = -1;
720 my $encoding = "";
721 my (
722         $biblionumbertagfield,
723         $biblionumbertagsubfield,
724         $biblioitemnumtagfield,
725         $biblioitemnumtagsubfield,
726         $bibitem,
727         $biblioitemnumber
728 );
729
730 if (($biblionumber) && !($breedingid)){
731         $record = GetMarcBiblio($biblionumber);
732 }
733 if ($breedingid) {
734     ( $record, $encoding ) = MARCfindbreeding( $dbh, $breedingid ) ;
735 }
736
737 $is_a_modif = 0;
738     
739 if ($biblionumber) {
740     $is_a_modif = 1;
741
742     # if it's a modif, retrieve bibli and biblioitem numbers for the future modification of old-DB.
743     ( $biblionumbertagfield, $biblionumbertagsubfield ) =
744         &GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
745     ( $biblioitemnumtagfield, $biblioitemnumtagsubfield ) =
746         &GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
747             
748     # search biblioitems value
749     my $sth =  $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
750     $sth->execute($biblionumber);
751     ($biblioitemnumber) = $sth->fetchrow;
752 }
753
754 #-------------------------------------------------------------------------------------
755 if ( $op eq "addbiblio" ) {
756 #-------------------------------------------------------------------------------------
757     # getting html input
758     my @params = $input->param();
759     $record = TransformHtmlToMarc( \@params , $input );
760     # check for a duplicate
761     my ($duplicatebiblionumber,$duplicatetitle) = FindDuplicate($record) if (!$is_a_modif);
762     my $confirm_not_duplicate = $input->param('confirm_not_duplicate');
763     # it is not a duplicate (determined either by Koha itself or by user checking it's not a duplicate)
764     if ( !$duplicatebiblionumber or $confirm_not_duplicate ) {
765         my $oldbibnum;
766         my $oldbibitemnum;
767         if (C4::Context->preference("BiblioAddsAuthorities")){
768           my ($countlinked,$countcreated)=BiblioAddAuthorities($record,$frameworkcode);
769         } 
770         if ( $is_a_modif ) {
771             ModBiblioframework( $biblionumber, $frameworkcode ); 
772             ModBiblio( $record, $biblionumber, $frameworkcode );
773         }
774         else {
775             ( $biblionumber, $oldbibitemnum ) = AddBiblio( $record, $frameworkcode );
776         }
777
778         if ($mode ne "popup"){
779             print $input->redirect(
780                 "/cgi-bin/koha/cataloguing/additem.pl?biblionumber=$biblionumber&frameworkcode=$frameworkcode"
781             );
782             exit;
783         } else {
784           $template->param(
785             biblionumber => $biblionumber,
786             done         =>1,
787             popup        =>1
788           );
789           $template->param( title => $record->subfield('200',"a") ) if ($record ne "-1" && C4::Context->preference('marcflavour') =~/unimarc/i);
790           $template->param( title => $record->title() ) if ($record ne "-1" && C4::Context->preference('marcflavour') eq "usmarc");
791           $template->param(
792             popup => $mode,
793             itemtype => $frameworkcode,
794           );
795           output_html_with_http_headers $input, $cookie, $template->output;
796           exit;     
797         }
798     } else {
799     # it may be a duplicate, warn the user and do nothing
800         build_tabs ($template, $record, $dbh,$encoding,$input);
801         $template->param(
802             biblionumber             => $biblionumber,
803             biblioitemnumber         => $biblioitemnumber,
804             duplicatebiblionumber    => $duplicatebiblionumber,
805             duplicatebibid           => $duplicatebiblionumber,
806             duplicatetitle           => $duplicatetitle,
807         );
808     }
809 }
810 elsif ( $op eq "delete" ) {
811     
812     my $error = &DelBiblio($biblionumber);
813     if ($error) {
814         warn "ERROR when DELETING BIBLIO $biblionumber : $error";
815         print "Content-Type: text/html\n\n<html><body><h1>ERROR when DELETING BIBLIO $biblionumber : $error</h1></body></html>";
816         exit;
817     }
818     
819     print $input->redirect('/cgi-bin/koha/catalogue/search.pl');
820     exit;
821     
822 } else {
823    #----------------------------------------------------------------------------
824    # If we're in a duplication case, we have to set to "" the biblionumber
825    # as we'll save the biblio as a new one.
826     if ( $op eq "duplicate" ) {
827         $biblionumber = "";
828     }
829
830 #FIXME: it's kind of silly to go from MARC::Record to MARC::File::XML and then back again just to fix the encoding
831     eval {
832         my $uxml = $record->as_xml;
833         MARC::Record::default_record_format("UNIMARC")
834           if ( C4::Context->preference("marcflavour") eq "UNIMARC" );
835         my $urecord = MARC::Record::new_from_xml( $uxml, 'UTF-8' );
836         $record = $urecord;
837     };
838     build_tabs( $template, $record, $dbh, $encoding,$input );
839     $template->param(
840         biblionumber             => $biblionumber,
841         biblionumbertagfield        => $biblionumbertagfield,
842         biblionumbertagsubfield     => $biblionumbertagsubfield,
843         biblioitemnumtagfield    => $biblioitemnumtagfield,
844         biblioitemnumtagsubfield => $biblioitemnumtagsubfield,
845         biblioitemnumber         => $biblioitemnumber,
846     );
847 }
848
849 $template->param( title => $record->title() ) if ( $record ne "-1" );
850 $template->param(
851     popup => $mode,
852     frameworkcode => $frameworkcode,
853     itemtype => $frameworkcode,
854 );
855
856 output_html_with_http_headers $input, $cookie, $template->output;