use MARC::File::USMARC;
use MARC::File::XML;
use POSIX qw(strftime);
+use Module::Load::Conditional qw(can_load);
use C4::Koha;
use C4::Dates qw/format_date/;
# to get something
push @EXPORT, qw(
- &Get
&GetBiblio
&GetBiblioData
&GetBiblioItemData
&GetAuthorisedValueDesc
&GetMarcStructure
&GetMarcFromKohaField
+ &GetMarcSubfieldStructureFromKohaField
&GetFrameworkCode
&TransformKohaToMarc
&PrepHostMarcField
# Others functions
push @EXPORT, qw(
&TransformMarcToKoha
- &TransformHtmlToMarc2
&TransformHtmlToMarc
&TransformHtmlToXml
- &GetNoZebraIndexes
prepare_host_field
);
}
+eval {
+ if (C4::Context->ismemcached) {
+ require Memoize::Memcached;
+ import Memoize::Memcached qw(memoize_memcached);
+
+ memoize_memcached( 'GetMarcStructure',
+ memcached => C4::Context->memcached);
+ }
+};
+
=head1 NAME
C4::Biblio - cataloging management functions
require C4::Reserves;
my ($count, $reserves) = C4::Reserves::GetReservesFromBiblionumber($biblionumber);
foreach my $res ( @$reserves ) {
- C4::Reserves::CancelReserve( $res->{'biblionumber'}, $res->{'itemnumber'}, $res->{'borrowernumber'} );
+ C4::Reserves::CancelReserve({ reserve_id => $res->{'reserve_id'} });
}
# Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
# for at least 2 reasons :
- # - we need to read the biblio if NoZebra is set (to remove it from the indexes
# - if something goes wrong, the biblio may be deleted from Koha but not from zebra
# and we would have no way to remove it (except manually in zebra, but I bet it would be very hard to handle the problem)
- my $oldRecord;
- if ( C4::Context->preference("NoZebra") ) {
-
- # only NoZebra indexing needs to have
- # the previous version of the record
- $oldRecord = GetMarcBiblio($biblionumber);
- }
- ModZebra( $biblionumber, "recordDelete", "biblioserver", $oldRecord, undef );
+ ModZebra( $biblionumber, "recordDelete", "biblioserver" );
# delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
$sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
my $linker_module =
"C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
- eval { eval "require $linker_module"; };
- if ($@) {
+ unless ( can_load( modules => { $linker_module => undef } ) ) {
$linker_module = 'C4::Linker::Default';
- eval "require $linker_module";
- }
- if ($@) {
- return 0, 0;
+ unless ( can_load( modules => { $linker_module => undef } ) ) {
+ return 0, 0;
+ }
}
my $linker = $linker_module->new(
$results{'fuzzy'}->{ $heading->display_form() }++;
}
elsif ( C4::Context->preference('AutoCreateAuthorities') ) {
- my $authtypedata =
- C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() );
- my $marcrecordauth = MARC::Record->new();
- if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
- $marcrecordauth->leader(' nz a22 o 4500');
- SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
+ if ( _check_valid_auth_link( $current_link, $field ) ) {
+ $results{'linked'}->{ $heading->display_form() }++;
}
- my $authfield =
- MARC::Field->new( $authtypedata->{auth_tag_to_report},
- '', '', "a" => "" . $field->subfield('a') );
- map {
- $authfield->add_subfields( $_->[0] => $_->[1] )
- if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
- } $field->subfields();
- $marcrecordauth->insert_fields_ordered($authfield);
+ else {
+ my $authtypedata =
+ C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() );
+ my $marcrecordauth = MARC::Record->new();
+ if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
+ $marcrecordauth->leader(' nz a22 o 4500');
+ SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' );
+ }
+ $field->delete_subfield( code => '9' )
+ if defined $current_link;
+ my $authfield =
+ MARC::Field->new( $authtypedata->{auth_tag_to_report},
+ '', '', "a" => "" . $field->subfield('a') );
+ map {
+ $authfield->add_subfields( $_->[0] => $_->[1] )
+ if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" )
+ } $field->subfields();
+ $marcrecordauth->insert_fields_ordered($authfield);
# bug 2317: ensure new authority knows it's using UTF-8; currently
# only need to do this for MARC21, as MARC::Record->as_xml_record() handles
# use UTF-8, but as of 2008-08-05, did not want to introduce that kind
# of change to a core API just before the 3.0 release.
- if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
- $marcrecordauth->insert_fields_ordered(
- MARC::Field->new(
- '667', '', '',
- 'a' => "Machine generated authority record."
- )
- );
- my $cite =
- $bib->author() . ", "
- . $bib->title_proper() . ", "
- . $bib->publication_date() . " ";
- $cite =~ s/^[\s\,]*//;
- $cite =~ s/[\s\,]*$//;
- $cite =
- "Work cat.: ("
- . C4::Context->preference('MARCOrgCode') . ")"
- . $bib->subfield( '999', 'c' ) . ": "
- . $cite;
- $marcrecordauth->insert_fields_ordered(
- MARC::Field->new( '670', '', '', 'a' => $cite ) );
- }
+ if ( C4::Context->preference('marcflavour') eq 'MARC21' ) {
+ $marcrecordauth->insert_fields_ordered(
+ MARC::Field->new(
+ '667', '', '',
+ 'a' => "Machine generated authority record."
+ )
+ );
+ my $cite =
+ $bib->author() . ", "
+ . $bib->title_proper() . ", "
+ . $bib->publication_date() . " ";
+ $cite =~ s/^[\s\,]*//;
+ $cite =~ s/[\s\,]*$//;
+ $cite =
+ "Work cat.: ("
+ . C4::Context->preference('MARCOrgCode') . ")"
+ . $bib->subfield( '999', 'c' ) . ": "
+ . $cite;
+ $marcrecordauth->insert_fields_ordered(
+ MARC::Field->new( '670', '', '', 'a' => $cite ) );
+ }
# warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted;
- $authid =
- C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
- $heading->auth_type() );
- $field->add_subfields( '9', $authid );
- $num_headings_changed++;
- $results{'added'}->{ $heading->display_form() }++;
+ $authid =
+ C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '',
+ $heading->auth_type() );
+ $field->add_subfields( '9', $authid );
+ $num_headings_changed++;
+ $results{'added'}->{ $heading->display_form() }++;
+ }
}
elsif ( defined $current_link ) {
- $field->delete_subfield( code => '9' );
- $num_headings_changed++;
- $results{'unlinked'}->{ $heading->display_form() }++;
+ if ( _check_valid_auth_link( $current_link, $field ) ) {
+ $results{'linked'}->{ $heading->display_form() }++;
+ }
+ else {
+ $field->delete_subfield( code => '9' );
+ $num_headings_changed++;
+ $results{'unlinked'}->{ $heading->display_form() }++;
+ }
}
else {
$results{'unlinked'}->{ $heading->display_form() }++;
return $num_headings_changed, \%results;
}
+=head2 _check_valid_auth_link
+
+ if ( _check_valid_auth_link($authid, $field) ) {
+ ...
+ }
+
+Check whether the specified heading-auth link is valid without reference
+to Zebra/Solr. Ideally this code would be in C4::Heading, but that won't be
+possible until we have de-cycled C4::AuthoritiesMarc, so this is the
+safest place.
+
+=cut
+
+sub _check_valid_auth_link {
+ my ( $authid, $field ) = @_;
+
+ require C4::AuthoritiesMarc;
+
+ my $authorized_heading =
+ C4::AuthoritiesMarc::GetAuthorizedHeading( { 'authid' => $authid } ) || '';
+
+ return ($field->as_string('abcdefghijklmnopqrstuvwxyz') eq $authorized_heading);
+}
+
=head2 GetRecordValue
my $values = GetRecordValue($field, $record, $frameworkcode);
my ($bibnum) = @_;
my $dbh = C4::Context->dbh;
- # my $query = C4::Context->preference('item-level_itypes') ?
- # " SELECT * , biblioitems.notes AS bnotes, biblio.notes
- # FROM biblio
- # LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
- # WHERE biblio.biblionumber = ?
- # AND biblioitems.biblionumber = biblio.biblionumber
- #";
-
my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
FROM biblio
LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
- WHERE biblio.biblionumber = ?
- AND biblioitems.biblionumber = biblio.biblionumber ";
+ WHERE biblio.biblionumber = ?";
my $sth = $dbh->prepare($query);
$sth->execute($bibnum);
sub GetISBDView {
my ( $biblionumber, $template ) = @_;
my $record = GetMarcBiblio($biblionumber, 1);
- return undef unless defined $record;
+ return unless defined $record;
my $itemtype = &GetFrameworkCode($biblionumber);
my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
my $tagslib = &GetMarcStructure( 1, $itemtype );
# warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue;
# warn "FV : $fieldvalue";
if ( $subfvalue ne "" ) {
+ # OPAC hidden subfield
+ next
+ if ( ( $template eq 'opac' )
+ && ( $tagslib->{$fieldvalue}->{$subfvalue}->{'hidden'} || 0 ) > 0 );
foreach my $field (@fieldslist) {
foreach my $subfield ( $field->subfield($subfvalue) ) {
my $calculated = $analysestring;
for my $i ( 0 .. $#subf ) {
my $valuecode = $subf[$i][1];
my $subfieldcode = $subf[$i][0];
+ # OPAC hidden subfield
+ next
+ if ( ( $template eq 'opac' )
+ && ( $tagslib->{$fieldvalue}->{$subfieldcode}->{'hidden'} || 0 ) > 0 );
my $subfieldvalue = GetAuthorisedValueDesc( $tag, $subf[$i][0], $subf[$i][1], '', $tagslib );
my $tagsubf = $tag . $subfieldcode;
=head2 GetBiblio
- ( $count, @results ) = &GetBiblio($biblionumber);
+ my $biblio = &GetBiblio($biblionumber);
=cut
my $count = 0;
my @results;
$sth->execute($biblionumber);
- while ( my $data = $sth->fetchrow_hashref ) {
- $results[$count] = $data;
- $count++;
- } # while
- $sth->finish;
- return ( $count, @results );
+ if ( my $data = $sth->fetchrow_hashref ) {
+ return $data;
+ }
+ return;
} # sub GetBiblio
=head2 GetBiblioItemInfosOf
my ( $forlibrarian, $frameworkcode ) = @_;
my $dbh = C4::Context->dbh;
$frameworkcode = "" unless $frameworkcode;
- my $cache;
if ( defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode} ) {
return $marc_structure_cache->{$forlibrarian}->{$frameworkcode};
}
- if (Koha::Cache->is_cache_active()) {
- $cache = Koha::Cache->new();
- if ($cache) {
- my $cached = $cache->get_from_cache("GetMarcStructure:$frameworkcode:$forlibrarian");
- return $cached if $cached;
- }
- }
+
+ # my $sth = $dbh->prepare(
+ # "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
+ # $sth->execute($frameworkcode);
+ # my ($total) = $sth->fetchrow;
+ # $frameworkcode = "" unless ( $total > 0 );
my $sth = $dbh->prepare(
"SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
FROM marc_tag_structure
$marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res;
- if (Koha::Cache->is_cache_active() && defined $cache) {
- $cache->set_in_cache("GetMarcStructure:$frameworkcode:$forlibrarian",$res,10000);
- }
return $res;
}
=cut
-sub GetUsedMarcStructure($) {
+sub GetUsedMarcStructure {
my $frameworkcode = shift || '';
my $query = qq/
SELECT *
($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
Returns the MARC fields & subfields mapped to the koha field
-for the given frameworkcode
+for the given frameworkcode or default framework if $frameworkcode is missing
=cut
sub GetMarcFromKohaField {
- my ( $kohafield, $frameworkcode ) = @_;
- return (0, undef) unless $kohafield and defined $frameworkcode;
+ my $kohafield = shift;
+ my $frameworkcode = shift || '';
+ return (0, undef) unless $kohafield;
my $relations = C4::Context->marcfromkohafield;
if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
return @$mf;
return (0, undef);
}
+=head2 GetMarcSubfieldStructureFromKohaField
+
+ my $subfield_structure = &GetMarcSubfieldStructureFromKohaField($kohafield, $frameworkcode);
+
+Returns a hashref where keys are marc_subfield_structure column names for the
+row where kohafield=$kohafield for the given framework code.
+
+$frameworkcode is optional. If not given, then the default framework is used.
+
+=cut
+
+sub GetMarcSubfieldStructureFromKohaField {
+ my ($kohafield, $frameworkcode) = @_;
+
+ return undef unless $kohafield;
+ $frameworkcode //= '';
+
+ my $dbh = C4::Context->dbh;
+ my $query = qq{
+ SELECT *
+ FROM marc_subfield_structure
+ WHERE kohafield = ?
+ AND frameworkcode = ?
+ };
+ my $sth = $dbh->prepare($query);
+ $sth->execute($kohafield, $frameworkcode);
+ my $result = $sth->fetchrow_hashref;
+ $sth->finish;
+
+ return $result;
+}
+
=head2 GetMarcBiblio
my $record = GetMarcBiblio($biblionumber, [$embeditems]);
return $record;
} else {
- return undef;
+ return;
}
}
my $marcxml = GetXmlBiblio($biblionumber);
Returns biblioitems.marcxml of the biblionumber passed in parameter.
-The XML contains both biblio & item datas
+The XML should only contain biblio information (item information is no longer stored in marcxml field)
=cut
my $note = "";
my $tag = "";
my $marcnote;
+ my %blacklist = map { $_ => 1 } split(/,/,C4::Context->preference('NotesBlacklist'));
foreach my $field ( $record->field($scope) ) {
- my $value = $field->as_string();
- if ( $note ne "" ) {
- $marcnote = { marcnote => $note, };
- push @marcnotes, $marcnote;
- $note = $value;
- }
- if ( $note ne $value ) {
- $note = $note . " " . $value;
+ my $tag = $field->tag();
+ if (!$blacklist{$tag}) {
+ my $value = $field->as_string();
+ if ( $note ne "" ) {
+ $marcnote = { marcnote => $note, };
+ push @marcnotes, $marcnote;
+ $note = $value;
+ }
+ if ( $note ne $value ) {
+ $note = $note . " " . $value;
+ }
}
}
sub GetMarcSubjects {
my ( $record, $marcflavour ) = @_;
- my ( $mintag, $maxtag );
+ my ( $mintag, $maxtag, $fields_filter );
if ( $marcflavour eq "UNIMARC" ) {
$mintag = "600";
$maxtag = "611";
- } else { # assume marc21 if not unimarc
+ $fields_filter = '6..';
+ } else { # marc21/normarc
$mintag = "600";
$maxtag = "699";
+ $fields_filter = '6..';
}
my @marcsubjects;
- my $subject = "";
- my $subfield = "";
- my $marcsubject;
my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
+ my $authoritysep = C4::Context->preference('authoritysep');
- foreach my $field ( $record->field('6..') ) {
- next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
+ foreach my $field ( $record->field($fields_filter) ) {
+ next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
my @subfields_loop;
my @subfields = $field->subfields();
- my $counter = 0;
my @link_loop;
- # if there is an authority link, build the link with an= subfield9
- my $found9 = 0;
+ # if there is an authority link, build the links with an= subfield9
+ my $subfield9 = $field->subfield('9');
+ my $authoritylink;
+ if ($subfield9) {
+ my $linkvalue = $subfield9;
+ $linkvalue =~ s/(\(|\))//g;
+ @link_loop = ( { limit => 'an', 'link' => $linkvalue } );
+ $authoritylink = $linkvalue
+ }
+
+ # other subfields
for my $subject_subfield (@subfields) {
+ next if ( $subject_subfield->[0] eq '9' );
# don't load unimarc subfields 3,4,5
next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
-
# don't load MARC21 subfields 2 (FIXME: any more subfields??)
next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
+
my $code = $subject_subfield->[0];
my $value = $subject_subfield->[1];
my $linkvalue = $value;
$linkvalue =~ s/(\(|\))//g;
- my $operator;
- if ( $counter != 0 ) {
- $operator = ' and ';
- }
- if ( $code eq 9 ) {
- $found9 = 1;
- @link_loop = ( { 'limit' => 'an', link => "$linkvalue" } );
- }
- if ( not $found9 ) {
- push @link_loop, { 'limit' => $subject_limit, link => $linkvalue, operator => $operator };
- }
- my $separator;
- if ( $counter != 0 ) {
- $separator = C4::Context->preference('authoritysep');
+ # if no authority link, build a search query
+ unless ($subfield9) {
+ push @link_loop, {
+ limit => $subject_limit,
+ 'link' => $linkvalue,
+ operator => (scalar @link_loop) ? ' and ' : undef
+ };
}
-
- # ignore $9
my @this_link_loop = @link_loop;
- push @subfields_loop, { code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $subject_subfield->[0] eq 9 || $subject_subfield->[0] eq '0' );
- $counter++;
+ # do not display $0
+ unless ( $code eq '0' ) {
+ push @subfields_loop, {
+ code => $code,
+ value => $value,
+ link_loop => \@this_link_loop,
+ separator => (scalar @subfields_loop) ? $authoritysep : ''
+ };
+ }
}
- push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
+ push @marcsubjects, {
+ MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop,
+ authoritylink => $authoritylink,
+ };
}
return \@marcsubjects;
sub GetMarcAuthors {
my ( $record, $marcflavour ) = @_;
- my ( $mintag, $maxtag );
+ my ( $mintag, $maxtag, $fields_filter );
# tagslib useful for UNIMARC author reponsabilities
my $tagslib =
if ( $marcflavour eq "UNIMARC" ) {
$mintag = "700";
$maxtag = "712";
- } elsif ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) { # assume marc21 or normarc if not unimarc
+ $fields_filter = '7..';
+ } else { # marc21/normarc
$mintag = "700";
$maxtag = "720";
- } else {
- return;
+ $fields_filter = '7..';
}
+
my @marcauthors;
+ my $authoritysep = C4::Context->preference('authoritysep');
- foreach my $field ( $record->fields ) {
+ foreach my $field ( $record->field($fields_filter) ) {
next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
my @subfields_loop;
my @link_loop;
# if there is an authority link, build the link with Koha-Auth-Number: subfield9
my $subfield9 = $field->subfield('9');
+ if ($subfield9) {
+ my $linkvalue = $subfield9;
+ $linkvalue =~ s/(\(|\))//g;
+ @link_loop = ( { 'limit' => 'an', 'link' => $linkvalue } );
+ }
+
+ # other subfields
for my $authors_subfield (@subfields) {
+ next if ( $authors_subfield->[0] eq '9' );
# don't load unimarc subfields 3, 5
next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
- my $subfieldcode = $authors_subfield->[0];
+
+ my $code = $authors_subfield->[0];
my $value = $authors_subfield->[1];
my $linkvalue = $value;
$linkvalue =~ s/(\(|\))//g;
- my $operator;
- if ( $count_auth != 0 ) {
- $operator = ' and ';
- }
-
- # if we have an authority link, use that as the link, otherwise use standard searching
- if ($subfield9) {
- @link_loop = ( { 'limit' => 'an', link => "$subfield9" } );
- } else {
-
- # reset $linkvalue if UNIMARC author responsibility
- if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] eq "4" ) ) {
- $linkvalue = "(" . GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ) . ")";
- }
- push @link_loop, { 'limit' => 'au', link => $linkvalue, operator => $operator };
+ # UNIMARC author responsibility
+ if ( $marcflavour eq 'UNIMARC' and $code eq '4' ) {
+ $value = GetAuthorisedValueDesc( $field->tag(), $code, $value, '', $tagslib );
+ $linkvalue = "($value)";
+ }
+ # if no authority link, build a search query
+ unless ($subfield9) {
+ push @link_loop, {
+ limit => 'au',
+ 'link' => $linkvalue,
+ operator => (scalar @link_loop) ? ' and ' : undef
+ };
}
- $value = GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib )
- if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /4/ ) );
my @this_link_loop = @link_loop;
- my $separator;
- if ( $count_auth != 0 ) {
- $separator = C4::Context->preference('authoritysep');
+ # do not display $0
+ unless ( $code eq '0') {
+ push @subfields_loop, {
+ tag => $field->tag(),
+ code => $code,
+ value => $value,
+ link_loop => \@this_link_loop,
+ separator => (scalar @subfields_loop) ? $authoritysep : ''
+ };
}
- push @subfields_loop,
- { tag => $field->tag(),
- code => $subfieldcode,
- value => $value,
- link_loop => \@this_link_loop,
- separator => $separator
- }
- unless ( $authors_subfield->[0] eq '9' || $authors_subfield->[0] eq '0');
- $count_auth++;
- }
- push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
+ }
+ push @marcauthors, {
+ MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop,
+ authoritylink => $subfield9,
+ };
}
return \@marcauthors;
}
sub GetMarcSeries {
my ( $record, $marcflavour ) = @_;
- my ( $mintag, $maxtag );
+ my ( $mintag, $maxtag, $fields_filter );
if ( $marcflavour eq "UNIMARC" ) {
- $mintag = "600";
- $maxtag = "619";
- } else { # assume marc21 if not unimarc
+ $mintag = "225";
+ $maxtag = "225";
+ $fields_filter = '2..';
+ } else { # marc21/normarc
$mintag = "440";
$maxtag = "490";
+ $fields_filter = '4..';
}
my @marcseries;
- my $subjct = "";
- my $subfield = "";
- my $marcsubjct;
+ my $authoritysep = C4::Context->preference('authoritysep');
- foreach my $field ( $record->field('440'), $record->field('490') ) {
+ foreach my $field ( $record->field($fields_filter) ) {
+ next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
my @subfields_loop;
-
- #my $value = $field->subfield('a');
- #$marcsubjct = {MARCSUBJCT => $value,};
my @subfields = $field->subfields();
-
- #warn "subfields:".join " ", @$subfields;
- my $counter = 0;
my @link_loop;
+
for my $series_subfield (@subfields) {
- my $volume_number;
- undef $volume_number;
- # see if this is an instance of a volume
- if ( $series_subfield->[0] eq 'v' ) {
- $volume_number = 1;
- }
+ # ignore $9, used for authority link
+ next if ( $series_subfield->[0] eq '9' );
+ my $volume_number;
my $code = $series_subfield->[0];
my $value = $series_subfield->[1];
my $linkvalue = $value;
$linkvalue =~ s/(\(|\))//g;
- if ( $counter != 0 ) {
- push @link_loop, { link => $linkvalue, operator => ' and ', };
- } else {
- push @link_loop, { link => $linkvalue, operator => undef, };
- }
- my $separator;
- if ( $counter != 0 ) {
- $separator = C4::Context->preference('authoritysep');
+
+ # see if this is an instance of a volume
+ if ( $code eq 'v' ) {
+ $volume_number = 1;
}
+
+ push @link_loop, {
+ 'link' => $linkvalue,
+ operator => (scalar @link_loop) ? ' and ' : undef
+ };
+
if ($volume_number) {
push @subfields_loop, { volumenum => $value };
} else {
- if ( $series_subfield->[0] ne '9' ) {
- push @subfields_loop, {
- code => $code,
- value => $value,
- link_loop => \@link_loop,
- separator => $separator,
- volumenum => $volume_number,
- };
+ push @subfields_loop, {
+ code => $code,
+ value => $value,
+ link_loop => \@link_loop,
+ separator => (scalar @subfields_loop) ? $authoritysep : '',
+ volumenum => $volume_number,
}
}
- $counter++;
}
push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
- #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
- #push @marcsubjcts, $marcsubjct;
- #$subjct = $value;
-
}
- my $marcseriessarray = \@marcseries;
- return $marcseriessarray;
+ return \@marcseries;
} #end getMARCseriess
=head2 GetMarcHosts
=head2 ModZebra
- ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
+ ModZebra( $biblionumber, $op, $server );
$biblionumber is the biblionumber we want to index
$server is the server that we want to update
-$oldRecord is the MARC::Record containing the previous version of the record. This is used only when
-NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
-do an update.
-
-$newRecord is the MARC::Record containing the new record. It is usefull only when NoZebra=1, and is used to know what to add to the nozebra database. (the record in mySQL being, if it exist, the previous record, the one just before the modif. We need both : the previous and the new one.
-
=cut
sub ModZebra {
###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
- my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
+ my ( $biblionumber, $op, $server ) = @_;
my $dbh = C4::Context->dbh;
# true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
# at the same time
# replaced by a zebraqueue table, that is filled with ModZebra to run.
- # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
+ # the table is emptied by rebuild_zebra.pl script (using the -z switch)
- if ( C4::Context->preference("NoZebra") ) {
-
- # lock the nozebra table : we will read index lines, update them in Perl process
- # and write everything in 1 transaction.
- # lock the table to avoid someone else overwriting what we are doing
- $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
- my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
- if ( $op eq 'specialUpdate' ) {
-
- # OK, we have to add or update the record
- # 1st delete (virtually, in indexes), if record actually exists
- if ($oldRecord) {
- %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
- }
-
- # ... add the record
- %result = _AddBiblioNoZebra( $biblionumber, $newRecord, $server, %result );
- } else {
-
- # it's a deletion, delete the record...
- # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
- %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
- }
-
- # ok, now update the database...
- my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
- foreach my $key ( keys %result ) {
- foreach my $index ( keys %{ $result{$key} } ) {
- $sth->execute( $result{$key}->{$index}, $server, $key, $index );
- }
- }
- $dbh->do('UNLOCK TABLES');
- } else {
-
- #
- # we use zebra, just fill zebraqueue table
- #
- my $check_sql = "SELECT COUNT(*) FROM zebraqueue
- WHERE server = ?
- AND biblio_auth_number = ?
- AND operation = ?
- AND done = 0";
- my $check_sth = $dbh->prepare_cached($check_sql);
- $check_sth->execute( $server, $biblionumber, $op );
- my ($count) = $check_sth->fetchrow_array;
- $check_sth->finish();
- if ( $count == 0 ) {
- my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
- $sth->execute( $biblionumber, $server, $op );
- $sth->finish;
- }
+ my $check_sql = "SELECT COUNT(*) FROM zebraqueue
+ WHERE server = ?
+ AND biblio_auth_number = ?
+ AND operation = ?
+ AND done = 0";
+ my $check_sth = $dbh->prepare_cached($check_sql);
+ $check_sth->execute( $server, $biblionumber, $op );
+ my ($count) = $check_sth->fetchrow_array;
+ $check_sth->finish();
+ if ( $count == 0 ) {
+ my $sth = $dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)");
+ $sth->execute( $biblionumber, $server, $op );
+ $sth->finish;
}
}
-=head2 GetNoZebraIndexes
-
- %indexes = GetNoZebraIndexes;
-
-return the data from NoZebraIndexes syspref.
-
-=cut
-
-sub GetNoZebraIndexes {
- my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
- my %indexes;
- INDEX: foreach my $line ( split /['"],[\n\r]*/, $no_zebra_indexes ) {
- $line =~ /(.*)=>(.*)/;
- my $index = $1; # initial ' or " is removed afterwards
- my $fields = $2;
- $index =~ s/'|"|\s//g;
- $fields =~ s/'|"|\s//g;
- $indexes{$index} = $fields;
- }
- return %indexes;
-}
=head2 EmbedItemsInMarcBiblio
- EmbedItemsInMarcBiblio($marc, $biblionumber);
+ EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers);
Given a MARC::Record object containing a bib record,
modify it to include the items attached to it as 9XX
per the bib's MARC framework.
+if $itemnumbers is defined, only specified itemnumbers are embedded
=cut
sub EmbedItemsInMarcBiblio {
- my ($marc, $biblionumber) = @_;
+ my ($marc, $biblionumber, $itemnumbers) = @_;
croak "No MARC record" unless $marc;
+ $itemnumbers = [] unless defined $itemnumbers;
+
my $frameworkcode = GetFrameworkCode($biblionumber);
_strip_item_fields($marc, $frameworkcode);
my @item_fields;
my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
while (my ($itemnumber) = $sth->fetchrow_array) {
+ next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers;
require C4::Items;
my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
push @item_fields, $item_marc->field($itemtag);
=head1 INTERNAL FUNCTIONS
-=head2 _DelBiblioNoZebra($biblionumber,$record,$server);
-
-function to delete a biblio in NoZebra indexes
-This function does NOT delete anything in database : it reads all the indexes entries
-that have to be deleted & delete them in the hash
-
-The SQL part is done either :
- - after the Add if we are modifying a biblio (delete + add again)
- - immediatly after this sub if we are doing a true deletion.
-
-$server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
-
-=cut
-
-sub _DelBiblioNoZebra {
- my ( $biblionumber, $record, $server ) = @_;
-
- # Get the indexes
- my $dbh = C4::Context->dbh;
-
- # Get the indexes
- my %index;
- my $title;
- if ( $server eq 'biblioserver' ) {
- %index = GetNoZebraIndexes;
-
- # get title of the record (to store the 10 first letters with the index)
- my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
- $title = lc( $record->subfield( $titletag, $titlesubfield ) );
- } else {
-
- # for authorities, the "title" is the $a mainentry
- my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
- my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
- warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
- $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
- $index{'mainmainentry'} = $authref->{'auth_tag_to_report'} . 'a';
- $index{'mainentry'} = $authref->{'auth_tag_to_report'} . '*';
- $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
- }
-
- my %result;
-
- # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
- $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
-
- # limit to 10 char, should be enough, and limit the DB size
- $title = substr( $title, 0, 10 );
-
- #parse each field
- my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
- foreach my $field ( $record->fields() ) {
-
- #parse each subfield
- next if $field->tag < 10;
- foreach my $subfield ( $field->subfields() ) {
- my $tag = $field->tag();
- my $subfieldcode = $subfield->[0];
- my $indexed = 0;
-
- # check each index to see if the subfield is stored somewhere
- # otherwise, store it in __RAW__ index
- foreach my $key ( keys %index ) {
-
- # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
- if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
- $indexed = 1;
- my $line = lc $subfield->[1];
-
- # remove meaningless value in the field...
- $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
-
- # ... and split in words
- foreach ( split / /, $line ) {
- next unless $_; # skip empty values (multiple spaces)
- # if the entry is already here, do nothing, the biblionumber has already be removed
- unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/ ) ) {
-
- # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
- $sth2->execute( $server, $key, $_ );
- my $existing_biblionumbers = $sth2->fetchrow;
-
- # it exists
- if ($existing_biblionumbers) {
-
- # warn " existing for $key $_: $existing_biblionumbers";
- $result{$key}->{$_} = $existing_biblionumbers;
- $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
- }
- }
- }
- }
- }
-
- # the subfield is not indexed, store it in __RAW__ index anyway
- unless ($indexed) {
- my $line = lc $subfield->[1];
- $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
-
- # ... and split in words
- foreach ( split / /, $line ) {
- next unless $_; # skip empty values (multiple spaces)
- # if the entry is already here, do nothing, the biblionumber has already be removed
- unless ( $result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/ ) {
-
- # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
- $sth2->execute( $server, '__RAW__', $_ );
- my $existing_biblionumbers = $sth2->fetchrow;
-
- # it exists
- if ($existing_biblionumbers) {
- $result{'__RAW__'}->{$_} = $existing_biblionumbers;
- $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
- }
- }
- }
- }
- }
- }
- return %result;
-}
-
-=head2 _AddBiblioNoZebra
-
- _AddBiblioNoZebra($biblionumber, $record, $server, %result);
-
-function to add a biblio in NoZebra indexes
-
-=cut
-
-sub _AddBiblioNoZebra {
- my ( $biblionumber, $record, $server, %result ) = @_;
- my $dbh = C4::Context->dbh;
-
- # Get the indexes
- my %index;
- my $title;
- if ( $server eq 'biblioserver' ) {
- %index = GetNoZebraIndexes;
-
- # get title of the record (to store the 10 first letters with the index)
- my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' ); # FIXME: should be GetFrameworkCode($biblionumber) ??
- $title = lc( $record->subfield( $titletag, $titlesubfield ) );
- } else {
-
- # warn "server : $server";
- # for authorities, the "title" is the $a mainentry
- my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
- my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
- warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
- $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
- $index{'mainmainentry'} = $authref->{auth_tag_to_report} . 'a';
- $index{'mainentry'} = $authref->{auth_tag_to_report} . '*';
- $index{'auth_type'} = "${auth_type_tag}${auth_type_sf}";
- }
-
- # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
- $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
-
- # limit to 10 char, should be enough, and limit the DB size
- $title = substr( $title, 0, 10 );
-
- #parse each field
- my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
- foreach my $field ( $record->fields() ) {
-
- #parse each subfield
- ###FIXME: impossible to index a 001-009 value with NoZebra
- next if $field->tag < 10;
- foreach my $subfield ( $field->subfields() ) {
- my $tag = $field->tag();
- my $subfieldcode = $subfield->[0];
- my $indexed = 0;
-
- # warn "INDEXING :".$subfield->[1];
- # check each index to see if the subfield is stored somewhere
- # otherwise, store it in __RAW__ index
- foreach my $key ( keys %index ) {
-
- # warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
- if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
- $indexed = 1;
- my $line = lc $subfield->[1];
-
- # remove meaningless value in the field...
- $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
-
- # ... and split in words
- foreach ( split / /, $line ) {
- next unless $_; # skip empty values (multiple spaces)
- # if the entry is already here, improve weight
-
- # warn "managing $_";
- if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
- my $weight = $1 + 1;
- $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
- $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
- } else {
-
- # get the value if it exist in the nozebra table, otherwise, create it
- $sth2->execute( $server, $key, $_ );
- my $existing_biblionumbers = $sth2->fetchrow;
-
- # it exists
- if ($existing_biblionumbers) {
- $result{$key}->{"$_"} = $existing_biblionumbers;
- my $weight = defined $1 ? $1 + 1 : 1;
- $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
- $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
-
- # create a new ligne for this entry
- } else {
-
- # warn "INSERT : $server / $key / $_";
- $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname=' . $dbh->quote($key) . ',value=' . $dbh->quote($_) );
- $result{$key}->{"$_"} .= "$biblionumber,$title-1;";
- }
- }
- }
- }
- }
-
- # the subfield is not indexed, store it in __RAW__ index anyway
- unless ($indexed) {
- my $line = lc $subfield->[1];
- $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
-
- # ... and split in words
- foreach ( split / /, $line ) {
- next unless $_; # skip empty values (multiple spaces)
- # if the entry is already here, improve weight
- my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
- if ( $tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
- my $weight = $1 + 1;
- $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
- $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
- } else {
-
- # get the value if it exist in the nozebra table, otherwise, create it
- $sth2->execute( $server, '__RAW__', $_ );
- my $existing_biblionumbers = $sth2->fetchrow;
-
- # it exists
- if ($existing_biblionumbers) {
- $result{'__RAW__'}->{"$_"} = $existing_biblionumbers;
- my $weight = ( $1 ? $1 : 0 ) + 1;
- $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
- $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
-
- # create a new ligne for this entry
- } else {
- $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname="__RAW__",value=' . $dbh->quote($_) );
- $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-1;";
- }
- }
- }
- }
- }
- }
- return %result;
-}
-
=head2 _koha_marc_update_bib_ids
$sth2->finish;
}
$sth->finish;
- return undef;
+ return;
}
=head2 _koha_delete_biblioitems
$sth2->finish;
}
$sth->finish;
- return undef;
+ return;
}
=head1 UNEXPORTED FUNCTIONS
# deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
if ( $encoding eq "UNIMARC" ) {
+ my $defaultlanguage = C4::Context->preference("UNIMARCField100Language");
+ $defaultlanguage = "fre" if (!$defaultlanguage || length($defaultlanguage) != 3);
my $string = $record->subfield( 100, "a" );
if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
my $f100 = $record->field(100);
$string = POSIX::strftime( "%Y%m%d", localtime );
$string =~ s/\-//g;
$string = sprintf( "%-*s", 35, $string );
+ substr ( $string, 22, 3, $defaultlanguage);
}
- substr( $string, 22, 6, "frey50" );
+ substr( $string, 25, 3, "y50" );
unless ( $record->subfield( 100, "a" ) ) {
$record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
}
$f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
}
- my $oldRecord;
- if ( C4::Context->preference("NoZebra") ) {
-
- # only NoZebra indexing needs to have
- # the previous version of the record
- $oldRecord = GetMarcBiblio($biblionumber);
- }
$sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
$sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
$sth->finish;
- ModZebra( $biblionumber, "specialUpdate", "biblioserver", $oldRecord, $record );
+ ModZebra( $biblionumber, "specialUpdate", "biblioserver" );
return $biblionumber;
}
projects / koha.git / blobdiff