1 package C4::AuthoritiesMarc;
2 # Copyright 2000-2002 Katipo Communications
4 # This file is part of Koha.
6 # Koha is free software; you can redistribute it and/or modify it under the
7 # terms of the GNU General Public License as published by the Free Software
8 # Foundation; either version 2 of the License, or (at your option) any later
11 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
12 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License along with
16 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
17 # Suite 330, Boston, MA 02111-1307 USA
27 use vars qw($VERSION @ISA @EXPORT);
29 # set the version for version checking
36 &AUTHfind_authtypecode
43 &AUTHfind_marc_from_kohafield
51 &AUTHhtml2marc &AUTHhtml2xml
53 &MARCaddword &MARCdelword
58 sub AUTHfind_marc_from_kohafield {
59 my ( $dbh, $kohafield,$authtypecode ) = @_;
60 return 0, 0 unless $kohafield;
61 $authtypecode="" unless $authtypecode;
62 my $marcfromkohafield;
63 my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where kohafield= ? and authtypecode=? ");
64 $sth->execute($kohafield,$authtypecode);
65 my ($tagfield,$tagsubfield) = $sth->fetchrow;
67 return ($tagfield,$tagsubfield);
70 my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode) = @_;
73 # the marclist may contain "mainentry". In this case, search the tag_to_report, that depends on
74 # the authtypecode. Then, search on $a of this tag_to_report
75 # also store main entry MARC tag, to extract it at end of search
77 ##first set the authtype search
78 $query="\@attr 1=1013 \@attr 5=100 ".$authtypecode; ##No truncation on authtype
82 for(my $i = 0 ; $i <= $#{$value} ; $i++)
86 ##If mainentry search $a tag
87 if (@$tags[$i] eq "mainentry") {
88 $attr =" \@attr 1=21 ";
90 $attr =" \@attr 1=47 ";
96 if (@$operator[$i] eq 'phrase') {
97 $attr.=" \@attr 4=1 \@attr 5=100 \@attr 3=1 ";##Phrase, No truncation, first in field###It seems not implemented by indexdata
101 $attr .=" \@attr 4=6 \@attr 5=1 ";## Word list, right truncated, anywhere
106 $attr =$attr."\"".@$value[$i]."\"";
112 ##Add how many queries generated
113 $query= $and.$query.$q2;
116 $offset=0 unless $offset;
117 my $counter = $offset;
118 $length=10 unless $length;
120 my $oAuth=C4::Context->Zconnauth("authorityserver");
121 if ($oAuth eq "error"){
122 warn "Error/CONNECTING \n";
123 return("error",undef);
127 my $Anewq= new ZOOM::Query::PQF($query);
128 $Anewq->sortby("1=21 i< 1=47 i<");
131 $oAResult= $oAuth->search($Anewq) ;
134 warn " /CODE:", $@->code()," /MSG:",$@->message(),"\n";
135 return("error",undef);
140 $nbresults=$oAResult->size() if ($oAResult);
145 my @finalresult = ();
147 # while (($counter <= $#result) && ($counter <= ($offset + $length))) {
148 # retrieve everything
149 for (my $counter=0;$counter <=$#result;$counter++) {
150 # warn " HERE : $counter, $#result, $offset, $length";
151 # get MARC::Record of the authority
152 my $record = AUTHgetauthority($dbh,$result[$counter]);
153 # then build the summary
154 #FIXME: all of this should be moved to the template eventually
155 my $authtypecode = AUTHfind_authtypecode($dbh,$result[$counter]);
156 my $authref = getauthtype($authtypecode);
157 my $authtype =$authref->{authtypetext};
158 my $summary = $authref->{summary};
159 # find biblio MARC field using this authtypecode (to jump to biblio)
160 my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
161 $sth->execute($authtypecode);
162 my $tags_using_authtype;
164 while (my ($tagfield) = $newsth->fetchrow) {
165 $tags_using_authtype.= "'".$tagfield."9',";
167 chop $tags_using_authtype;
168 # if the library has a summary defined, use it. Otherwise, build a standard one
170 my @fields = $record->fields();
171 foreach my $field (@fields) {
172 my $tag = $field->tag();
173 my $tagvalue = $field->as_string();
174 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
177 my @subf = $field->subfields;
178 for my $i (0..$#subf) {
179 my $subfieldcode = $subf[$i][0];
180 my $subfieldvalue = $subf[$i][1];
181 my $tagsubf = $tag.$subfieldcode;
182 $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
186 $summary =~ s/\[(.*?)]//g;
187 $summary =~ s/\n/<br>/g;
189 my $heading; # = $authref->{summary};
193 my @fields = $record->fields();
194 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
195 # construct UNIMARC summary, that is quite different from MARC21 one
197 foreach my $field ($record->field('2..')) {
198 $heading.= $field->as_string();
201 foreach my $field ($record->field('4..')) {
202 $summary.= " <i>".$field->as_string()."</i><br/>";
203 $summary.= " <i>see:</i> ".$heading."<br/>";
206 foreach my $field ($record->field('5..')) {
207 $summary.= " <i>".$field->as_string()."</i><br/>";
208 $summary.= " <i>see:</i> ".$heading."<br/>";
211 foreach my $field ($record->field('7..')) {
212 $seeheading.= " <i>see also:</i> ".$field->as_string()."<br />";
213 $altheading.= " ".$field->as_string()."<br />";
214 $altheading.= " <i>see also:</i> ".$heading."<br />";
216 $summary = "<b>".$heading."</b><br />".$seeheading.$altheading.$summary;
218 # construct MARC21 summary
219 foreach my $field ($record->field('1..')) {
220 if ($record->field('100')) {
221 $heading.= $field->as_string('abcdefghjklmnopqrstvxyz68');
222 } elsif ($record->field('110')) {
223 $heading.= $field->as_string('abcdefghklmnoprstvxyz68');
224 } elsif ($record->field('111')) {
225 $heading.= $field->as_string('acdefghklnpqstvxyz68');
226 } elsif ($record->field('130')) {
227 $heading.= $field->as_string('adfghklmnoprstvxyz68');
228 } elsif ($record->field('148')) {
229 $heading.= $field->as_string('abvxyz68');
230 } elsif ($record->field('150')) {
231 $heading.= $field->as_string('abvxyz68');
232 } elsif ($record->field('151')) {
233 $heading.= $field->as_string('avxyz68');
234 } elsif ($record->field('155')) {
235 $heading.= $field->as_string('abvxyz68');
236 } elsif ($record->field('180')) {
237 $heading.= $field->as_string('vxyz68');
238 } elsif ($record->field('181')) {
239 $heading.= $field->as_string('vxyz68');
240 } elsif ($record->field('182')) {
241 $heading.= $field->as_string('vxyz68');
242 } elsif ($record->field('185')) {
243 $heading.= $field->as_string('vxyz68');
245 $heading.= $field->as_string();
248 foreach my $field ($record->field('4..')) {
249 $seeheading.= " ".$field->as_string()."<br />";
250 $seeheading.= " <i>see:</i> ".$seeheading."<br />";
252 foreach my $field ($record->field('5..')) {
253 $altheading.= " <i>see also:</i> ".$field->as_string()."<br />";
254 $altheading.= " ".$field->as_string()."<br />";
255 $altheading.= " <i>see also:</i> ".$altheading."<br />";
257 $summary.=$heading.$seeheading.$altheading;
260 # then add a line for the template loop
262 $newline{summary} = $summary;
263 $newline{authtype} = $authtype;
264 $newline{authid} = $result[$counter];
265 $newline{used} = &AUTHcount_usage($result[$counter]);
266 $newline{biblio_fields} = $tags_using_authtype;
267 $newline{even} = $counter % 2;
268 $newline{mainentry} = $record->field($mainentrytag)->subfield('a')." ".$record->field($mainentrytag)->subfield('b') if $record->field($mainentrytag);
269 push @finalresult, \%newline;
272 my @finalresult3= sort {$a->{summary} cmp $b->{summary}} @finalresult;
273 # cut from $offset to $offset+$length;
275 for (my $i=$offset;$i<=$offset+$length;$i++) {
276 push @finalresult2,$finalresult3[$i] if $finalresult3[$i];
278 my $nbresults = $#result + 1;
280 return (\@finalresult2, $nbresults);
283 # Creates the SQL Request
286 my ($dbh,$tags, $and_or, $operator, $value) = @_;
288 my $sql_tables; # will contain marc_subfield_table as m1,...
289 my $sql_where1; # will contain the "true" where
290 my $sql_where2 = "("; # will contain m1.authid=m2.authid
291 my $nb_active=0; # will contain the number of "active" entries. and entry is active is a value is provided.
292 my $nb_table=1; # will contain the number of table. ++ on each entry EXCEPT when an OR is provided.
295 for(my $i=0; $i<=@$value;$i++) {
300 $sql_tables = "auth_subfield_table as m$nb_table,";
301 $sql_where1 .= "( m$nb_table.subfieldvalue like '@$value[$i]' ";
303 $sql_where1 .=" and concat(m1.tag,m1.subfieldcode) in (@$tags[$i])";
306 } elsif (@$operator[$i] eq "contains") {
307 $sql_tables .= "auth_word as m$nb_table,";
308 $sql_where1 .= "(m1.word like ".$dbh->quote("@$value[$i]%");
310 $sql_where1 .=" and m1.tagsubfield in (@$tags[$i])";
315 $sql_tables .= "auth_subfield_table as m$nb_table,";
316 $sql_where1 .= "(m1.subfieldvalue @$operator[$i] ".$dbh->quote("@$value[$i]");
318 $sql_where1 .=" and concat(m1.tag,m1.subfieldcode) in (@$tags[$i])";
323 if (@$operator[$i] eq "start") {
325 $sql_tables .= "auth_subfield_table as m$nb_table,";
326 $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue like ".$dbh->quote("@$value[$i]%");
328 $sql_where1 .=" and concat(m$nb_table.tag,m$nb_table.subfieldcode) in (@$tags[$i])";
331 $sql_where2 .= "m1.authid=m$nb_table.authid and ";
332 } elsif (@$operator[$i] eq "contains") {
333 if (@$and_or[$i] eq 'and') {
335 $sql_tables .= "auth_word as m$nb_table,";
336 $sql_where1 .= "@$and_or[$i] (m$nb_table.word like ".$dbh->quote("@$value[$i]%");
338 $sql_where1 .=" and m$nb_table.tagsubfield in(@$tags[$i])";
341 $sql_where2 .= "m1.authid=m$nb_table.authid and ";
343 $sql_where1 .= "@$and_or[$i] (m$nb_table.word like ".$dbh->quote("@$value[$i]%");
345 $sql_where1 .=" and concat(m$nb_table.tag,m$nb_table.subfieldid) in (@$tags[$i])";
348 $sql_where2 .= "m1.authid=m$nb_table.authid and ";
353 $sql_tables .= "auth_subfield_table as m$nb_table,";
354 $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue like '@$value[$i]' ";
356 $sql_where1 .=" and concat(m$nb_table.tag,m$nb_table.subfieldcode) in (@$tags[$i])";
358 $sql_where2 .= "m1.authid=m$nb_table.authid and ";
360 $sql_where2.="m1.authid=m$nb_table.authid and ";
367 if($sql_where2 ne "(") # some datas added to sql_where2, processing
369 $sql_where2 = substr($sql_where2, 0, (length($sql_where2)-5)); # deletes the trailing ' and '
372 else # no sql_where2 statement, deleting '('
376 chop $sql_tables; # deletes the trailing ','
378 return ($sql_tables, $sql_where1, $sql_where2);
382 sub AUTHcount_usage {
384 my $dbh = C4::Context->dbh;
385 # find MARC fields using this authtype
386 my $authtypecode = AUTHfind_authtypecode($dbh,$authid);
387 my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
388 my $tags_used=$sth->execute($authtypecode);
389 my $tags_using_authtype;
391 while (my($tagfield) = $sth->fetchrow){
392 # warn "TAG : $tagfield";
393 $tags_using_authtype.= "'".$tagfield."9',";
397 chop $tags_using_authtype;
398 ### try ZOOM search here
399 my $oConnection=C4::Context->Zconn("biblioserver");
402 $query= "\@attr GILS 1=2057 ".$authid;
404 my $oResult = $oConnection->search_pqf($query);
406 my $result=$oResult->size() if ($oResult);
409 # if ($tags_using_authtype) {
410 # $sth = $dbh->prepare("select count(*) from marc_subfield_table where concat(tag,subfieldcode) in ($tags_using_authtype) and MATCH(subfieldvalue) AGAINST(? IN BOOLEAN MODE)");
412 # $sth = $dbh->prepare("select count(*) from marc_subfield_table where subfieldvalue=?");
414 # warn "Q : select count(*) from marc_subfield_table where concat(tag,subfieldcode) in ($tags_using_authtype) and d MATCH(subfieldvalue) AGAINST($authid IN BOOLEAN MODE) ";
415 # $sth->execute($authid);
416 # my ($result) = $sth->fetchrow;
417 # warn "Authority $authid TOTAL USED : $result";
424 sub AUTHfind_authtypecode {
425 my ($dbh,$authid) = @_;
426 my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?");
427 $sth->execute($authid);
428 my ($authtypecode) = $sth->fetchrow;
429 return $authtypecode;
434 my ($dbh,$forlibrarian,$authtypecode)= @_;
435 $authtypecode="" unless $authtypecode;
437 my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
440 # check that authority exists
441 $sth=$dbh->prepare("select count(*) from auth_tag_structure where authtypecode=?");
442 $sth->execute($authtypecode);
443 my ($total) = $sth->fetchrow;
444 $authtypecode="" unless ($total >0);
446 "select tagfield,liblibrarian,libopac,mandatory,repeatable from auth_tag_structure where authtypecode=? order by tagfield"
449 $sth->execute($authtypecode);
450 my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
452 while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
453 $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
454 $res->{$tab}->{tab} = ""; # XXX
455 $res->{$tag}->{mandatory} = $mandatory;
456 $res->{$tag}->{repeatable} = $repeatable;
458 $sth= $dbh->prepare("select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link from auth_subfield_structure where authtypecode=? order by tagfield,tagsubfield"
460 $sth->execute($authtypecode);
463 my $authorised_value;
473 ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
474 $mandatory, $repeatable, $authorised_value, $authtypecode,
475 $value_builder, $kohafield, $seealso, $hidden,
480 $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
481 $res->{$tag}->{$subfield}->{tab} = $tab;
482 $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
483 $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
484 $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
485 $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
486 $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
487 $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
488 $res->{$tag}->{$subfield}->{seealso} = $seealso;
489 $res->{$tag}->{$subfield}->{hidden} = $hidden;
490 $res->{$tag}->{$subfield}->{isurl} = $isurl;
491 $res->{$tag}->{$subfield}->{link} = $link;
496 sub AUTHaddauthority {
497 # pass the MARC::Record to this function, and it will create the records in the authority table
498 my ($dbh,$record,$authid,$authtypecode) = @_;
499 my @fields=$record->fields();
500 # adding main table, and retrieving authid
501 # if authid is sent, then it's not a true add, it's only a re-add, after a delete (ie, a mod)
502 # In fact, it could still be a true add, in the case of a bulkauthimort for instance with previously
503 # existing authids in the records. I've adjusted below to account for this instance --JF.
505 $dbh->do("lock tables auth_header WRITE,auth_subfield_table WRITE, auth_word WRITE, stopwords READ");
506 my $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode) values (?,now(),?)");
507 $sth->execute($authid,$authtypecode);
509 # if authid empty => true add, find a new authid number
511 $dbh->do("lock tables auth_header WRITE,auth_subfield_table WRITE, auth_word WRITE, stopwords READ");
512 my $sth=$dbh->prepare("insert into auth_header (datecreated,authtypecode) values (now(),?)");
513 $sth->execute($authtypecode);
514 $sth=$dbh->prepare("select max(authid) from auth_header");
516 ($authid)=$sth->fetchrow;
523 my ($dbh,$linkid,$authid)=@_;
524 my $record=AUTHgetauthority($dbh,$linkid);
525 my $authtypecode=AUTHfind_authtypecode($dbh,$linkid);
526 #warn "adding l:$linkid,a:$authid,auth:$authtypecode";
527 $record=AUTH2marcOnefieldlink($dbh,$record,"auth_header.linkid",$authid,$authtypecode);
528 $dbh->do("lock tables auth_header WRITE");
529 my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
530 $sth->execute($record->as_usmarc,$linkid);
532 $dbh->do("unlock tables");
533 zebraopauth($dbh,$linkid,'specialUpdate');
536 sub AUTH2marcOnefieldlink {
537 my ( $dbh, $record, $kohafieldname, $newvalue,$authtypecode ) = @_;
538 my $sth = $dbh->prepare(
539 "select tagfield,tagsubfield from auth_subfield_structure where authtypecode=? and kohafield=?"
541 $sth->execute($authtypecode,$kohafieldname);
542 my ($tagfield,$tagsubfield)=$sth->fetchrow;
543 $record->add_fields( $tagfield, " ", " ", $tagsubfield => $newvalue );
548 my ($dbh,$authid,$op)=@_;
553 $Zconnauthority=C4::Context->Zconnauth("authorityserver");
554 if ($Zconnauthority ne "error"){
555 my $record = AUTHgetauthority($dbh,$authid);
556 my $Zpackage = $Zconnauthority->package();
557 $Zpackage->option(action => $op);
558 $Zpackage->option(record => $record->as_xml_record);
561 $Zpackage->send("update");
564 if($@->code()==10007 && $tried==0){ ##Timedout -retry
567 }elsif($@->code()==10004 && $recon==0){##Lost connection -reconnect
571 warn "Error-authority updating $authid $op /CODE:", $@->code()," /MSG:",$@->message(),"\n";
572 zebrafiles($dbh,$authid,$op);
576 $Zpackage->("commit") if (C4::Context->authorityservershadow);
579 zebrafiles($dbh,$authid,$op);
585 my ($dbh,$authid,$folder)=@_;
586 my $record=AUTHgetauthority($dbh,$authid);
587 my $zebradir = C4::Context->zebraconfig("authorityserver")->{directory}."/".$folder."/";
589 #my $zebradir = C4::Context->authoritydir."/".$folder."/";
590 unless (opendir(DIR, "$zebradir")) {
591 warn "$zebradir not found";
595 my $filename = $zebradir.$authid;
597 open (OUTPUT,">", $filename.".xml");
598 print OUTPUT $record->as_xml_record;
608 ##Hard coded for NEU auth types
609 my($dbh,$authtypecode)=@_;
612 if ($authtypecode eq "AUTH"){
614 }elsif ($authtypecode eq "ESUB"){
616 }elsif ($authtypecode eq "TSUB"){
624 sub AUTHgetauthority {
625 # Returns MARC::Record of the biblio passed in parameter.
626 my ($dbh,$authid)=@_;
627 my $sth=$dbh->prepare("select marc from auth_header where authid=?");
628 $sth->execute($authid);
629 my ($marc) = $sth->fetchrow;
630 my $record=MARC::File::USMARC::decode($marc);
635 sub AUTHgetauth_type {
636 my ($authtypecode) = @_;
637 my $dbh=C4::Context->dbh;
638 my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
639 $sth->execute($authtypecode);
640 return $sth->fetchrow_hashref;
642 sub AUTHmodauthority {
644 my ($dbh,$authid,$record,$authtypecode,$merge)=@_;
645 my ($oldrecord)=&AUTHgetauthority($dbh,$authid);
646 if ($oldrecord eq $record) {
649 my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
650 #warn find if linked records exist and delete them
651 my($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode);
653 if ($oldrecord->field($linkidfield)){
654 my @fields=$oldrecord->field($linkidfield);
655 foreach my $field (@fields){
656 my $linkid=$field->subfield($linkidsubfield) ;
658 ##Modify the record of linked
659 my $linkrecord=AUTHgetauthority($dbh,$linkid);
660 my $linktypecode=AUTHfind_authtypecode($dbh,$linkid);
661 my ( $linkidfield2,$linkidsubfield2)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$linktypecode);
662 my @linkfields=$linkrecord->field($linkidfield2);
663 foreach my $linkfield (@linkfields){
664 if ($linkfield->subfield($linkidsubfield2) eq $authid){
665 $linkrecord->delete_field($linkfield);
666 $sth->execute($linkrecord->as_usmarc,$linkid);
667 zebraopauth($dbh,$linkid,'specialUpdate');
673 #Now rewrite the $record to table with an add
674 $authid=AUTHaddauthority($dbh,$record,$authid,$authtypecode);
677 ### If a library thinks that updating all biblios is a long process and wishes to leave that to a cron job to use merge_authotities.p
678 ### they should have a system preference "dontmerge=1" otherwise by default biblios will be updated
679 ### the $merge flag is now depreceated and will be removed at code cleaning
681 if (C4::Context->preference('dontmerge')){
682 # save the file in localfile/modified_authorities
683 my $cgidir = C4::Context->intranetdir ."/cgi-bin";
684 unless (opendir(DIR, "$cgidir")) {
685 $cgidir = C4::Context->intranetdir."/";
688 my $filename = $cgidir."/localfile/modified_authorities/$authid.authid";
689 open AUTH, "> $filename";
693 &merge($dbh,$authid,$record,$authid,$record);
698 sub AUTHdelauthority {
699 my ($dbh,$authid,$keep_biblio) = @_;
700 # if the keep_biblio is set to 1, then authority entries in biblio are preserved.
702 zebraopauth($dbh,$authid,"recordDelete");
703 $dbh->do("delete from auth_header where authid=$authid") ;
705 # FIXME : delete or not in biblio tables (depending on $keep_biblio flag)
710 sub AUTHfind_authtypecode {
711 my ($dbh,$authid) = @_;
712 my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?");
713 $sth->execute($authid);
714 my ($authtypecode) = $sth->fetchrow;
715 return $authtypecode;
721 my ($tags,$subfields,$values,$indicator,$ind_tag) = @_;
723 my $xml= MARC::File::XML::header();
728 for (my $i=0;$i<=@$tags;$i++){
730 if ((@$tags[$i] ne $prevtag)){
731 $j++ unless (@$tags[$i] eq "");
732 warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i];
735 $xml.="</datafield>\n";
739 if (@$values[$i] ne "") {
741 if (@$tags[$i] eq "000") {
742 $xml.="<leader>@$values[$i]</leader>\n";
744 # rest of the fixed fields
745 } elsif (@$tags[$i] < 10) {
746 $xml.="<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
750 my $ind1 = substr(@$indicator[$j],0,1);
751 my $ind2 = substr(@$indicator[$j],1,1);
752 $xml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
753 $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
759 if (@$values[$i] eq "") {
763 my $ind1 = substr(@$indicator[$j],0,1);
764 my $ind2 = substr(@$indicator[$j],1,1);
765 $xml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
768 $xml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
772 $prevtag = @$tags[$i];
774 $xml.= MARC::File::XML::footer();
779 my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
781 my $record = MARC::Record->new();
782 #---- TODO : the leader is missing
784 # my %subfieldlist=();
785 my $prevvalue; # if tag <10
786 my $field; # if tag >=10
787 for (my $i=0; $i< @$rtags; $i++) {
788 # rebuild MARC::Record
789 if (@$rtags[$i] ne $prevtag) {
792 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
796 $record->add_fields($field);
799 $indicators{@$rtags[$i]}.=' ';
800 if (@$rtags[$i] <10) {
801 $prevvalue= @$rvalues[$i];
805 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
807 $prevtag = @$rtags[$i];
809 if (@$rtags[$i] <10) {
810 $prevvalue=@$rvalues[$i];
812 if (length(@$rvalues[$i])>0) {
813 $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
816 $prevtag= @$rtags[$i];
819 # the last has not been included inside the loop... do it now !
820 $record->add_fields($field) if $field;
829 my ($record,$authtypecode)=@_;
830 # warn "IN for ".$record->as_formatted;
831 my $dbh = C4::Context->dbh;
832 # warn "".$record->as_formatted;
833 my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
834 $sth->execute($authtypecode);
835 my ($auth_tag_to_report) = $sth->fetchrow;
837 # build a request for authoritysearch
838 my (@tags, @and_or, @excluding, @operator, @value, $offset, $length);
839 if ($record->field($auth_tag_to_report)) {
840 push @tags, $auth_tag_to_report;
843 push @operator, "all";
844 push @value, $record->field($auth_tag_to_report)->as_string();
847 my ($finalresult,$nbresult) = authoritysearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10,$authtypecode);
848 # there is at least 1 result => return the 1st one
850 return @$finalresult[0]->{authid},@$finalresult[0]->{summary};
852 # no result, returns nothing
857 ## give this a Marc record to return summary
858 my ($dbh,$record,$authid,$authtypecode)=@_;
860 # my $authtypecode = AUTHfind_authtypecode($dbh,$authid);
861 my $authref = getauthtype($authtypecode);
862 my $summary = $authref->{summary};
863 my @fields = $record->fields();
864 # chop $tags_using_authtype;
865 # if the library has a summary defined, use it. Otherwise, build a standard one
867 my @fields = $record->fields();
868 foreach my $field (@fields) {
869 my $tag = $field->tag();
870 my $tagvalue = $field->as_string();
871 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
874 my @subf = $field->subfields;
875 for my $i (0..$#subf) {
876 my $subfieldcode = $subf[$i][0];
877 my $subfieldvalue = $subf[$i][1];
878 my $tagsubf = $tag.$subfieldcode;
879 $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
883 $summary =~ s/\[(.*?)]//g;
884 $summary =~ s/\n/<br>/g;
886 my $heading; # = $authref->{summary};
890 my @fields = $record->fields();
891 if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
892 # construct UNIMARC summary, that is quite different from MARC21 one
894 foreach my $field ($record->field('2..')) {
895 $heading.= $field->as_string();
898 foreach my $field ($record->field('4..')) {
899 $summary.= " <i>".$field->as_string()."</i><br/>";
900 $summary.= " <i>see:</i> ".$heading."<br/>";
903 foreach my $field ($record->field('5..')) {
904 $summary.= " <i>".$field->as_string()."</i><br/>";
905 $summary.= " <i>see:</i> ".$heading."<br/>";
908 foreach my $field ($record->field('7..')) {
909 $seeheading.= " <i>see also:</i> ".$field->as_string()."<br />";
910 $altheading.= " ".$field->as_string()."<br />";
911 $altheading.= " <i>see also:</i> ".$heading."<br />";
913 $summary = "<b>".$heading."</b><br />".$seeheading.$altheading.$summary;
915 # construct MARC21 summary
916 foreach my $field ($record->field('1..')) {
917 if ($record->field('100')) {
918 $heading.= $field->as_string('abcdefghjklmnopqrstvxyz68');
919 } elsif ($record->field('110')) {
920 $heading.= $field->as_string('abcdefghklmnoprstvxyz68');
921 } elsif ($record->field('111')) {
922 $heading.= $field->as_string('acdefghklnpqstvxyz68');
923 } elsif ($record->field('130')) {
924 $heading.= $field->as_string('adfghklmnoprstvxyz68');
925 } elsif ($record->field('148')) {
926 $heading.= $field->as_string('abvxyz68');
927 } elsif ($record->field('150')) {
928 $heading.= $field->as_string('abvxyz68');
929 } elsif ($record->field('151')) {
930 $heading.= $field->as_string('avxyz68');
931 } elsif ($record->field('155')) {
932 $heading.= $field->as_string('abvxyz68');
933 } elsif ($record->field('180')) {
934 $heading.= $field->as_string('vxyz68');
935 } elsif ($record->field('181')) {
936 $heading.= $field->as_string('vxyz68');
937 } elsif ($record->field('182')) {
938 $heading.= $field->as_string('vxyz68');
939 } elsif ($record->field('185')) {
940 $heading.= $field->as_string('vxyz68');
942 $heading.= $field->as_string();
945 foreach my $field ($record->field('4..')) {
946 $seeheading.= " ".$field->as_string()."<br />";
947 $seeheading.= " <i>see:</i> ".$seeheading."<br />";
949 foreach my $field ($record->field('5..')) {
950 $altheading.= " <i>see also:</i> ".$field->as_string()."<br />";
951 $altheading.= " ".$field->as_string()."<br />";
952 $altheading.= " <i>see also:</i> ".$altheading."<br />";
954 $summary.=$heading.$seeheading.$altheading;
960 my ($dbh,$mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
961 my $authtypecodefrom = AUTHfind_authtypecode($dbh,$mergefrom);
962 my $authtypecodeto = AUTHfind_authtypecode($dbh,$mergeto);
963 # return if authority does not exist
964 my @X = $MARCfrom->fields();
966 my @X = $MARCto->fields();
970 # search the tag to report
971 my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
972 $sth->execute($authtypecodefrom);
973 my ($auth_tag_to_report) = $sth->fetchrow;
976 @record_to = $MARCto->field($auth_tag_to_report)->subfields() if $MARCto->field($auth_tag_to_report);
978 @record_from = $MARCfrom->field($auth_tag_to_report)->subfields() if $MARCfrom->field($auth_tag_to_report);
980 # search all biblio tags using this authority.
981 $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
982 $sth->execute($authtypecodefrom);
983 my @tags_using_authtype;
984 while (my ($tagfield) = $sth->fetchrow) {
985 push @tags_using_authtype,$tagfield."9" ;
988 # now, find every biblio using this authority
989 ### try ZOOM search here
990 my $oConnection=C4::Context->Zconn("biblioserver");
995 $query= "\@attr GILS 1=2057 ".$mergefrom;
997 my $oResult = $oConnection->search_pqf($query);
999 my $count=$oResult->size() if ($oResult);
1002 while ( $z<$count ) {
1006 $rec=$oResult->record($z);
1009 my $marcdata = $rec->raw();
1010 push @reccache, $marcdata;
1013 $oResult->destroy();
1014 foreach my $marc(@reccache){
1018 $marcrecord = MARC::File::USMARC::decode($marc);
1019 foreach my $tagfield (@tags_using_authtype){
1020 $tagfield=substr($tagfield,0,3);
1021 my @tags = $marcrecord->field($tagfield);
1022 foreach my $tag (@tags){
1023 my $tagsubs=$tag->subfield("9");
1024 #warn "$tagfield:$tagsubs:$mergefrom";
1025 if ($tagsubs== $mergefrom) {
1027 $tag->update("9" =>$mergeto);
1028 foreach my $subfield (@record_to) {
1029 # warn "$subfield,$subfield->[0],$subfield->[1]";
1030 $tag->update($subfield->[0] =>$subfield->[1]);
1033 $marcrecord->delete_field($tag);
1034 $marcrecord->add_fields($tag);
1038 my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,"") ;
1040 &NEWmodbiblio($dbh,$marcrecord,$oldbiblio->{'biblionumber'},undef,"0000") ;
1045 END { } # module clean-up code here (global destructor)
1051 Koha Developement team <info@koha.org>
1053 Paul POULAIN paul.poulain@free.fr
1059 # Revision 1.27 2006/07/04 14:36:51 toins
1060 # Head & rel_2_2 merged
1062 # Revision 1.26 2006/05/20 14:32:54 tgarip1957
1063 # If an authority is modified biblios related to this authority were not updated but a list of modified authorities was written to disk. Now by defult they get modified as well unless a system preference 'dontmerge' is defined. dontmerge=1 will keep the previous behaviour.
1065 # Authority zebra server may have different shadow settings. Support is added
1067 # Revision 1.25 2006/05/19 18:09:39 tgarip1957
1068 # All support for auth_subfield_tables is removed. All search is now with zebra authorities. New authority structure allows multiple linking of authorities of differnet types to one another.
1069 # Authority tables are modified to be compatible with new MARC frameworks. This change is part of Authority Linking & Zebra authorities. Requires change in Mysql database. It will break head unless all changes regarding this is implemented. This warning will take place on all commits regarding this
1071 # Revision 1.9.2.6 2005/06/07 10:02:00 tipaul
1072 # porting dictionnary search from head to 2.2. there is now a ... facing titles, author & subject, to search in biblio & authorities existing values.
1074 # Revision 1.9.2.5 2005/05/31 14:50:46 tipaul
1075 # fix for authority merging. There was a bug on official installs
1077 # Revision 1.9.2.4 2005/05/30 11:24:15 tipaul
1078 # fixing a bug : when a field was repeated, the last field was also repeated. (Was due to the "empty" field in html between fields : to separate fields, in html, an empty field is automatically added. in AUTHhtml2marc, this empty field was not discarded correctly)
1080 # Revision 1.9.2.3 2005/04/28 08:45:33 tipaul
1081 # porting FindDuplicate feature for authorities from HEAD to rel_2_2, works correctly now.
1083 # Revision 1.9.2.2 2005/02/28 14:03:13 tipaul
1084 # * adding search on "main entry" (ie $a subfield) on a given authority (the "search everywhere" field is still here).
1085 # * adding a select box to requet "contain" or "begin with" search.
1086 # * fixing some bug in authority search (related to "main entry" search)
1088 # Revision 1.9.2.1 2005/02/24 13:12:13 tipaul
1089 # saving authority modif in a text file. This will be used soon with another script (in crontab). The script in crontab will retrieve every authorityid in the directory localfile/authorities and modify every biblio using this authority. Those modifs may be long. So they can't be done through http, because we may encounter a webserver timeout, and kill the process before end of the job.
1090 # So, it will be done through a cron job.
1091 # (/me agree we need some doc for command line scripts)
1093 # Revision 1.9 2004/12/23 09:48:11 tipaul
1094 # Minor changes in summary "exploding" (the 3 digits AFTER the subfield were not on the right place).
1096 # Revision 1.8 2004/11/05 10:11:39 tipaul
1097 # export auth_count_usage (bugfix)
1099 # Revision 1.7 2004/09/23 16:13:00 tipaul
1100 # Bugfix in modification
1102 # Revision 1.6 2004/08/18 16:00:24 tipaul
1103 # fixes for authorities management
1105 # Revision 1.5 2004/07/05 13:37:22 doxulting
1106 # First step for working authorities
1108 # Revision 1.4 2004/06/22 11:35:37 tipaul
1109 # removing % at the beginning of a string to avoid loooonnnngggg searchs
1111 # Revision 1.3 2004/06/17 08:02:13 tipaul
1112 # merging tag & subfield in auth_word for better perfs
1114 # Revision 1.2 2004/06/10 08:29:01 tipaul
1115 # MARC authority management (continued)
1117 # Revision 1.1 2004/06/07 07:35:01 tipaul
1118 # MARC authority management package