X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FAuthoritiesMarc.pm;h=1eeb96454ea893c618fed66502e506c4fb79206a;hb=6c7f964c27937fd1c352bfd8936c047d995382b8;hp=a4237387c59a06818708a0f2388c262fb9bee516;hpb=349afe78eed0e1b6ad4d228b28e0d7cfb38a475b;p=koha_gimpoz diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index a4237387c5..1eeb96454e 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -12,11 +12,12 @@ 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; FIXME - Bug 2505 use C4::Context; use C4::Koha; use MARC::Record; @@ -25,6 +26,7 @@ use C4::Search; use C4::AuthoritiesMarc::MARC21; use C4::AuthoritiesMarc::UNIMARC; use C4::Charset; +use C4::Log; use vars qw($VERSION @ISA @EXPORT); @@ -63,18 +65,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,13 +97,11 @@ sub GetAuthMARCFromKohaField { =head2 SearchAuthorities -=over 4 + (\@finalresult, $nbresults)= &SearchAuthorities($tags, $and_or, + $excluding, $operator, $value, $offset,$length,$authtypecode,$sortby) -(\@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 { @@ -219,6 +221,7 @@ sub SearchAuthorities { my $dosearch; my $and=" \@and " ; my $q2; + my $attr_cnt = 0; for(my $i = 0 ; $i <= $#{$value} ; $i++) { if (@$value[$i]){ @@ -245,15 +248,16 @@ sub SearchAuthorities { } $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 ($query=~/\S+/){ + $query= $and x $attr_cnt . $query . $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 +267,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; @@ -343,13 +348,10 @@ sub SearchAuthorities { =head2 CountUsage -=over 4 + $count= &CountUsage($authid) -$count= &CountUsage($authid) counts Usage of Authid in bibliorecords. -=back - =cut sub CountUsage { @@ -361,30 +363,19 @@ sub CountUsage { return scalar @tab; } else { ### ZOOM search here - my $oConnection=C4::Context->Zconn("biblioserver",1); my $query; $query= "an=".$authid; - my $oResult = $oConnection->search(new ZOOM::Query::CCL2RPN( $query, $oConnection )); - my $result; - while ((my $i = ZOOM::event([ $oConnection ])) != 0) { - my $ev = $oConnection->last_event(); - if ($ev == ZOOM::Event::ZEND) { - $result = $oResult->size(); - } - } + my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10); 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 { @@ -393,13 +384,10 @@ sub CountUsageChildren { =head2 GetAuthTypeCode -=over 4 + $authtypecode= &GetAuthTypeCode($authid) -$authtypecode= &GetAuthTypeCode($authid) returns authtypecode of an authid -=back - =cut sub GetAuthTypeCode { @@ -414,11 +402,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. @@ -493,11 +477,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. @@ -515,14 +495,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 @@ -536,8 +518,6 @@ where attribute takes values in : isurl link -=back - =cut sub GetTagsLabels { @@ -545,7 +525,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 @@ -612,14 +592,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 @@ -638,6 +614,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); @@ -647,12 +634,6 @@ 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( @@ -670,7 +651,7 @@ sub AddAuthority { } if (($format eq "UNIMARCAUTH") && (!$record->subfield('100','a'))){ - $record->leader(" nx j22 "); + $record->leader(" nx j22 ") unless ($record->leader()); my $date=POSIX::strftime("%Y%m%d",localtime); if ($record->field('100')){ $record->field('100')->update('a'=>$date."afrey50 ba0"); @@ -721,6 +702,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); @@ -729,23 +711,20 @@ 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); } sub ModAuthority { @@ -773,18 +752,16 @@ sub ModAuthority { print AUTH $authid; close AUTH; } + 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 { @@ -811,13 +788,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 { @@ -839,11 +813,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 @@ -916,15 +886,12 @@ sub AUTHhtml2marc { =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 { @@ -946,7 +913,7 @@ 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) { my $marcrecord = MARC::File::USMARC::decode($results->[0]); @@ -958,17 +925,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{ @@ -1007,10 +971,12 @@ sub BuildSummary{ if ($summary and C4::Context->preference('marcflavour') eq 'UNIMARC') { my @fields = $record->fields(); # $reported_tag = '$9'.$result[$counter]; + my @stringssummary; foreach my $field (@fields) { my $tag = $field->tag(); my $tagvalue = $field->as_string(); - $summary =~ s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g; + my $localsummary= $summary; + $localsummary =~ s/\[(.?.?.?.?)$tag\*(.*?)\]/$1$tagvalue$2\[$1$tag$2\]/g; if ($tag<10) { if ($tag eq '001') { $reported_tag.='$3'.$field->data(); @@ -1021,15 +987,18 @@ sub BuildSummary{ my $subfieldcode = $subf[$i][0]; my $subfieldvalue = $subf[$i][1]; my $tagsubf = $tag.$subfieldcode; - $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g; + $localsummary =~ s/\[(.?.?.?.?)$tagsubf(.*?)\]/$1$subfieldvalue$2\[$1$tagsubf$2\]/g; } } + push @stringssummary, $localsummary if ($localsummary ne $summary); } - $summary =~ s/\[(.*?)]//g; - $summary =~ s/\n/
/g; + my $resultstring; + $resultstring = join(" -- ",@stringssummary); + $resultstring =~ s/\[(.*?)\]//g; + $resultstring =~ s/\n/
/g; + $summary = $resultstring; } else { my $heading; - my $authid; my $altheading; my $seealso; my $broaderterms; @@ -1042,8 +1011,7 @@ sub BuildSummary{ # construct UNIMARC summary, that is quite different from MARC21 one # accepted form foreach my $field ($record->field('2..')) { - $heading.= $field->subfield('a'); - $authid=$field->subfield('3'); + $heading.= $field->as_string('abcdefghijlmnopqrstuvwxyz'); } # rejected form(s) foreach my $field ($record->field('3..')) { @@ -1052,18 +1020,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 @@ -1075,7 +1043,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); @@ -1136,17 +1104,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{ @@ -1195,9 +1160,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" @@ -1211,8 +1175,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{ @@ -1220,16 +1182,17 @@ 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')){ + foreach my $field ($record->field('5..')){ + my $subfauthid=_get_authid_subfield($field); if ($field->subfield('5') && $field->subfield('a')){ if ($field->subfield('5') eq 'h'){ - push @loopchildren, { "childauthid"=>$field->subfield('3'),"childvalue"=>$field->subfield('a')}; + push @loopchildren, { "childauthid"=>$subfauthid,"childvalue"=>$field->subfield('a')}; }elsif ($field->subfield('5') eq 'g'){ - push @loopparents, { "parentauthid"=>$field->subfield('3'),"parentvalue"=>$field->subfield('a')}; + push @loopparents, { "parentauthid"=>$subfauthid,"parentvalue"=>$field->subfield('a')}; } # brothers could get in there with an else } @@ -1245,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{ @@ -1268,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{ @@ -1288,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 { @@ -1388,9 +1344,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; @@ -1468,11 +1432,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 @@ -1508,7 +1468,7 @@ __END__ =head1 AUTHOR -Koha Developement team +Koha Development Team Paul POULAIN paul.poulain@free.fr