C4/AuthoritiesMarc.pm

   1 package C4::AuthoritiesMarc;
   2 # Copyright 2000-2002 Katipo Communications
   3 #
   4 # This file is part of Koha.
   5 #
   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
   9 # version.
  10 #
  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.
  14 #
  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
  18
  19 use strict;
  20 require Exporter;
  21 use C4::Context;
  22 use C4::Koha;
  23 use MARC::Record;
  24 use C4::Biblio;
  25 use C4::Search;
  26 #use ZOOM;
  27 use vars qw($VERSION @ISA @EXPORT);
  28
  29 # set the version for version checking
  30 $VERSION = 0.01;
  31
  32 @ISA = qw(Exporter);
  33 @EXPORT = qw(
  34     &AUTHgettagslib
  35     &AUTHfindsubfield
  36     &AUTHfind_authtypecode
  37
  38     &AUTHaddauthority
  39     &AUTHmodauthority
  40     &AUTHdelauthority
  41     &AUTHaddsubfield
  42     &AUTHgetauthority
  43     &AUTHfind_marc_from_kohafield
  44     &AUTHgetauth_type
  45     &AUTHcount_usage
  46     &getsummary
  47     &authoritysearch
  48     &XMLgetauthority
  49
  50     &AUTHhtml2marc
  51     &BuildUnimarcHierarchies
  52     &BuildUnimarcHierarchy
  53     &merge
  54     &FindDuplicate
  55  );
  56
  57 sub AUTHfind_marc_from_kohafield {
  58   my ( $kohafield,$authtypecode ) = @_;
  59   my $dbh=C4::Context->dbh;
  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;
  66
  67   return  ($tagfield,$tagsubfield);
  68 }
  69
  70 sub authoritysearch {
  71   my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby) = @_;
  72   my $dbh=C4::Context->dbh;
  73   my $query;
  74   my $attr;
  75     # the marclist may contain "mainentry". In this case, search the tag_to_report, that depends on
  76     # the authtypecode. Then, search on $a of this tag_to_report
  77     # also store main entry MARC tag, to extract it at end of search
  78   my $mainentrytag;
  79   ##first set the authtype search and may be multiple authorities
  80   my $n=0;
  81   my @authtypecode;
  82   my @auths=split / /,$authtypecode ;
  83   foreach my  $auth (@auths){
  84     $query .=" \@attr 1=Authority/format-id \@attr 5=100 ".$auth; ##No truncation on authtype
  85     push @authtypecode ,$auth;
  86     $n++;
  87   }
  88   if ($n>1){
  89     $query= "\@or ".$query;
  90   }
  91
  92   my $dosearch;
  93   my $and;
  94   my $q2;
  95   for(my $i = 0 ; $i <= $#{$value} ; $i++)
  96   {
  97     if (@$value[$i]){
  98     ##If mainentry search $a tag
  99         if (@$tags[$i] eq "mainmainentry") {
 100           $attr =" \@attr 1=Heading ";
 101         }elsif (@$tags[$i] eq "mainentry") {
 102           $attr =" \@attr 1=Heading-Entity ";
 103         }else{
 104           $attr =" \@attr 1=Any ";
 105         }
 106         if (@$operator[$i] eq 'is') {
 107             $attr.=" \@attr 4=1  \@attr 5=100 ";##Phrase, No truncation,all of subfield field must match
 108         }elsif (@$operator[$i] eq "="){
 109             $attr.=" \@attr 4=107 ";           #Number Exact match
 110         }elsif (@$operator[$i] eq "start"){
 111             $attr.=" \@attr 4=1 \@attr 5=1 ";#Phrase, Right truncated
 112         } else {
 113             $attr .=" \@attr 5=1  ";## Word list, right truncated, anywhere
 114         }
 115         $and .=" \@and " ;
 116         $attr =$attr."\"".@$value[$i]."\"";
 117         $q2 .=$attr;
 118     $dosearch=1;
 119     }#if value
 120   }
 121   ##Add how many queries generated
 122   $query= $and.$query.$q2;
 123   $query=' @or  @attr 7=1 @attr 1=Heading 0 '.$query if ($sortby eq "HeadingAsc");
 124   $query=' @or  @attr 7=2 @attr 1=Heading 0 '.$query if ($sortby eq "HeadingDsc");
 125   warn $query;
 126
 127   $offset=0 unless $offset;
 128   my $counter = $offset;
 129   $length=10 unless $length;
 130   my @oAuth;
 131   my $i;
 132   $oAuth[0]=C4::Context->Zconn("authorityserver" , 1);
 133   my $Anewq= new ZOOM::Query::PQF($query,$oAuth[0]);
 134   # $Anewq->sortby("1=Heading i< 1=Heading-Entity i< ");
 135   # $Anewq->sortby("1=Heading i< 1=Heading-Entity i< ");
 136   my $oAResult;
 137   $oAResult= $oAuth[0]->search($Anewq) ;
 138   while (($i = ZOOM::event(\@oAuth)) != 0) {
 139       my $ev = $oAuth[$i-1]->last_event();
 140   #    warn("Authority ", $i-1, ": event $ev (", ZOOM::event_str($ev), ")\n");
 141       last if $ev == ZOOM::Event::ZEND;
 142   }
 143   my($error, $errmsg, $addinfo, $diagset) = $oAuth[0]->error_x();
 144   if ($error) {
 145     warn  "oAuth error: $errmsg ($error) $addinfo $diagset\n";
 146     goto NOLUCK;
 147   }
 148
 149   my $nbresults;
 150   $nbresults=$oAResult->size();
 151   my $nremains=$nbresults;
 152   my @result = ();
 153   my @finalresult = ();
 154
 155   if ($nbresults>0){
 156
 157   ##Find authid and linkid fields
 158   ##we may be searching multiple authoritytypes.
 159   ## FIXME this assumes that all authid and linkid fields are the same for all authority types
 160   # my ($authidfield,$authidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode[0]);
 161   # my ($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode[0]);
 162     while (($counter < $nbresults) && ($counter < ($offset + $length))) {
 163
 164       ##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES
 165       my $rec=$oAResult->record($counter);
 166       my $marcdata=$rec->raw();
 167       my $authrecord;
 168       my $linkid;
 169       my @linkids;
 170       my $separator=C4::Context->preference('authoritysep');
 171       my $linksummary=" ".$separator;
 172
 173           $authrecord = MARC::File::USMARC::decode($marcdata);
 174
 175       my $authid=$authrecord->field('001')->data();
 176       #     if ($authrecord->field($linkidfield)){
 177       # my @fields=$authrecord->field($linkidfield);
 178       #
 179       # #     foreach my $field (@fields){
 180       # # #     $linkid=$field->subfield($linkidsubfield) ;
 181       # # #         if ($linkid){ ##There is a linked record add fields to produce summary
 182       # # # my $linktype=AUTHfind_authtypecode($dbh,$linkid);
 183       # # #         my $linkrecord=AUTHgetauthority($dbh,$linkid);
 184       # # #         $linksummary.="<br>&nbsp;&nbsp;&nbsp;&nbsp;<a href='detail.pl?authid=$linkid'>".getsummary($dbh,$linkrecord,$linkid,$linktype).".</a>".$separator;
 185       # # #         }
 186       # #      }
 187       #     }#
 188
 189           my $summary=getsummary($authrecord,$authid,$authtypecode);
 190   #         $summary="<a href='detail.pl?authid=$authid'>".$summary.".</a>" if ($intranet);
 191   #         $summary="<a href='detail.pl?authid=$authid'>".$summary.".</a>" if ($intranet);
 192       #     if ($linkid && $linksummary ne " ".$separator){
 193       #         $summary="<b>".$summary."</b>".$linksummary;
 194       #     }
 195           my $query_auth_tag = "SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?";
 196           my $sth = $dbh->prepare($query_auth_tag);
 197           $sth->execute($authtypecode);
 198           my $auth_tag_to_report = $sth->fetchrow;
 199           my %newline;
 200           $newline{summary} = $summary;
 201           $newline{authid} = $authid;
 202       #     $newline{linkid} = $linkid;
 203       #      $newline{reported_tag} = $reported_tag;
 204       #     $newline{used} =0;
 205       #     $newline{biblio_fields} = $tags_using_authtype;
 206           $newline{even} = $counter % 2;
 207           $counter++;
 208           push @finalresult, \%newline;
 209     }## while counter
 210   ###
 211    for (my $z=0; $z<@finalresult; $z++){
 212         my  $count=AUTHcount_usage($finalresult[$z]{authid});
 213         $finalresult[$z]{used}=$count;
 214    }# all $z's
 215
 216   }## if nbresult
 217 NOLUCK:
 218 # $oAResult->destroy();
 219 # $oAuth[0]->destroy();
 220
 221     return (\@finalresult, $nbresults);
 222 }
 223
 224 sub AUTHcount_usage {
 225   my ($authid) = @_;
 226   ### try ZOOM search here
 227   my $oConnection=C4::Context->Zconn("biblioserver",1);
 228   my $query;
 229   $query= "an=".$authid;
 230
 231   my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
 232   my $result;
 233   while ((my $i = ZOOM::event([ $oConnection ])) != 0) {
 234       my $ev = $oConnection->last_event();
 235       if ($ev == ZOOM::Event::ZEND) {
 236           $result = $oResult->size();
 237       }
 238   }
 239   return ($result);
 240 }
 241
 242 sub AUTHfind_authtypecode {
 243   my ($authid) = @_;
 244   my $dbh=C4::Context->dbh;
 245   my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?");
 246   $sth->execute($authid);
 247   my ($authtypecode) = $sth->fetchrow;
 248   return $authtypecode;
 249 }
 250
 251 sub AUTHgettagslib {
 252   my ($forlibrarian,$authtypecode)= @_;
 253   my $dbh=C4::Context->dbh;
 254   $authtypecode="" unless $authtypecode;
 255   my $sth;
 256   my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
 257
 258
 259   # check that authority exists
 260   $sth=$dbh->prepare("select count(*) from auth_tag_structure where authtypecode=?");
 261   $sth->execute($authtypecode);
 262   my ($total) = $sth->fetchrow;
 263   $authtypecode="" unless ($total >0);
 264   $sth= $dbh->prepare(
 265 "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
 266  FROM auth_tag_structure
 267  WHERE authtypecode=?
 268  ORDER BY tagfield"
 269     );
 270
 271   $sth->execute($authtypecode);
 272   my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
 273
 274   while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
 275         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 276         $res->{$tag}->{tab}        = " ";            # XXX
 277         $res->{$tag}->{mandatory}  = $mandatory;
 278         $res->{$tag}->{repeatable} = $repeatable;
 279   }
 280   $sth=      $dbh->prepare(
 281 "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl
 282 FROM auth_subfield_structure
 283 WHERE authtypecode=?
 284 ORDER BY tagfield,tagsubfield"
 285     );
 286     $sth->execute($authtypecode);
 287
 288     my $subfield;
 289     my $authorised_value;
 290     my $value_builder;
 291     my $kohafield;
 292     my $seealso;
 293     my $hidden;
 294     my $isurl;
 295     my $link;
 296
 297     while (
 298         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
 299         $mandatory,     $repeatable, $authorised_value, $authtypecode,
 300         $value_builder, $kohafield,  $seealso,          $hidden,
 301         $isurl,            $link )
 302         = $sth->fetchrow
 303       )
 304     {
 305         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 306         $res->{$tag}->{$subfield}->{tab}              = $tab;
 307         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 308         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 309         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 310         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 311         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 312         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
 313         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 314         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 315         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 316         $res->{$tag}->{$subfield}->{link}            = $link;
 317     }
 318     return $res;
 319 }
 320
 321 sub AUTHaddauthority {
 322 # pass the MARC::Record to this function, and it will create the records in the authority table
 323   my ($record,$authid,$authtypecode) = @_;
 324   my $dbh=C4::Context->dbh;
 325   my $leader='         a              ';##Fixme correct leader as this one just adds utf8 to MARC21
 326 #substr($leader,8,1)=$leadercode;
 327 #    $record->leader($leader);
 328 # my ($authfield,$authidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode);
 329 # my ($authfield2,$authtypesubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authtypecode",$authtypecode);
 330 # my ($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode);
 331
 332 # if authid empty => true add, find a new authid number
 333   if (!$authid) {
 334     my $sth=$dbh->prepare("select max(authid) from auth_header");
 335     $sth->execute;
 336     ($authid)=$sth->fetchrow;
 337     $authid=$authid+1;
 338   ##Insert the recordID in MARC record
 339   ##Both authid and authtypecode is expected to be in the same field. Modify if other requirements arise
 340     $record->add_fields('001',$authid) unless $record->field('001');
 341     $record->add_fields('152','','','b'=>$authtypecode) unless $record->field('152');
 342     #           $record->add_fields('100','','','b'=>$authtypecode);
 343     warn $record->as_formatted;
 344     $dbh->do("lock tables auth_header WRITE");
 345     $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc) values (?,now(),?,?)");
 346     $sth->execute($authid,$authtypecode,$record->as_usmarc);
 347     $sth->finish;
 348
 349   }else{
 350       ##Modified record reinsertid
 351 #       my $idfield=$record->field('001');
 352 #       $record->delete_field($idfield);
 353       $record->add_fields('001',$authid) unless ($record->field('001'));
 354       $record->add_fields('152','','','b'=>$authtypecode) unless ($record->field('152'));
 355 #       $record->add_fields($authfield,$authid);
 356 #       $record->add_fields($authfield2,'','',$authtypesubfield=>$authtypecode);
 357 #       warn $record->as_formatted;
 358       $dbh->do("lock tables auth_header WRITE");
 359       my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
 360       $sth->execute($record->as_usmarc,$authid);
 361       $sth->finish;
 362     }
 363     $dbh->do("unlock tables");
 364     ModZebra($authid,'specialUpdate',"authorityserver");
 365
 366     return ($authid);
 367 }
 368
 369 sub XMLgetauthority {
 370
 371     # Returns MARC::XML of the authority passed in parameter.
 372   my ( $authid ) = @_;
 373   my $dbh=C4::Context->dbh;
 374   my $sth =
 375       $dbh->prepare("select marc from auth_header where authid=? "  );
 376   $sth->execute($authid);
 377   my ($marc)=$sth->fetchrow;
 378   $marc=MARC::File::USMARC::decode($marc);
 379   my $marcxml=$marc->as_xml_record();
 380   return $marcxml;
 381
 382 }
 383
 384 sub AUTHgetauthority {
 385 # Returns MARC::Record of the biblio passed in parameter.
 386   my ($authid)=@_;
 387   my $dbh=C4::Context->dbh;
 388   my $sth=$dbh->prepare("select marc from auth_header where authid=?");
 389   $sth->execute($authid);
 390   my ($marc) = $sth->fetchrow;
 391   my $record=MARC::File::USMARC::decode($marc);
 392
 393   return ($record);
 394 }
 395
 396 sub AUTHgetauth_type {
 397     my ($authtypecode) = @_;
 398     my $dbh=C4::Context->dbh;
 399     my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
 400     $sth->execute($authtypecode);
 401     return $sth->fetchrow_hashref;
 402 }
 403
 404 sub AUTHmodauthority {
 405     my ($authid,$record,$authtypecode,$merge)=@_;
 406     my $dbh=C4::Context->dbh;
 407     my ($oldrecord)=&AUTHgetauthority($authid);
 408     if ($oldrecord eq $record) {
 409         return;
 410     }
 411 my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
 412 #warn find if linked records exist and delete them
 413 my($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield("auth_header.linkid",$authtypecode);
 414
 415 if ($oldrecord->field($linkidfield)){
 416 my @fields=$oldrecord->field($linkidfield);
 417     foreach my $field (@fields){
 418 my    $linkid=$field->subfield($linkidsubfield) ;
 419     if ($linkid){
 420         ##Modify the record of linked
 421         my $linkrecord=AUTHgetauthority($linkid);
 422         my $linktypecode=AUTHfind_authtypecode($linkid);
 423         my ( $linkidfield2,$linkidsubfield2)=AUTHfind_marc_from_kohafield("auth_header.linkid",$linktypecode);
 424         my @linkfields=$linkrecord->field($linkidfield2);
 425             foreach my $linkfield (@linkfields){
 426             if ($linkfield->subfield($linkidsubfield2) eq $authid){
 427                 $linkrecord->delete_field($linkfield);
 428                 $sth->execute($linkrecord->as_usmarc,$linkid);
 429                 ModZebra($linkid,'specialUpdate',"authorityserver");
 430             }
 431             }#foreach linkfield
 432     }
 433     }#foreach linkid
 434 }
 435 #Now rewrite the $record to table with an add
 436 $authid=AUTHaddauthority($record,$authid,$authtypecode);
 437
 438
 439 ### 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
 440 ### they should have a system preference "dontmerge=1" otherwise by default biblios will be updated
 441 ### the $merge flag is now depreceated and will be removed at code cleaning
 442
 443 if (C4::Context->preference('dontmerge') ){
 444 # save the file in localfile/modified_authorities
 445     my $cgidir = C4::Context->intranetdir ."/cgi-bin";
 446     unless (opendir(DIR,"$cgidir")) {
 447             $cgidir = C4::Context->intranetdir."/";
 448     }
 449
 450     my $filename = $cgidir."/localfile/modified_authorities/$authid.authid";
 451     open AUTH, "> $filename";
 452     print AUTH $authid;
 453     close AUTH;
 454 } else {
 455     &merge($authid,$record,$authid,$record);
 456 }
 457 return $authid;
 458 }
 459
 460 sub AUTHdelauthority {
 461     my ($authid,$keep_biblio) = @_;
 462     my $dbh=C4::Context->dbh;
 463 # if the keep_biblio is set to 1, then authority entries in biblio are preserved.
 464
 465 ModZebra($authid,"recordDelete","authorityserver");
 466     $dbh->do("delete from auth_header where authid=$authid") ;
 467
 468 }
 469
 470 sub AUTHhtml2marc {
 471     my ($rtags,$rsubfields,$rvalues,%indicators) = @_;
 472     my $dbh=C4::Context->dbh;
 473     my $prevtag = -1;
 474     my $record = MARC::Record->new();
 475 #---- TODO : the leader is missing
 476
 477 #     my %subfieldlist=();
 478     my $prevvalue; # if tag <10
 479     my $field; # if tag >=10
 480     for (my $i=0; $i< @$rtags; $i++) {
 481         # rebuild MARC::Record
 482         if (@$rtags[$i] ne $prevtag) {
 483             if ($prevtag < 10) {
 484                 if ($prevvalue) {
 485                     $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
 486                 }
 487             } else {
 488                 if ($field) {
 489                     $record->add_fields($field);
 490                 }
 491             }
 492             $indicators{@$rtags[$i]}.='  ';
 493             if (@$rtags[$i] <10) {
 494                 $prevvalue= @$rvalues[$i];
 495                 undef $field;
 496             } else {
 497                 undef $prevvalue;
 498                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
 499             }
 500             $prevtag = @$rtags[$i];
 501         } else {
 502             if (@$rtags[$i] <10) {
 503                 $prevvalue=@$rvalues[$i];
 504             } else {
 505                 if (length(@$rvalues[$i])>0) {
 506                     $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
 507                 }
 508             }
 509             $prevtag= @$rtags[$i];
 510         }
 511     }
 512     # the last has not been included inside the loop... do it now !
 513     $record->add_fields($field) if $field;
 514     return $record;
 515 }
 516
 517
 518 sub FindDuplicate {
 519
 520     my ($record,$authtypecode)=@_;
 521 #    warn "IN for ".$record->as_formatted;
 522     my $dbh = C4::Context->dbh;
 523 #    warn "".$record->as_formatted;
 524     my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
 525     $sth->execute($authtypecode);
 526     my ($auth_tag_to_report) = $sth->fetchrow;
 527     $sth->finish;
 528 #     warn "record :".$record->as_formatted." authtattoreport :$auth_tag_to_report";
 529     # build a request for authoritysearch
 530     my $query='at='.$authtypecode.' ';
 531     map {$query.= " and he=\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/)}  $record->field($auth_tag_to_report)->subfields() if $record->field($auth_tag_to_report);
 532     my ($error,$results)=SimpleSearch($query,"authorityserver");
 533     # there is at least 1 result => return the 1st one
 534     if (@$results>0) {
 535       my $marcrecord = MARC::File::USMARC::decode($results->[0]);
 536       return $marcrecord->field('001')->data,getsummary($marcrecord,$marcrecord->field('001')->data,$authtypecode);
 537     }
 538     # no result, returns nothing
 539     return;
 540 }
 541
 542 sub getsummary{
 543 ## give this a Marc record to return summary
 544 my ($record,$authid,$authtypecode)=@_;
 545
 546 my $dbh=C4::Context->dbh;
 547 # my $authtypecode = AUTHfind_authtypecode($dbh,$authid);
 548  my $authref = getauthtype($authtypecode);
 549         my $summary = $authref->{summary};
 550         my @fields = $record->fields();
 551 #        chop $tags_using_authtype; # FIXME: why commented out?
 552         my $reported_tag;
 553
 554         # if the library has a summary defined, use it. Otherwise, build a standard one
 555         if ($summary) {
 556             my @fields = $record->fields();
 557 #             $reported_tag = '$9'.$result[$counter];
 558             foreach my $field (@fields) {
 559                 my $tag = $field->tag();
 560                 my $tagvalue = $field->as_string();
 561                 $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
 562                 if ($tag<10) {
 563                 if ($tag eq '001') {
 564                     $reported_tag.='$3'.$field->data();
 565                 }
 566
 567                 } else {
 568                     my @subf = $field->subfields;
 569                     for my $i (0..$#subf) {
 570                         my $subfieldcode = $subf[$i][0];
 571                         my $subfieldvalue = $subf[$i][1];
 572                         my $tagsubf = $tag.$subfieldcode;
 573                         $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
 574 #                         if ($tag eq $auth_tag_to_report) {
 575 #                             $reported_tag.='$'.$subfieldcode.$subfieldvalue;
 576 #                         }
 577                     }
 578                 }
 579             }
 580             $summary =~ s/\[(.*?)]//g;
 581             $summary =~ s/\n/<br>/g;
 582         } else {
 583             my $heading; # = $authref->{summary};
 584             my $altheading;
 585             my $seeheading;
 586             my $see;
 587             my @fields = $record->fields();
 588             if (C4::Context->preference('marcflavour') eq 'UNIMARC') {
 589             # construct UNIMARC summary, that is quite different from MARC21 one
 590                 # accepted form
 591                 foreach my $field ($record->field('2..')) {
 592                     $heading.= $field->as_string();
 593                 }
 594                 # rejected form(s)
 595                 foreach my $field ($record->field('4..')) {
 596                     $summary.= "&nbsp;&nbsp;&nbsp;<i>".$field->as_string()."</i><br/>";
 597                     $summary.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see:</i> ".$heading."<br/>";
 598                 }
 599                 # see :
 600                 foreach my $field ($record->field('5..')) {
 601                     $summary.= "&nbsp;&nbsp;&nbsp;<i>".$field->as_string()."</i><br/>";
 602                     $summary.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see:</i> ".$heading."<br/>";
 603                 }
 604                 # // form
 605                 foreach my $field ($record->field('7..')) {
 606                     $seeheading.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see also:</i> ".$field->as_string()."<br />";
 607                     $altheading.= "&nbsp;&nbsp;&nbsp;".$field->as_string()."<br />";
 608                     $altheading.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see also:</i> ".$heading."<br />";
 609                 }
 610                 $summary = "<b>".$heading."</b><br />".$seeheading.$altheading.$summary;
 611             } else {
 612             # construct MARC21 summary
 613                 foreach my $field ($record->field('1..')) {
 614                     if ($record->field('100')) {
 615                         $heading.= $field->as_string('abcdefghjklmnopqrstvxyz68');
 616                     } elsif ($record->field('110')) {
 617                                             $heading.= $field->as_string('abcdefghklmnoprstvxyz68');
 618                     } elsif ($record->field('111')) {
 619                                             $heading.= $field->as_string('acdefghklnpqstvxyz68');
 620                     } elsif ($record->field('130')) {
 621                                             $heading.= $field->as_string('adfghklmnoprstvxyz68');
 622                     } elsif ($record->field('148')) {
 623                                             $heading.= $field->as_string('abvxyz68');
 624                     } elsif ($record->field('150')) {
 625                 #    $heading.= $field->as_string('abvxyz68');
 626                 $heading.= $field->as_formatted();
 627                     my $tag=$field->tag();
 628                     $heading=~s /^$tag//g;
 629                     $heading =~s /\_/\$/g;
 630                     } elsif ($record->field('151')) {
 631                                             $heading.= $field->as_string('avxyz68');
 632                     } elsif ($record->field('155')) {
 633                                             $heading.= $field->as_string('abvxyz68');
 634                     } elsif ($record->field('180')) {
 635                                             $heading.= $field->as_string('vxyz68');
 636                     } elsif ($record->field('181')) {
 637                                             $heading.= $field->as_string('vxyz68');
 638                     } elsif ($record->field('182')) {
 639                                             $heading.= $field->as_string('vxyz68');
 640                     } elsif ($record->field('185')) {
 641                                             $heading.= $field->as_string('vxyz68');
 642                     } else {
 643                         $heading.= $field->as_string();
 644                     }
 645                 } #See From
 646                 foreach my $field ($record->field('4..')) {
 647                     $seeheading.= "&nbsp;&nbsp;&nbsp;".$field->as_string()."<br />";
 648                     $seeheading.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see:</i> ".$seeheading."<br />";
 649                 } #See Also
 650                 foreach my $field ($record->field('5..')) {
 651                     $altheading.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see also:</i> ".$field->as_string()."<br />";
 652                     $altheading.= "&nbsp;&nbsp;&nbsp;".$field->as_string()."<br />";
 653                     $altheading.= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<i>see also:</i> ".$altheading."<br />";
 654                 }
 655                 $summary.=$heading.$seeheading.$altheading;
 656             }
 657         }
 658 return $summary;
 659 }
 660
 661 sub BuildUnimarcHierarchies{
 662   my $authid = shift @_;
 663 #   warn "authid : $authid";
 664   my $force = shift @_;
 665   my @globalresult;
 666   my $dbh=C4::Context->dbh;
 667   my $hierarchies;
 668   my $data = AUTHgetheader($authid);
 669
 670   if ($data->{'authtrees'} and not $force){
 671     return $data->{'authtrees'};
 672   } elsif ($data->{'authtrees'}){
 673     $hierarchies=$data->{'authtrees'};
 674   } else {
 675     my $record = AUTHgetauthority($authid);
 676     my $found;
 677     foreach my $field ($record->field('550')){
 678       if ($field->subfield('5') && $field->subfield('5') eq 'g'){
 679         my $parentrecord = AUTHgetauthority($field->subfield('3'));
 680         my $localresult=$hierarchies;
 681         my $trees;
 682         $trees = BuildUnimarcHierarchies($field->subfield('3'));
 683         my @trees;
 684         if ($trees=~/;/){
 685            @trees = split(/;/,$trees);
 686         } else {
 687            push @trees, $trees;
 688         }
 689         foreach (@trees){
 690           $_.= ",$authid";
 691         }
 692         @globalresult = (@globalresult,@trees);
 693         $found=1;
 694       }
 695       $hierarchies=join(";",@globalresult);
 696     }
 697     #Unless there is no ancestor, I am alone.
 698     $hierarchies="$authid" unless ($hierarchies);
 699   }
 700   AUTHsavetrees($authid,$hierarchies);
 701   return $hierarchies;
 702 }
 703
 704 sub BuildUnimarcHierarchy{
 705         my $record = shift @_;
 706     my $class = shift @_;
 707     my $authid_constructed = shift @_;
 708         my $authid=$record->subfield('250','3');
 709     my %cell;
 710         my $parents=""; my $children="";
 711     my (@loopparents,@loopchildren);
 712         foreach my $field ($record->field('550')){
 713                 if ($field->subfield('5') && $field->subfield('a')){
 714                   if ($field->subfield('5') eq 'h'){
 715             push @loopchildren, { "childauthid"=>$field->subfield('3'),"childvalue"=>$field->subfield('a')};
 716                   }elsif ($field->subfield('5') eq 'g'){
 717             push @loopparents, { "parentauthid"=>$field->subfield('3'),"parentvalue"=>$field->subfield('a')};
 718                   }
 719                 # brothers could get in there with an else
 720                 }
 721         }
 722     $cell{"ifparents"}=1 if (scalar(@loopparents)>0);
 723     $cell{"ifchildren"}=1 if (scalar(@loopchildren)>0);
 724     $cell{"loopparents"}=\@loopparents if (scalar(@loopparents)>0);
 725     $cell{"loopchildren"}=\@loopchildren if (scalar(@loopchildren)>0);
 726     $cell{"class"}=$class;
 727     $cell{"loopauthid"}=$authid;
 728     $cell{"current_value"} =1 if $authid eq $authid_constructed;
 729     $cell{"value"}=$record->subfield('250',"a");
 730         return \%cell;
 731 }
 732
 733 sub AUTHgetheader{
 734         my $authid = shift @_;
 735         my $sql= "SELECT * from auth_header WHERE authid = ?";
 736         my $dbh=C4::Context->dbh;
 737         my $rq= $dbh->prepare($sql);
 738     $rq->execute($authid);
 739         my $data= $rq->fetchrow_hashref;
 740         return $data;
 741 }
 742
 743 sub AUTHsavetrees{
 744         my $authid = shift @_;
 745         my $trees = shift @_;
 746         my $sql= "UPDATE IGNORE auth_header set authtrees=? WHERE authid = ?";
 747         my $dbh=C4::Context->dbh;
 748         my $rq= $dbh->prepare($sql);
 749     $rq->execute($trees,$authid);
 750 }
 751
 752 sub merge {
 753     my ($mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
 754     my $dbh=C4::Context->dbh;
 755     my $authtypecodefrom = AUTHfind_authtypecode($mergefrom);
 756     my $authtypecodeto = AUTHfind_authtypecode($mergeto);
 757     # return if authority does not exist
 758     my @X = $MARCfrom->fields();
 759     return if $#X == -1;
 760     @X = $MARCto->fields();
 761     return if $#X == -1;
 762
 763
 764     # search the tag to report
 765     my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
 766     $sth->execute($authtypecodefrom);
 767     my ($auth_tag_to_report) = $sth->fetchrow;
 768
 769     my @record_to;
 770     @record_to = $MARCto->field($auth_tag_to_report)->subfields() if $MARCto->field($auth_tag_to_report);
 771     my @record_from;
 772     @record_from = $MARCfrom->field($auth_tag_to_report)->subfields() if $MARCfrom->field($auth_tag_to_report);
 773
 774     # search all biblio tags using this authority.
 775     $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
 776     $sth->execute($authtypecodefrom);
 777 my @tags_using_authtype;
 778     while (my ($tagfield) = $sth->fetchrow) {
 779         push @tags_using_authtype,$tagfield."9" ;
 780     }
 781
 782     # now, find every biblio using this authority
 783 ### try ZOOM search here
 784 my $oConnection=C4::Context->Zconn("biblioserver");
 785 my $query;
 786 $query= "an= ".$mergefrom;
 787 my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection ));
 788 my $count=$oResult->size() if  ($oResult);
 789 my @reccache;
 790 my $z=0;
 791 while ( $z<$count ) {
 792 my $rec;
 793          $rec=$oResult->record($z);
 794     my $marcdata = $rec->raw();
 795 push @reccache, $marcdata;
 796 $z++;
 797 }
 798 $oResult->destroy();
 799 foreach my $marc(@reccache){
 800
 801 my $update;
 802     my $marcrecord;
 803     $marcrecord = MARC::File::USMARC::decode($marc);
 804     foreach my $tagfield (@tags_using_authtype){
 805     $tagfield=substr($tagfield,0,3);
 806         my @tags = $marcrecord->field($tagfield);
 807         foreach my $tag (@tags){
 808                 my $tagsubs=$tag->subfield("9");
 809 #warn "$tagfield:$tagsubs:$mergefrom";
 810                     if ($tagsubs== $mergefrom) {
 811
 812             $tag->update("9" =>$mergeto);
 813     foreach my $subfield (@record_to) {
 814 #        warn "$subfield,$subfield->[0],$subfield->[1]";
 815             $tag->update($subfield->[0] =>$subfield->[1]);
 816             }#for $subfield
 817         }
 818              $marcrecord->delete_field($tag);
 819                 $marcrecord->add_fields($tag);
 820         $update=1;
 821         }#for each tag
 822     }#foreach tagfield
 823         my $oldbiblio = TransformMarcToKoha($dbh,$marcrecord,"") ;
 824         if ($update==1){
 825         # FIXME : this NEWmodbiblio does not exist anymore...
 826         &ModBiblio($marcrecord,$oldbiblio->{'biblionumber'},GetFrameworkCode($oldbiblio->{'biblionumber'})) ;
 827         }
 828
 829 }#foreach $marc
 830 }#sub
 831 END { }       # module clean-up code here (global destructor)
 832
 833 =back
 834
 835 =head1 AUTHOR
 836
 837 Koha Developement team <info@koha.org>
 838
 839 Paul POULAIN paul.poulain@free.fr
 840
 841 =cut
 842
 843 # $Id$
 844 # $Log$
 845 # Revision 1.43  2007/03/30 11:59:16  tipaul
 846 # some cleaning (minor, the main one will come later) : removing some unused subs
 847 #
 848 # Revision 1.42  2007/03/29 16:45:53  tipaul
 849 # Code cleaning of Biblio.pm (continued)
 850 #
 851 # All subs have be cleaned :
 852 # - removed useless
 853 # - merged some
 854 # - reordering Biblio.pm completly
 855 # - using only naming conventions
 856 #
 857 # Seems to have broken nothing, but it still has to be heavily tested.
 858 # Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
 859 #
 860 # Revision 1.41  2007/03/29 13:30:31  tipaul
 861 # Code cleaning :
 862 # == Biblio.pm cleaning (useless) ==
 863 # * some sub declaration dropped
 864 # * removed modbiblio sub
 865 # * removed moditem sub
 866 # * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
 867 # * removed MARCkoha2marcItem
 868 # * removed MARCdelsubfield declaration
 869 # * removed MARCkoha2marcBiblio
 870 #
 871 # == Biblio.pm cleaning (naming conventions) ==
 872 # * MARCgettagslib renamed to GetMarcStructure
 873 # * MARCgetitems renamed to GetMarcItem
 874 # * MARCfind_frameworkcode renamed to GetFrameworkCode
 875 # * MARCmarc2koha renamed to TransformMarcToKoha
 876 # * MARChtml2marc renamed to TransformHtmlToMarc
 877 # * MARChtml2xml renamed to TranformeHtmlToXml
 878 # * zebraop renamed to ModZebra
 879 #
 880 # == MARC=OFF ==
 881 # * removing MARC=OFF related scripts (in cataloguing directory)
 882 # * removed checkitems (function related to MARC=off feature, that is completly broken in head. If someone want to reintroduce it, hard work coming...)
 883 # * removed getitemsbybiblioitem (used only by MARC=OFF scripts, that is removed as well)
 884 #
 885 # Revision 1.40  2007/03/28 10:39:16  hdl
 886 # removing $dbh as a parameter in AuthoritiesMarc functions
 887 # And reporting all differences into the scripts taht relies on those functions.
 888 #
 889 # Revision 1.39  2007/03/16 01:25:08  kados
 890 # Using my precrash CVS copy I did the following:
 891 #
 892 # cvs -z3 -d:ext:kados@cvs.savannah.nongnu.org:/sources/koha co -P koha
 893 # find koha.precrash -type d -name "CVS" -exec rm -v {} \;
 894 # cp -r koha.precrash/* koha/
 895 # cd koha/
 896 # cvs commit
 897 #
 898 # This should in theory put us right back where we were before the crash
 899 #
 900 # Revision 1.39  2007/03/12 22:16:31  kados
 901 # chcking for field before calling subfields
 902 #
 903 # Revision 1.38  2007/03/09 14:31:47  tipaul
 904 # rel_3_0 moved to HEAD
 905 #
 906 # Revision 1.28.2.17  2007/02/05 13:16:08  hdl
 907 # Removing Link from AuthoritiesMARC summary (caused a problem owed to the API differences between opac and intranet)
 908 # + removing $dbh in authoritysearch
 909 # + adding links in templates on summaries to go to full view.
 910 # (no more links in popup authorities. or should we add it ?)
 911 #
 912 # Revision 1.28.2.16  2007/02/02 18:07:42  hdl
 913 # Sorting and searching for exact term now works.
 914 #
 915 # Revision 1.28.2.15  2007/01/24 10:17:47  hdl
 916 # FindDuplicate Now works.
 917 # Be AWARE that it needs a change ccl.properties.
 918 #
 919 # Revision 1.28.2.14  2007/01/10 14:40:11  hdl
 920 # Adding Authorities tree.
 921 #
 922 # Revision 1.28.2.13  2007/01/09 15:18:09  hdl
 923 # Adding an to ccl.properties to allow ccl search for authority-numbers.
 924 # Fixing Some problems with the previous modification to allow pqf search to work for more than one page.
 925 # Using search for an= for an authority-Number.
 926 #
 927 # Revision 1.28.2.12  2007/01/09 13:51:31  hdl
 928 # Bug Fixing : AUTHcount_usage used *synchronous* connection where biblio used ****asynchronous**** one.
 929 # First try to get it work.
 930 #
 931 # Revision 1.28.2.11  2007/01/05 14:37:26  btoumi
 932 # bug fix : remove wrong field in sql syntaxe from auth_subfield_structure table
 933 #
 934 # Revision 1.28.2.10  2007/01/04 13:11:08  tipaul
 935 # commenting 2 zconn destroy
 936 #
 937 # Revision 1.28.2.9  2006/12/22 15:09:53  toins
 938 # removing C4::Database;
 939 #
 940 # Revision 1.28.2.8  2006/12/20 17:13:19  hdl
 941 # modifying use of GILS into use of @attr 1=Koha-Auth-Number
 942 #
 943 # Revision 1.28.2.7  2006/12/18 16:45:38  tipaul
 944 # FIXME upcased
 945 #
 946 # Revision 1.28.2.6  2006/12/07 16:45:43  toins
 947 # removing warn compilation. (perl -wc)
 948 #
 949 # Revision 1.28.2.5  2006/12/06 14:19:59  hdl
 950 # ABugFixing : Authority count  Management.
 951 #
 952 # Revision 1.28.2.4  2006/11/17 13:18:58  tipaul
 953 # code cleaning : removing use of "bib", and replacing with "biblionumber"
 954 #
 955 # WARNING : I tried to do carefully, but there are probably some mistakes.
 956 # So if you encounter a problem you didn't have before, look for this change !!!
 957 # anyway, I urge everybody to use only "biblionumber", instead of "bib", "bi", "biblio" or anything else. will be easier to maintain !!!
 958 #
 959 # Revision 1.28.2.3  2006/11/17 11:17:30  tipaul
 960 # code cleaning : removing use of "bib", and replacing with "biblionumber"
 961 #
 962 # WARNING : I tried to do carefully, but there are probably some mistakes.
 963 # So if you encounter a problem you didn't have before, look for this change !!!
 964 # anyway, I urge everybody to use only "biblionumber", instead of "bib", "bi", "biblio" or anything else. will be easier to maintain !!!
 965 #
 966 # Revision 1.28.2.2  2006/10/12 22:04:47  hdl
 967 # Authorities working with zebra.
 968 # zebra Configuration files are comitted next.