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