X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FAuthoritiesMarc.pm;h=c3b0db30aa766d7bec6f389c98e1a3c6f7844c81;hb=31a3a7ed9353958e3f684fffc62316caf21e3e77;hp=12ba169d28340eb33cbe84b7ccb6c1c4787a3906;hpb=19ac7c156942ef67cc343b5682e635fa747d7ae7;p=koha_gimpoz diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 12ba169d28..c3b0db30aa 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -12,19 +12,20 @@ package C4::AuthoritiesMarc; # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR # A PARTICULAR PURPOSE. See the GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use strict; +use warnings; use C4::Context; -use C4::Koha; use MARC::Record; use C4::Biblio; use C4::Search; use C4::AuthoritiesMarc::MARC21; use C4::AuthoritiesMarc::UNIMARC; use C4::Charset; +use C4::Log; use vars qw($VERSION @ISA @EXPORT); @@ -39,7 +40,6 @@ BEGIN { &GetAuthType &GetAuthTypeCode &GetAuthMARCFromKohaField - &AUTHhtml2marc &AddAuthority &ModAuthority @@ -63,18 +63,20 @@ BEGIN { ); } + +=head1 NAME + +C4::AuthoritiesMarc + =head2 GetAuthMARCFromKohaField -=over 4 + ( $tag, $subfield ) = &GetAuthMARCFromKohaField ($kohafield,$authtypecode); -( $tag, $subfield ) = &GetAuthMARCFromKohaField ($kohafield,$authtypecode); returns tag and subfield linked to kohafield Comment : Suppose Kohafield is only linked to ONE subfield -=back - =cut sub GetAuthMARCFromKohaField { @@ -93,18 +95,17 @@ sub GetAuthMARCFromKohaField { =head2 SearchAuthorities -=over 4 + (\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, + $excluding, $operator, $value, $offset,$length,$authtypecode, + $sortby[, $skipmetadata]) -(\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby) returns ref to array result and count of results returned -=back - =cut sub SearchAuthorities { - my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby) = @_; -# warn "CALL : $tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby"; + my ($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby,$skipmetadata) = @_; + # warn Dumper($tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby); my $dbh=C4::Context->dbh; if (C4::Context->preference('NoZebra')) { @@ -219,41 +220,63 @@ sub SearchAuthorities { my $dosearch; my $and=" \@and " ; my $q2; + my $attr_cnt = 0; for(my $i = 0 ; $i <= $#{$value} ; $i++) { if (@$value[$i]){ - ##If mainentry search $a tag - if (@$tags[$i] eq "mainmainentry") { - -# FIXME: 'Heading-Main' index not yet defined in zebra -# $attr =" \@attr 1=Heading-Main "; - $attr =" \@attr 1=Heading "; - - }elsif (@$tags[$i] eq "mainentry") { - $attr =" \@attr 1=Heading "; - }else{ - $attr =" \@attr 1=Any "; + if ( @$tags[$i] eq "mainmainentry" ) { + $attr = " \@attr 1=Heading-Main "; } - if (@$operator[$i] eq 'is') { - $attr.=" \@attr 4=1 \@attr 5=100 ";##Phrase, No truncation,all of subfield field must match - }elsif (@$operator[$i] eq "="){ - $attr.=" \@attr 4=107 "; #Number Exact match - }elsif (@$operator[$i] eq "start"){ - $attr.=" \@attr 3=2 \@attr 4=1 \@attr 5=1 ";#Firstinfield Phrase, Right truncated - } else { - $attr .=" \@attr 5=1 \@attr 4=6 ";## Word list, right truncated, anywhere + elsif ( @$tags[$i] eq "mainentry" ) { + $attr = " \@attr 1=Heading "; + } + elsif ( @$tags[$i] eq "any" ) { + $attr = " \@attr 1=Any "; + } + elsif ( @$tags[$i] eq "match" ) { + $attr = " \@attr 1=Match "; + } + elsif ( @$tags[$i] eq "match-heading" ) { + $attr = " \@attr 1=Match-heading "; + } + elsif ( @$tags[$i] eq "see-from" ) { + $attr = " \@attr 1=Match-heading-see-from "; } + elsif ( @$tags[$i] eq "thesaurus" ) { + $attr = " \@attr 1=Subject-heading-thesaurus "; + } + if ( @$operator[$i] eq 'is' ) { + $attr .= " \@attr 4=1 \@attr 5=100 " + ; ##Phrase, No truncation,all of subfield field must match + } + elsif ( @$operator[$i] eq "=" ) { + $attr .= " \@attr 4=107 "; #Number Exact match + } + elsif ( @$operator[$i] eq "start" ) { + $attr .= " \@attr 3=2 \@attr 4=1 \@attr 5=1 " + ; #Firstinfield Phrase, Right truncated + } + elsif ( @$operator[$i] eq "exact" ) { + $attr .= " \@attr 4=1 \@attr 5=100 \@attr 6=3 " + ; ##Phrase, No truncation,all of subfield field must match + } + else { + $attr .= " \@attr 5=1 \@attr 4=6 " + ; ## Word list, right truncated, anywhere + } + @$value[$i] =~ s/"/\\"/g; # Escape the double-quotes in the search value $attr =$attr."\"".@$value[$i]."\""; $q2 .=$attr; - $dosearch=1; + $dosearch=1; + ++$attr_cnt; }#if value } ##Add how many queries generated - if ($query=~/\S+/){ - $query= $and.$query.$q2 + if (defined $query && $query=~/\S+/){ + $query= $and x $attr_cnt . $query . (defined $q2 ? $q2 : ''); } else { - $query=$q2; - } + $query= $q2; + } ## Adding order #$query=' @or @attr 7=2 @attr 1=Heading 0 @or @attr 7=1 @attr 1=Heading 1'.$query if ($sortby eq "HeadingDsc"); my $orderstring= ($sortby eq "HeadingAsc"? @@ -263,8 +286,9 @@ sub SearchAuthorities { '@attr 7=2 @attr 1=Heading 0' :'' ); - $query=($query?"\@or $orderstring $query":"\@or \@attr 1=_ALLRECORDS \@attr 2=103 '' $orderstring "); - + $query=($query?$query:"\@attr 1=_ALLRECORDS \@attr 2=103 ''"); + $query="\@or $orderstring $query" if $orderstring; + $offset=0 unless $offset; my $counter = $offset; $length=10 unless $length; @@ -306,35 +330,42 @@ sub SearchAuthorities { my $separator=C4::Context->preference('authoritysep'); $authrecord = MARC::File::USMARC::decode($marcdata); my $authid=$authrecord->field('001')->data(); - my $summary=BuildSummary($authrecord,$authid,$authtypecode); - my $query_auth_tag = "SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?"; - my $sth = $dbh->prepare($query_auth_tag); - $sth->execute($authtypecode); - my $auth_tag_to_report = $sth->fetchrow; - my $reported_tag; - my $mainentry = $authrecord->field($auth_tag_to_report); - if ($mainentry) { - foreach ($mainentry->subfields()) { - $reported_tag .='$'.$_->[0].$_->[1]; - } - } my %newline; - $newline{summary} = $summary; $newline{authid} = $authid; - $newline{even} = $counter % 2; - $newline{reported_tag} = $reported_tag; + if ( !$skipmetadata ) { + my $summary = + BuildSummary( $authrecord, $authid, $authtypecode ); + my $query_auth_tag = +"SELECT auth_tag_to_report FROM auth_types WHERE authtypecode=?"; + my $sth = $dbh->prepare($query_auth_tag); + $sth->execute($authtypecode); + my $auth_tag_to_report = $sth->fetchrow; + my $reported_tag; + my $mainentry = $authrecord->field($auth_tag_to_report); + if ($mainentry) { + + foreach ( $mainentry->subfields() ) { + $reported_tag .= '$' . $_->[0] . $_->[1]; + } + } + $newline{summary} = $summary; + $newline{even} = $counter % 2; + $newline{reported_tag} = $reported_tag; + } $counter++; push @finalresult, \%newline; }## while counter - ### - for (my $z=0; $z<@finalresult; $z++){ - my $count=CountUsage($finalresult[$z]{authid}); - $finalresult[$z]{used}=$count; - }# all $z's - + ### + if (! $skipmetadata) { + for (my $z=0; $z<@finalresult; $z++){ + my $count=CountUsage($finalresult[$z]{authid}); + $finalresult[$z]{used}=$count; + }# all $z's + } + }## if nbresult NOLUCK: - # $oAResult->destroy(); + $oAResult->destroy(); # $oAuth[0]->destroy(); return (\@finalresult, $nbresults); @@ -343,13 +374,10 @@ sub SearchAuthorities { =head2 CountUsage -=over 4 + $count= &CountUsage($authid) -$count= &CountUsage($authid) counts Usage of Authid in bibliorecords. -=back - =cut sub CountUsage { @@ -364,19 +392,21 @@ sub CountUsage { my $query; $query= "an=".$authid; my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10); - return ($result); + if ($err) { + warn "Error: $err from search $query"; + $result = 0; + } + + return $result; } } =head2 CountUsageChildren -=over 4 + $count= &CountUsageChildren($authid) -$count= &CountUsageChildren($authid) counts Usage of narrower terms of Authid in bibliorecords. -=back - =cut sub CountUsageChildren { @@ -385,13 +415,10 @@ sub CountUsageChildren { =head2 GetAuthTypeCode -=over 4 + $authtypecode= &GetAuthTypeCode($authid) -$authtypecode= &GetAuthTypeCode($authid) returns authtypecode of an authid -=back - =cut sub GetAuthTypeCode { @@ -406,11 +433,7 @@ sub GetAuthTypeCode { =head2 GuessAuthTypeCode -=over 4 - -my $authtypecode = GuessAuthTypeCode($record); - -=back + my $authtypecode = GuessAuthTypeCode($record); Get the record and tries to guess the adequate authtypecode from its content. @@ -485,11 +508,7 @@ my $heading_fields = { =head2 GuessAuthId -=over 4 - -my $authtid = GuessAuthId($record); - -=back + my $authtid = GuessAuthId($record); Get the record and tries to guess the adequate authtypecode from its content. @@ -507,14 +526,16 @@ sub GuessAuthId { =head2 GetTagsLabels -=over 4 + $tagslabel= &GetTagsLabels($forlibrarian,$authtypecode) -$tagslabel= &GetTagsLabels($forlibrarian,$authtypecode) returns a ref to hashref of authorities tag and subfield structure. tagslabel usage : -$tagslabel->{$tag}->{$subfield}->{'attribute'} + + $tagslabel->{$tag}->{$subfield}->{'attribute'} + where attribute takes values in : + lib tab mandatory @@ -528,8 +549,6 @@ where attribute takes values in : isurl link -=back - =cut sub GetTagsLabels { @@ -537,7 +556,7 @@ sub GetTagsLabels { my $dbh=C4::Context->dbh; $authtypecode="" unless $authtypecode; my $sth; - my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac'; + my $libfield = ($forlibrarian == 1)? 'liblibrarian' : 'libopac'; # check that authority exists @@ -604,14 +623,10 @@ ORDER BY tagfield,tagsubfield" =head2 AddAuthority -=over 4 - -$authid= &AddAuthority($record, $authid,$authtypecode) -returns authid of the newly created authority + $authid= &AddAuthority($record, $authid,$authtypecode) Either Create Or Modify existing authority. - -=back +returns authid of the newly created authority =cut @@ -630,6 +645,17 @@ sub AddAuthority { $format= 'MARC21'; } + #update date/time to 005 for marc and unimarc + my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime); + my $f5=$record->field('005'); + if (!$f5) { + $record->insert_fields_ordered( MARC::Field->new('005',$time.".0") ); + } + else { + $f5->update($time.".0"); + } + + SetUTF8Flag($record); if ($format eq "MARC21") { if (!$record->leader) { $record->leader($leader); @@ -639,17 +665,18 @@ sub AddAuthority { MARC::Field->new('003',C4::Context->preference('MARCOrgCode')) ); } - my $time=POSIX::strftime("%Y%m%d%H%M%S",localtime); - if (!$record->field('005')) { - $record->insert_fields_ordered( - MARC::Field->new('005',$time.".0") - ); - } my $date=POSIX::strftime("%y%m%d",localtime); if (!$record->field('008')) { - $record->insert_fields_ordered( - MARC::Field->new('008',$date."|||a|||||| | ||| d") - ); + # Get a valid default value for field 008 + my $default_008 = C4::Context->preference('MARCAuthorityControlField008'); + if(!$default_008 or length($default_008)<34) { + $default_008 = '|| aca||aabn | a|a d'; + } + else { + $default_008 = substr($default_008,0,34); + } + + $record->insert_fields_ordered( MARC::Field->new('008',$date.$default_008) ); } if (!$record->field('040')) { $record->insert_fields_ordered( @@ -661,17 +688,21 @@ sub AddAuthority { } } - if (($format eq "UNIMARCAUTH") && (!$record->subfield('100','a'))){ - $record->leader(" nx j22 "); + if ($format eq "UNIMARCAUTH") { + $record->leader(" nx j22 ") unless ($record->leader()); my $date=POSIX::strftime("%Y%m%d",localtime); - if ($record->field('100')){ + if (my $string=$record->subfield('100',"a")){ + $string=~s/fre50/frey50/; + $record->field('100')->update('a'=>$string); + } + elsif ($record->field('100')){ $record->field('100')->update('a'=>$date."afrey50 ba0"); - } else { - $record->append_fields( - MARC::Field->new('100',' ',' ' - ,'a'=>$date."afrey50 ba0") - ); - } + } else { + $record->append_fields( + MARC::Field->new('100',' ',' ' + ,'a'=>$date."afrey50 ba0") + ); + } } my ($auth_type_tag, $auth_type_subfield) = get_auth_type_location($authtypecode); if (!$authid and $format eq "MARC21") { @@ -713,6 +744,7 @@ sub AddAuthority { my $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)"); $sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record($format)); $sth->finish; + logaction( "AUTHORITIES", "ADD", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog"); } ModZebra($authid,'specialUpdate',"authorityserver",$oldRecord,$record); return ($authid); @@ -721,62 +753,60 @@ sub AddAuthority { =head2 DelAuthority -=over 4 + $authid= &DelAuthority($authid) -$authid= &DelAuthority($authid) Deletes $authid -=back - =cut - sub DelAuthority { my ($authid) = @_; my $dbh=C4::Context->dbh; + logaction( "AUTHORITIES", "DELETE", $authid, "authority" ) if C4::Context->preference("AuthoritiesLog"); ModZebra($authid,"recordDelete","authorityserver",GetAuthority($authid),undef); - $dbh->do("delete from auth_header where authid=$authid") ; - + my $sth = $dbh->prepare("DELETE FROM auth_header WHERE authid=?"); + $sth->execute($authid); } +=head2 ModAuthority + + $authid= &ModAuthority($authid,$record,$authtypecode) + +Modifies authority record, optionally updates attached biblios. + +=cut + sub ModAuthority { - my ($authid,$record,$authtypecode,$merge)=@_; + my ($authid,$record,$authtypecode)=@_; # deprecated $merge parameter removed + my $dbh=C4::Context->dbh; #Now rewrite the $record to table with an add my $oldrecord=GetAuthority($authid); $authid=AddAuthority($record,$authid,$authtypecode); -### 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 -### they should have a system preference "dontmerge=1" otherwise by default biblios will be updated -### the $merge flag is now depreceated and will be removed at code cleaning - if (C4::Context->preference('MergeAuthoritiesOnUpdate') ){ + # If a library thinks that updating all biblios is a long process and wishes + # to leave that to a cron job, use misc/migration_tools/merge_authority.pl. + # In that case set system preference "dontmerge" to 1. Otherwise biblios will + # be updated. + unless(C4::Context->preference('dontmerge') eq '1'){ &merge($authid,$oldrecord,$authid,$record); } else { - # save the file in tmp/modified_authorities - my $cgidir = C4::Context->intranetdir ."/cgi-bin"; - unless (opendir(DIR,"$cgidir")) { - $cgidir = C4::Context->intranetdir."/"; - closedir(DIR); - } - - my $filename = $cgidir."/tmp/modified_authorities/$authid.authid"; - open AUTH, "> $filename"; - print AUTH $authid; - close AUTH; + # save a record in need_merge_authorities table + my $sqlinsert="INSERT INTO need_merge_authorities (authid, done) ". + "VALUES (?,?)"; + $dbh->do($sqlinsert,undef,($authid,0)); } + logaction( "AUTHORITIES", "MODIFY", $authid, "BEFORE=>" . $oldrecord->as_formatted ) if C4::Context->preference("AuthoritiesLog"); return $authid; } =head2 GetAuthorityXML -=over 4 + $marcxml= &GetAuthorityXML( $authid) -$marcxml= &GetAuthorityXML( $authid) returns xml form of record $authid -=back - =cut sub GetAuthorityXML { @@ -803,13 +833,10 @@ sub GetAuthorityXML { =head2 GetAuthority -=over 4 + $record= &GetAuthority( $authid) -$record= &GetAuthority( $authid) Returns MARC::Record of the authority passed in parameter. -=back - =cut sub GetAuthority { @@ -831,11 +858,7 @@ sub GetAuthority { =head2 GetAuthType -=over 4 - -$result = &GetAuthType($authtypecode) - -=back + $result = &GetAuthType($authtypecode) If the authority type specified by C<$authtypecode> exists, returns a hashref of the type's fields. If the type @@ -859,64 +882,14 @@ sub GetAuthType { } -sub AUTHhtml2marc { - my ($rtags,$rsubfields,$rvalues,%indicators) = @_; - my $dbh=C4::Context->dbh; - my $prevtag = -1; - my $record = MARC::Record->new(); -#---- TODO : the leader is missing - -# my %subfieldlist=(); - my $prevvalue; # if tag <10 - my $field; # if tag >=10 - for (my $i=0; $i< @$rtags; $i++) { - # rebuild MARC::Record - if (@$rtags[$i] ne $prevtag) { - if ($prevtag < 10) { - if ($prevvalue) { - $record->add_fields((sprintf "%03s",$prevtag),$prevvalue); - } - } else { - if ($field) { - $record->add_fields($field); - } - } - $indicators{@$rtags[$i]}.=' '; - if (@$rtags[$i] <10) { - $prevvalue= @$rvalues[$i]; - undef $field; - } else { - undef $prevvalue; - $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]); - } - $prevtag = @$rtags[$i]; - } else { - if (@$rtags[$i] <10) { - $prevvalue=@$rvalues[$i]; - } else { - if (length(@$rvalues[$i])>0) { - $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]); - } - } - $prevtag= @$rtags[$i]; - } - } - # the last has not been included inside the loop... do it now ! - $record->add_fields($field) if $field; - return $record; -} - =head2 FindDuplicateAuthority -=over 4 + $record= &FindDuplicateAuthority( $record, $authtypecode) -$record= &FindDuplicateAuthority( $record, $authtypecode) return $authid,Summary if duplicate is found. Comments : an improvement would be to return All the records that match. -=back - =cut sub FindDuplicateAuthority { @@ -938,9 +911,9 @@ sub FindDuplicateAuthority { $_->[1]=~s/$filtervalues/ /g; $query.= " and he,wrdl=\"".$_->[1]."\"" if ($_->[0]=~/[A-z]/); } } - my ($error, $results, $total_hits)=SimpleSearch( $query, 0, 1, [ "authorityserver" ] ); + my ($error, $results, $total_hits) = C4::Search::SimpleSearch( $query, 0, 1, [ "authorityserver" ] ); # there is at least 1 result => return the 1st one - if (@$results>0) { + if (!defined $error && @{$results} ) { my $marcrecord = MARC::File::USMARC::decode($results->[0]); return $marcrecord->field('001')->data,BuildSummary($marcrecord,$marcrecord->field('001')->data,$authtypecode); } @@ -950,17 +923,14 @@ sub FindDuplicateAuthority { =head2 BuildSummary -=over 4 + $text= &BuildSummary( $record, $authid, $authtypecode) -$text= &BuildSummary( $record, $authid, $authtypecode) return HTML encoded Summary Comment : authtypecode can be infered from both record and authid. Moreover, authid can also be inferred from $record. Would it be interesting to delete those things. -=back - =cut sub BuildSummary{ @@ -1026,21 +996,20 @@ sub BuildSummary{ $resultstring =~ s/\n/
/g; $summary = $resultstring; } else { - my $heading; - my $authid; - my $altheading; - my $seealso; - my $broaderterms; - my $narrowerterms; - my $see; - my $seeheading; - my $notes; + my $heading = ''; + my $altheading = ''; + my $seealso = ''; + my $broaderterms = ''; + my $narrowerterms = ''; + my $see = ''; + my $seeheading = ''; + my $notes = ''; my @fields = $record->fields(); if (C4::Context->preference('marcflavour') eq 'UNIMARC') { # construct UNIMARC summary, that is quite different from MARC21 one # accepted form foreach my $field ($record->field('2..')) { - $heading.= $field->subfield('a'); + $heading.= $field->as_string('abcdefghijlmnopqrstuvwxyz'); } # rejected form(s) foreach my $field ($record->field('3..')) { @@ -1049,18 +1018,18 @@ sub BuildSummary{ foreach my $field ($record->field('4..')) { if ($field->subfield('2')) { my $thesaurus = "thes. : ".$thesaurus{"$field->subfield('2')"}." : "; - $see.= ''.$thesaurus.$field->subfield('a')." -- \n"; + $see.= ''.$thesaurus.$field->as_string('abcdefghijlmnopqrstuvwxyz')." -- \n"; } } # see : foreach my $field ($record->field('5..')) { if (($field->subfield('5')) && ($field->subfield('a')) && ($field->subfield('5') eq 'g')) { - $broaderterms.= ' '.$field->subfield('a')." -- \n"; - } elsif (($field->subfield('5')) && ($field->subfield('a')) && ($field->subfield('5') eq 'h')){ - $narrowerterms.= ''.$field->subfield('a')." -- \n"; + $broaderterms.= ' '.$field->as_string('abcdefgjxyz')." -- \n"; + } elsif (($field->subfield('5')) && ($field->as_string) && ($field->subfield('5') eq 'h')){ + $narrowerterms.= ''.$field->as_string('abcdefgjxyz')." -- \n"; } elsif ($field->subfield('a')) { - $seealso.= ''.$field->subfield('a')." -- \n"; + $seealso.= ''.$field->as_string('abcdefgxyz')." -- \n"; } } # // form @@ -1072,7 +1041,7 @@ sub BuildSummary{ $narrowerterms =~s/-- \n$//; $seealso =~s/-- \n$//; $see =~s/-- \n$//; - $summary = "".$heading."
".($notes?"$notes
":""); + $summary = $heading."
".($notes?"$notes
":""); $summary.= '

TG : '.$broaderterms.'

' if ($broaderterms); $summary.= '

TS : '.$narrowerterms.'

' if ($narrowerterms); $summary.= '

TA : '.$seealso.'

' if ($seealso); @@ -1097,8 +1066,8 @@ sub BuildSummary{ } elsif ($record->field('148')) { $heading.= $field->as_string('abvxyz68'); } elsif ($record->field('150')) { - # $heading.= $field->as_string('abvxyz68'); - $heading.= $field->as_formatted(); + $heading.= $field->as_string('abvxyz68'); + #$heading.= $field->as_formatted(); my $tag=$field->tag(); $heading=~s /^$tag//g; $heading =~s /\_/\$/g; @@ -1133,17 +1102,14 @@ sub BuildSummary{ =head2 BuildUnimarcHierarchies -=over 4 + $text= &BuildUnimarcHierarchies( $authid, $force) -$text= &BuildUnimarcHierarchies( $authid, $force) return text containing trees for hierarchies for them to be stored in auth_header Example of text: 122,1314,2452;1324,2342,3,2452 -=back - =cut sub BuildUnimarcHierarchies{ @@ -1156,33 +1122,34 @@ sub BuildUnimarcHierarchies{ my $data = GetHeaderAuthority($authid); if ($data->{'authtrees'} and not $force){ return $data->{'authtrees'}; - } elsif ($data->{'authtrees'}){ - $hierarchies=$data->{'authtrees'}; +# } elsif ($data->{'authtrees'}){ +# $hierarchies=$data->{'authtrees'}; } else { my $record = GetAuthority($authid); my $found; - if ($record){ - foreach my $field ($record->field('550')){ - if ($field->subfield('5') && $field->subfield('5') eq 'g'){ - my $parentrecord = GetAuthority($field->subfield('3')); - my $localresult=$hierarchies; - my $trees; - $trees = BuildUnimarcHierarchies($field->subfield('3')); - my @trees; - if ($trees=~/;/){ - @trees = split(/;/,$trees); - } else { - push @trees, $trees; - } - foreach (@trees){ - $_.= ",$authid"; - } - @globalresult = (@globalresult,@trees); - $found=1; - } - $hierarchies=join(";",@globalresult); - } - } + return unless $record; + foreach my $field ($record->field('5..')){ + if ($field->subfield('5') && $field->subfield('5') eq 'g'){ + my $subfauthid=_get_authid_subfield($field); + next if ($subfauthid eq $authid); + my $parentrecord = GetAuthority($subfauthid); + my $localresult=$hierarchies; + my $trees; + $trees = BuildUnimarcHierarchies($subfauthid); + my @trees; + if ($trees=~/;/){ + @trees = split(/;/,$trees); + } else { + push @trees, $trees; + } + foreach (@trees){ + $_.= ",$authid"; + } + @globalresult = (@globalresult,@trees); + $found=1; + } + $hierarchies=join(";",@globalresult); + } #Unless there is no ancestor, I am alone. $hierarchies="$authid" unless ($hierarchies); } @@ -1192,9 +1159,8 @@ sub BuildUnimarcHierarchies{ =head2 BuildUnimarcHierarchy -=over 4 + $ref= &BuildUnimarcHierarchy( $record, $class,$authid) -$ref= &BuildUnimarcHierarchy( $record, $class,$authid) return a hashref in order to display hierarchy for record and final Authid $authid "loopparents" @@ -1208,8 +1174,6 @@ return a hashref in order to display hierarchy for record and final Authid $auth "ifchildren" Those two latest ones should disappear soon. -=back - =cut sub BuildUnimarcHierarchy{ @@ -1217,19 +1181,21 @@ sub BuildUnimarcHierarchy{ my $class = shift @_; my $authid_constructed = shift @_; return undef unless ($record); - my $authid=$record->subfield('2..','3'); + my $authid=$record->field('001')->data(); my %cell; my $parents=""; my $children=""; my (@loopparents,@loopchildren); - foreach my $field ($record->field('550')){ - if ($field->subfield('5') && $field->subfield('a')){ - if ($field->subfield('5') eq 'h'){ - push @loopchildren, { "childauthid"=>$field->subfield('3'),"childvalue"=>$field->subfield('a')}; - }elsif ($field->subfield('5') eq 'g'){ - push @loopparents, { "parentauthid"=>$field->subfield('3'),"parentvalue"=>$field->subfield('a')}; - } + foreach my $field ($record->field('5..')){ + my $subfauthid=_get_authid_subfield($field); + if ($subfauthid && $field->subfield('5') && $field->subfield('a')){ + if ($field->subfield('5') eq 'h'){ + push @loopchildren, { "childauthid"=>$field->subfield('3'),"childvalue"=>$field->subfield('a')}; + } + elsif ($field->subfield('5') eq 'g'){ + push @loopparents, { "parentauthid"=>$field->subfield('3'),"parentvalue"=>$field->subfield('a')}; + } # brothers could get in there with an else - } + } } $cell{"ifparents"}=1 if (scalar(@loopparents)>0); $cell{"ifchildren"}=1 if (scalar(@loopchildren)>0); @@ -1242,15 +1208,16 @@ sub BuildUnimarcHierarchy{ return \%cell; } +sub _get_authid_subfield{ + my ($field)=@_; + return $field->subfield('9')||$field->subfield('3'); +} =head2 GetHeaderAuthority -=over 4 + $ref= &GetHeaderAuthority( $authid) -$ref= &GetHeaderAuthority( $authid) return a hashref in order auth_header table data -=back - =cut sub GetHeaderAuthority{ @@ -1265,13 +1232,10 @@ sub GetHeaderAuthority{ =head2 AddAuthorityTrees -=over 4 + $ref= &AddAuthorityTrees( $authid, $trees) -$ref= &AddAuthorityTrees( $authid, $trees) return success or failure -=back - =cut sub AddAuthorityTrees{ @@ -1285,16 +1249,11 @@ sub AddAuthorityTrees{ =head2 merge -=over 4 - -$ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto) - + $ref= &merge(mergefrom,$MARCfrom,$mergeto,$MARCto) Could add some feature : Migrating from a typecode to an other for instance. Then we should add some new parameter : bibliotargettag, authtargettag -=back - =cut sub merge { @@ -1339,6 +1298,7 @@ sub merge { } else { #zebra connection my $oConnection=C4::Context->Zconn("biblioserver",0); + my $oldSyntax = $oConnection->option("preferredRecordSyntax"); $oConnection->option("preferredRecordSyntax"=>"XML"); my $query; $query= "an=".$mergefrom; @@ -1355,7 +1315,8 @@ sub merge { push @reccache, $marcdata; $z++; } - $oConnection->destroy(); + $oResult->destroy(); + $oConnection->option("preferredRecordSyntax"=>$oldSyntax); } #warn scalar(@reccache)." biblios to update"; # Get All candidate Tags for the change @@ -1385,9 +1346,17 @@ sub merge { my $tag=$field->tag(); if ($auth_number==$mergefrom) { my $field_to=MARC::Field->new(($tag_to?$tag_to:$tag),$field->indicator(1),$field->indicator(2),"9"=>$mergeto); + my $exclude='9'; foreach my $subfield (@record_to) { $field_to->add_subfields($subfield->[0] =>$subfield->[1]); + $exclude.= $subfield->[0]; } + $exclude='['.$exclude.']'; +# add subfields in $field not included in @record_to + my @restore= grep {$_->[0]!~/$exclude/} $field->subfields(); + foreach my $subfield (@restore) { + $field_to->add_subfields($subfield->[0] =>$subfield->[1]); + } $marcrecord->delete_field($field); $marcrecord->insert_grouped_field($field_to); $update=1; @@ -1465,11 +1434,7 @@ sub merge { =head2 get_auth_type_location -=over 4 - -my ($tag, $subfield) = get_auth_type_location($auth_type_code); - -=back + my ($tag, $subfield) = get_auth_type_location($auth_type_code); Get the tag and subfield used to store the heading type for indexing purposes. The C<$auth_type> parameter is @@ -1487,7 +1452,7 @@ sub get_auth_type_location { my $auth_type_code = @_ ? shift : ''; my ($tag, $subfield) = GetAuthMARCFromKohaField('auth_header.authtypecode', $auth_type_code); - if (defined $tag and defined $subfield and $tag != 0 and $subfield != 0) { + if (defined $tag and defined $subfield and $tag != 0 and $subfield ne '' and $subfield ne ' ') { return ($tag, $subfield); } else { if (C4::Context->preference('marcflavour') eq "MARC21") { @@ -1505,7 +1470,7 @@ __END__ =head1 AUTHOR -Koha Developement team +Koha Development Team Paul POULAIN paul.poulain@free.fr