# 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;
use C4::AuthoritiesMarc::MARC21;
use C4::AuthoritiesMarc::UNIMARC;
use C4::Charset;
+use C4::Log;
use vars qw($VERSION @ISA @EXPORT);
);
}
+
+=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 {
=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 {
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 ";
+ $attr =" \@attr 1=Heading-Main ";
}elsif (@$tags[$i] eq "mainentry") {
$attr =" \@attr 1=Heading ";
} 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 ($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"?
'@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;
=head2 CountUsage
-=over 4
+ $count= &CountUsage($authid)
-$count= &CountUsage($authid)
counts Usage of Authid in bibliorecords.
-=back
-
=cut
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);
+ if ($err) {
+ warn "Error: $err from search $query";
+ $result = 0;
}
- return ($result);
+
+ 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 {
=head2 GetAuthTypeCode
-=over 4
+ $authtypecode= &GetAuthTypeCode($authid)
-$authtypecode= &GetAuthTypeCode($authid)
returns authtypecode of an authid
-=back
-
=cut
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.
=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.
=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
isurl
link
-=back
-
=cut
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
=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
$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);
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(
}
}
- 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") {
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);
=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 {
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 {
=head2 GetAuthority
-=over 4
+ $record= &GetAuthority( $authid)
-$record= &GetAuthority( $authid)
Returns MARC::Record of the authority passed in parameter.
-=back
-
=cut
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
=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 {
$_->[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);
}
=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{
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();
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/<br>/g;
+ my $resultstring;
+ $resultstring = join(" -- ",@stringssummary);
+ $resultstring =~ s/\[(.*?)\]//g;
+ $resultstring =~ s/\n/<br>/g;
+ $summary = $resultstring;
} else {
my $heading;
- my $authid;
my $altheading;
my $seealso;
my $broaderterms;
# 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..')) {
foreach my $field ($record->field('4..')) {
if ($field->subfield('2')) {
my $thesaurus = "thes. : ".$thesaurus{"$field->subfield('2')"}." : ";
- $see.= '<span class="UF">'.$thesaurus.$field->subfield('a')."</span> -- \n";
+ $see.= '<span class="UF">'.$thesaurus.$field->as_string('abcdefghijlmnopqrstuvwxyz')."</span> -- \n";
}
}
# see :
foreach my $field ($record->field('5..')) {
if (($field->subfield('5')) && ($field->subfield('a')) && ($field->subfield('5') eq 'g')) {
- $broaderterms.= '<span class="BT"> <a href="detail.pl?authid='.$field->subfield('3').'">'.$field->subfield('a')."</a></span> -- \n";
- } elsif (($field->subfield('5')) && ($field->subfield('a')) && ($field->subfield('5') eq 'h')){
- $narrowerterms.= '<span class="NT"><a href="detail.pl?authid='.$field->subfield('3').'">'.$field->subfield('a')."</a></span> -- \n";
+ $broaderterms.= '<span class="BT"> '.$field->as_string('abcdefgjxyz')."</span> -- \n";
+ } elsif (($field->subfield('5')) && ($field->as_string) && ($field->subfield('5') eq 'h')){
+ $narrowerterms.= '<span class="NT">'.$field->as_string('abcdefgjxyz')."</span> -- \n";
} elsif ($field->subfield('a')) {
- $seealso.= '<span class="RT"><a href="detail.pl?authid='.$field->subfield('3').'">'.$field->subfield('a')."</a></span> -- \n";
+ $seealso.= '<span class="RT">'.$field->as_string('abcdefgxyz')."</a></span> -- \n";
}
}
# // form
$narrowerterms =~s/-- \n$//;
$seealso =~s/-- \n$//;
$see =~s/-- \n$//;
- $summary = "<b><a href=\"detail.pl?authid=$authid\">".$heading."</a></b><br />".($notes?"$notes <br />":"");
+ $summary = $heading."<br />".($notes?"$notes <br />":"");
$summary.= '<p><div class="label">TG : '.$broaderterms.'</div></p>' if ($broaderterms);
$summary.= '<p><div class="label">TS : '.$narrowerterms.'</div></p>' if ($narrowerterms);
$summary.= '<p><div class="label">TA : '.$seealso.'</div></p>' if ($seealso);
} 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;
=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{
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);
}
=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"
"ifchildren"
Those two latest ones should disappear soon.
-=back
-
=cut
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);
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{
=head2 AddAuthorityTrees
-=over 4
+ $ref= &AddAuthorityTrees( $authid, $trees)
-$ref= &AddAuthorityTrees( $authid, $trees)
return success or failure
-=back
-
=cut
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 {
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;
=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
=head1 AUTHOR
-Koha Developement team <info@koha.org>
+Koha Development Team <http://koha-community.org/>
Paul POULAIN paul.poulain@free.fr
projects / koha.git / blobdiff