X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FBiblio.pm;h=7fb5c9a49c64664700197b949f934d979ae57c9a;hb=39d2885d1330afe825e1881f5fc8033d459f6006;hp=6d0c9bb8ddd966aa9c353280814ea1ab325f1dba;hpb=0ffe964fb70084e4f74c1daf7339ed7de98c5ea3;p=koha.git diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 6d0c9bb8dd..7fb5c9a49c 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -20,9 +20,69 @@ package C4::Biblio; # along with Koha; if not, see . use Modern::Perl; + +use vars qw(@ISA @EXPORT); +BEGIN { + require Exporter; + @ISA = qw(Exporter); + + @EXPORT = qw( + AddBiblio + GetBiblioData + GetMarcBiblio + GetRecordValue + GetISBDView + GetMarcControlnumber + GetMarcNotes + GetMarcISBN + GetMarcISSN + GetMarcSubjects + GetMarcAuthors + GetMarcSeries + GetMarcHosts + GetMarcUrls + GetUsedMarcStructure + GetXmlBiblio + GetCOinSBiblio + GetMarcPrice + MungeMarcPrice + GetMarcQuantity + GetAuthorisedValueDesc + GetMarcStructure + IsMarcStructureInternal + GetMarcFromKohaField + GetMarcSubfieldStructureFromKohaField + GetFrameworkCode + TransformKohaToMarc + PrepHostMarcField + CountItemsIssued + CountBiblioInOrders + ModBiblio + ModZebra + UpdateTotalIssues + RemoveAllNsb + DelBiblio + BiblioAutoLink + LinkBibHeadingsToAuthorities + TransformMarcToKoha + TransformHtmlToMarc + TransformHtmlToXml + prepare_host_field + ); + + # Internal functions + # those functions are exported but should not be used + # they are useful in a few circumstances, so they are exported, + # but don't use them unless you are a core developer ;-) + push @EXPORT, qw( + ModBiblioMarc + ); +} + use Carp; use Encode qw( decode is_utf8 ); +use List::MoreUtils qw( uniq ); use MARC::Record; use MARC::File::USMARC; use MARC::File::XML; @@ -41,109 +101,15 @@ use C4::Debug; use Koha::Caches; use Koha::Authority::Types; use Koha::Acquisition::Currencies; -use Koha::Biblio::Metadata; use Koha::Biblio::Metadatas; +use Koha::Holds; +use Koha::ItemTypes; use Koha::SearchEngine; use Koha::Libraries; +use Koha::Util::MARC; -use vars qw(@ISA @EXPORT); use vars qw($debug $cgi_debug); -BEGIN { - - require Exporter; - @ISA = qw( Exporter ); - - # to add biblios - # EXPORTED FUNCTIONS. - push @EXPORT, qw( - &AddBiblio - ); - - # to get something - push @EXPORT, qw( - GetBiblio - GetBiblioData - GetMarcBiblio - GetBiblioItemData - GetBiblioItemInfosOf - GetBiblioItemByBiblioNumber - GetBiblioFromItemNumber - GetBiblionumberFromItemnumber - - &GetRecordValue - &GetFieldMapping - &SetFieldMapping - &DeleteFieldMapping - - &GetISBDView - - &GetMarcControlnumber - &GetMarcNotes - &GetMarcISBN - &GetMarcISSN - &GetMarcSubjects - &GetMarcAuthors - &GetMarcSeries - &GetMarcHosts - GetMarcUrls - &GetUsedMarcStructure - &GetXmlBiblio - &GetCOinSBiblio - &GetMarcPrice - &MungeMarcPrice - &GetMarcQuantity - - &GetAuthorisedValueDesc - &GetMarcStructure - &IsMarcStructureInternal - &GetMarcFromKohaField - &GetMarcSubfieldStructureFromKohaField - &GetFrameworkCode - &TransformKohaToMarc - &PrepHostMarcField - - &CountItemsIssued - &CountBiblioInOrders - &GetSubscriptionsId - ); - - # To modify something - push @EXPORT, qw( - &ModBiblio - &ModZebra - &UpdateTotalIssues - &RemoveAllNsb - ); - - # To delete something - push @EXPORT, qw( - &DelBiblio - ); - - # To link headings in a bib record - # to authority records. - push @EXPORT, qw( - &BiblioAutoLink - &LinkBibHeadingsToAuthorities - ); - - # Internal functions - # those functions are exported but should not be used - # they are useful in a few circumstances, so they are exported, - # but don't use them unless you are a core developer ;-) - push @EXPORT, qw( - &ModBiblioMarc - ); - - # Others functions - push @EXPORT, qw( - &TransformMarcToKoha - &TransformHtmlToMarc - &TransformHtmlToXml - prepare_host_field - ); -} =head1 NAME @@ -241,6 +207,10 @@ sub AddBiblio { $defer_marc_save = 1; } + if (C4::Context->preference('BiblioAddsAuthorities')) { + BiblioAutoLink( $record, $frameworkcode ); + } + my ( $biblionumber, $biblioitemnumber, $error ); my $dbh = C4::Context->dbh; @@ -298,10 +268,14 @@ sub ModBiblio { } if ( C4::Context->preference("CataloguingLog") ) { - my $newrecord = GetMarcBiblio($biblionumber); + my $newrecord = GetMarcBiblio({ biblionumber => $biblionumber }); logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted ); } + if (C4::Context->preference('BiblioAddsAuthorities')) { + BiblioAutoLink( $record, $frameworkcode ); + } + # Cleaning up invalid fields must be done early or SetUTF8Flag is liable to # throw an exception which probably won't be handled. foreach my $field ($record->fields()) { @@ -387,6 +361,10 @@ C<$error> : undef unless an error occurs sub DelBiblio { my ($biblionumber) = @_; + + my $biblio = Koha::Biblios->find( $biblionumber ); + return unless $biblio; # Should we throw an exception instead? + my $dbh = C4::Context->dbh; my $error; # for error handling @@ -409,10 +387,9 @@ sub DelBiblio { } # We delete any existing holds - require C4::Reserves; - my $reserves = C4::Reserves::GetReservesFromBiblionumber({ biblionumber => $biblionumber }); - foreach my $res ( @$reserves ) { - C4::Reserves::CancelReserve({ reserve_id => $res->{'reserve_id'} }); + my $holds = $biblio->holds; + while ( my $hold = $holds->next ) { + $hold->cancel; } # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio @@ -431,6 +408,7 @@ sub DelBiblio { return $error if $error; } + # delete biblio from Koha tables and save in deletedbiblio # must do this *after* _koha_delete_biblioitems, otherwise # delete cascade will prevent deletedbiblioitems rows @@ -560,7 +538,10 @@ sub LinkBibHeadingsToAuthorities { '', '', "a" => "" . $field->subfield('a') ); map { $authfield->add_subfields( $_->[0] => $_->[1] ) - if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" ) + if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" + && C4::Heading::valid_bib_heading_subfield( + $authority_type->auth_tag_to_report, $_->[0] ) + ); } $field->subfields(); $marcrecordauth->insert_fields_ordered($authfield); @@ -572,6 +553,11 @@ sub LinkBibHeadingsToAuthorities { # of change to a core API just before the 3.0 release. if ( C4::Context->preference('marcflavour') eq 'MARC21' ) { + my $userenv = C4::Context->userenv; + my $library; + if ( $userenv && $userenv->{'branch'} ) { + $library = Koha::Libraries->find( $userenv->{'branch'} ); + } $marcrecordauth->insert_fields_ordered( MARC::Field->new( '667', '', '', @@ -586,7 +572,7 @@ sub LinkBibHeadingsToAuthorities { $cite =~ s/[\s\,]*$//; $cite = "Work cat.: (" - . C4::Context->preference('MARCOrgCode') . ")" + . ( $library ? $library->get_effective_marcorgcode : C4::Context->preference('MARCOrgCode') ) . ")" . $bib->subfield( '999', 'c' ) . ": " . $cite; $marcrecordauth->insert_fields_ordered( @@ -685,66 +671,6 @@ sub GetRecordValue { return \@result; } -=head2 SetFieldMapping - - SetFieldMapping($framework, $field, $fieldcode, $subfieldcode); - -Set a Field to MARC mapping value, if it already exists we don't add a new one. - -=cut - -sub SetFieldMapping { - my ( $framework, $field, $fieldcode, $subfieldcode ) = @_; - my $dbh = C4::Context->dbh; - - my $sth = $dbh->prepare('SELECT * FROM fieldmapping WHERE fieldcode = ? AND subfieldcode = ? AND frameworkcode = ? AND field = ?'); - $sth->execute( $fieldcode, $subfieldcode, $framework, $field ); - if ( not $sth->fetchrow_hashref ) { - my @args; - $sth = $dbh->prepare('INSERT INTO fieldmapping (fieldcode, subfieldcode, frameworkcode, field) VALUES(?,?,?,?)'); - - $sth->execute( $fieldcode, $subfieldcode, $framework, $field ); - } -} - -=head2 DeleteFieldMapping - - DeleteFieldMapping($id); - -Delete a field mapping from an $id. - -=cut - -sub DeleteFieldMapping { - my ($id) = @_; - my $dbh = C4::Context->dbh; - - my $sth = $dbh->prepare('DELETE FROM fieldmapping WHERE id = ?'); - $sth->execute($id); -} - -=head2 GetFieldMapping - - GetFieldMapping($frameworkcode); - -Get all field mappings for a specified frameworkcode - -=cut - -sub GetFieldMapping { - my ($framework) = @_; - my $dbh = C4::Context->dbh; - - my $sth = $dbh->prepare('SELECT * FROM fieldmapping where frameworkcode = ?'); - $sth->execute($framework); - - my @return; - while ( my $row = $sth->fetchrow_hashref ) { - push @return, $row; - } - return \@return; -} - =head2 GetBiblioData $data = &GetBiblioData($biblionumber); @@ -780,112 +706,6 @@ sub GetBiblioData { return ($data); } # sub GetBiblioData -=head2 &GetBiblioItemData - - $itemdata = &GetBiblioItemData($biblioitemnumber); - -Looks up the biblioitem with the given biblioitemnumber. Returns a -reference-to-hash. The keys are the fields from the C, -C, and C tables in the Koha database, except -that C is given as C<$itemdata-E{bnotes}>. - -=cut - -#' -sub GetBiblioItemData { - my ($biblioitemnumber) = @_; - my $dbh = C4::Context->dbh; - my $query = "SELECT *,biblioitems.notes AS bnotes - FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber "; - unless ( C4::Context->preference('item-level_itypes') ) { - $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype "; - } - $query .= " WHERE biblioitemnumber = ? "; - my $sth = $dbh->prepare($query); - my $data; - $sth->execute($biblioitemnumber); - $data = $sth->fetchrow_hashref; - $sth->finish; - return ($data); -} # sub &GetBiblioItemData - -=head2 GetBiblioItemByBiblioNumber - -NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration. - -=cut - -sub GetBiblioItemByBiblioNumber { - my ($biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?"); - my $count = 0; - my @results; - - $sth->execute($biblionumber); - - while ( my $data = $sth->fetchrow_hashref ) { - push @results, $data; - } - - $sth->finish; - return @results; -} - -=head2 GetBiblionumberFromItemnumber - - -=cut - -sub GetBiblionumberFromItemnumber { - my ($itemnumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select biblionumber FROM items WHERE itemnumber = ?"); - - $sth->execute($itemnumber); - my ($result) = $sth->fetchrow; - return ($result); -} - -=head2 GetBiblioFromItemNumber - - $item = &GetBiblioFromItemNumber($itemnumber,$barcode); - -Looks up the item with the given itemnumber. if undef, try the barcode. - -C<&itemnodata> returns a reference-to-hash whose keys are the fields -from the C, C, and C tables in the Koha -database. - -=cut - -#' -sub GetBiblioFromItemNumber { - my ( $itemnumber, $barcode ) = @_; - my $dbh = C4::Context->dbh; - my $sth; - if ($itemnumber) { - $sth = $dbh->prepare( - "SELECT * FROM items - LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber - LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber - WHERE items.itemnumber = ?" - ); - $sth->execute($itemnumber); - } else { - $sth = $dbh->prepare( - "SELECT * FROM items - LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber - LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber - WHERE items.barcode = ?" - ); - $sth->execute($barcode); - } - my $data = $sth->fetchrow_hashref; - $sth->finish; - return ($data); -} - =head2 GetISBDView $isbd = &GetISBDView({ @@ -910,7 +730,7 @@ sub GetISBDView { my $framework = $params->{framework}; my $itemtype = $framework; my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype ); - my $tagslib = &GetMarcStructure( 1, $itemtype, { unsafe => 1 } ); + my $tagslib = GetMarcStructure( 1, $itemtype, { unsafe => 1 } ); my $ISBD = C4::Context->preference($sysprefname); my $bloc = $ISBD; @@ -1022,46 +842,6 @@ sub GetISBDView { return $res; } -=head2 GetBiblio - - my $biblio = &GetBiblio($biblionumber); - -=cut - -sub GetBiblio { - my ($biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?"); - my $count = 0; - my @results; - $sth->execute($biblionumber); - if ( my $data = $sth->fetchrow_hashref ) { - return $data; - } - return; -} # sub GetBiblio - -=head2 GetBiblioItemInfosOf - - GetBiblioItemInfosOf(@biblioitemnumbers); - -=cut - -sub GetBiblioItemInfosOf { - my @biblioitemnumbers = @_; - - my $biblioitemnumber_values = @biblioitemnumbers ? join( ',', @biblioitemnumbers ) : "''"; - - my $query = " - SELECT biblioitemnumber, - publicationyear, - itemtype - FROM biblioitems - WHERE biblioitemnumber IN ($biblioitemnumber_values) - "; - return get_infos_of( $query, 'biblioitemnumber' ); -} - =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT =head2 IsMarcStructureInternal @@ -1113,19 +893,21 @@ sub GetMarcStructure { my $dbh = C4::Context->dbh; my $sth = $dbh->prepare( - "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable + "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable,ind1_defaultvalue,ind2_defaultvalue FROM marc_tag_structure WHERE frameworkcode=? ORDER BY tagfield" ); $sth->execute($frameworkcode); - my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable ); + my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable, $ind1_defaultvalue, $ind2_defaultvalue ); - while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) { + while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable, $ind1_defaultvalue, $ind2_defaultvalue ) = $sth->fetchrow ) { $res->{$tag}->{lib} = ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac; $res->{$tag}->{tab} = ""; $res->{$tag}->{mandatory} = $mandatory; $res->{$tag}->{repeatable} = $repeatable; + $res->{$tag}->{ind1_defaultvalue} = $ind1_defaultvalue; + $res->{$tag}->{ind2_defaultvalue} = $ind2_defaultvalue; } $sth = $dbh->prepare( @@ -1184,7 +966,7 @@ in tab 0-9. (used field) my $results = GetUsedMarcStructure($frameworkcode); -C<$results> is a ref to an array which each case containts a ref +C<$results> is a ref to an array which each case contains a ref to a hash which each keys is the columns from marc_subfield_structure C<$frameworkcode> is the framework code. @@ -1205,77 +987,144 @@ sub GetUsedMarcStructure { return $sth->fetchall_arrayref( {} ); } +=pod + =head2 GetMarcSubfieldStructure + my $structure = GetMarcSubfieldStructure($frameworkcode, [$params]); + +Returns a reference to hash representing MARC subfield structure +for framework with framework code C<$frameworkcode>, C<$params> is +optional and may contain additional options. + +=over 4 + +=item C<$frameworkcode> + +The framework code. + +=item C<$params> + +An optional hash reference with additional options. +The following options are supported: + +=over 4 + +=item unsafe + +Pass { unsafe => 1 } do disable cached object cloning, +and instead get a shared reference, resulting in better +performance (but care must be taken so that retured object +is never modified). + +Note: If you call GetMarcSubfieldStructure with unsafe => 1, do not modify or +even autovivify its contents. It is a cached/shared data structure. Your +changes would be passed around in subsequent calls. + +=back + +=back + =cut sub GetMarcSubfieldStructure { - my ( $frameworkcode ) = @_; + my ( $frameworkcode, $params ) = @_; $frameworkcode //= ''; my $cache = Koha::Caches->get_instance(); my $cache_key = "MarcSubfieldStructure-$frameworkcode"; - my $cached = $cache->get_from_cache($cache_key); + my $cached = $cache->get_from_cache($cache_key, { unsafe => ($params && $params->{unsafe}) }); return $cached if $cached; my $dbh = C4::Context->dbh; - my $subfield_structure = $dbh->selectall_hashref( q| + # We moved to selectall_arrayref since selectall_hashref does not + # keep duplicate mappings on kohafield (like place in 260 vs 264) + my $subfield_aref = $dbh->selectall_arrayref( q| SELECT * FROM marc_subfield_structure WHERE frameworkcode = ? AND kohafield > '' - |, 'kohafield', {}, $frameworkcode ); - + ORDER BY frameworkcode,tagfield,tagsubfield + |, { Slice => {} }, $frameworkcode ); + # Now map the output to a hash structure + my $subfield_structure = {}; + foreach my $row ( @$subfield_aref ) { + push @{ $subfield_structure->{ $row->{kohafield} }}, $row; + } $cache->set_in_cache( $cache_key, $subfield_structure ); return $subfield_structure; } =head2 GetMarcFromKohaField - ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode); + ( $field,$subfield ) = GetMarcFromKohaField( $kohafield ); + @fields = GetMarcFromKohaField( $kohafield ); + $field = GetMarcFromKohaField( $kohafield ); + + Returns the MARC fields & subfields mapped to $kohafield. + Since the Default framework is considered as authoritative for such + mappings, the former frameworkcode parameter is obsoleted. -Returns the MARC fields & subfields mapped to the koha field -for the given frameworkcode or default framework if $frameworkcode is missing + In list context all mappings are returned; there can be multiple + mappings. Note that in the above example you could miss a second + mappings in the first call. + In scalar context only the field tag of the first mapping is returned. =cut sub GetMarcFromKohaField { - my ( $kohafield, $frameworkcode ) = @_; - return (0, undef) unless $kohafield; - my $mss = GetMarcSubfieldStructure( $frameworkcode ); - return ( $mss->{$kohafield}{tagfield}, $mss->{$kohafield}{tagsubfield} ); + my ( $kohafield ) = @_; + return unless $kohafield; + # The next call uses the Default framework since it is AUTHORITATIVE + # for all Koha to MARC mappings. + my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework + my @retval; + foreach( @{ $mss->{$kohafield} } ) { + push @retval, $_->{tagfield}, $_->{tagsubfield}; + } + return wantarray ? @retval : ( @retval ? $retval[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. + my $str = GetMarcSubfieldStructureFromKohaField( $kohafield ); -$frameworkcode is optional. If not given, then the default framework is used. + Returns marc subfield structure information for $kohafield. + The Default framework is used, since it is authoritative for kohafield + mappings. + In list context returns a list of all hashrefs, since there may be + multiple mappings. In scalar context the first hashref is returned. =cut sub GetMarcSubfieldStructureFromKohaField { - my ( $kohafield, $frameworkcode ) = @_; + my ( $kohafield ) = @_; return unless $kohafield; - my $mss = GetMarcSubfieldStructure( $frameworkcode ); - return exists $mss->{$kohafield} - ? $mss->{$kohafield} - : undef; + # The next call uses the Default framework since it is AUTHORITATIVE + # for all Koha to MARC mappings. + my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework + return unless $mss->{$kohafield}; + return wantarray ? @{$mss->{$kohafield}} : $mss->{$kohafield}->[0]; } =head2 GetMarcBiblio - my $record = GetMarcBiblio($biblionumber, [$embeditems], [$opac]); + my $record = GetMarcBiblio({ + biblionumber => $biblionumber, + embed_items => $embeditems, + opac => $opac, + borcat => $patron_category }); Returns MARC::Record representing a biblio record, or C if the biblionumber doesn't exist. +Both embed_items and opac are optional. +If embed_items is passed and is 1, items are embedded. +If opac is passed and is 1, the record is filtered as needed. + =over 4 =item C<$biblionumber> @@ -1291,14 +1140,28 @@ set to true to include item information. set to true to make the result suited for OPAC view. This causes things like OpacHiddenItems to be applied. +=item C<$borcat> + +If the OpacHiddenItemsExceptions system preference is set, this patron category +can be used to make visible OPAC items which would be normally hidden. +It only makes sense in combination both embed_items and opac values true. + =back =cut sub GetMarcBiblio { - my $biblionumber = shift; - my $embeditems = shift || 0; - my $opac = shift || 0; + my ($params) = @_; + + if (not defined $params) { + carp 'GetMarcBiblio called without parameters'; + return; + } + + my $biblionumber = $params->{biblionumber}; + my $embeditems = $params->{embed_items} || 0; + my $opac = $params->{opac} || 0; + my $borcat = $params->{borcat} // q{}; if (not defined $biblionumber) { carp 'GetMarcBiblio called with undefined biblionumber'; @@ -1326,7 +1189,11 @@ sub GetMarcBiblio { C4::Biblio::_koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber ); - C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblionumber, undef, $opac ) + C4::Biblio::EmbedItemsInMarcBiblio({ + marc_record => $record, + biblionumber => $biblionumber, + opac => $opac, + borcat => $borcat }) if ($embeditems); return $record; @@ -1355,7 +1222,7 @@ sub GetXmlBiblio { FROM biblio_metadata WHERE biblionumber=? AND format='marcxml' - AND marcflavour=? + AND `schema`=? |, undef, $biblionumber, C4::Context->preference('marcflavour') ); return $marcxml; @@ -1484,9 +1351,9 @@ sub GetCOinSBiblio { $isbn = $record->subfield( '773', 'z' ) || ''; $issn = $record->subfield( '773', 'x' ) || ''; if ($mtx eq 'journal') { - $title .= "&rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a'))); + $title .= "&rft.title=" . ( $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{} ); } else { - $title .= "&rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || ''); + $title .= "&rft.btitle=" . ( $record->subfield( '773', 't' ) || $record->subfield( '773', 'a') || q{} ); } foreach my $rel ($record->subfield( '773', 'g' )) { if ($pages) { @@ -1556,6 +1423,7 @@ sub GetMarcPrice { =head2 MungeMarcPrice Return the best guess at what the actual price is from a price field. + =cut sub MungeMarcPrice { @@ -1683,12 +1551,14 @@ sub GetAuthorisedValueDesc { #---- branch if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) { - return Koha::Libraries->find($value)->branchname; + my $branch = Koha::Libraries->find($value); + return $branch? $branch->branchname: q{}; } #---- itemtypes if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) { - return getitemtypeinfo($value)->{translated_description}; + my $itemtype = Koha::ItemTypes->find( $value ); + return $itemtype ? $itemtype->translated_description : q||; } #---- "true" authorized value @@ -1802,7 +1672,7 @@ sub GetMarcISSN { Get all notes from the MARC record and returns them in an array. The notes are stored in different fields depending on MARC flavour. - MARC21 field 555 gets special attention for the $u subfields. + MARC21 5XX $u subfields receive special attention as they are URIs. =cut @@ -1820,12 +1690,16 @@ sub GetMarcNotes { foreach my $field ( $record->field($scope) ) { my $tag = $field->tag(); next if $blacklist{ $tag }; - if( $marcflavour ne 'UNIMARC' && $tag =~ /555/ ) { - # Field 555$u contains URLs - # We first push the regular subfields and all $u's separately - # Leave further actions to the template - push @marcnotes, { marcnote => $field->as_string('abcd') }; + if( $marcflavour ne 'UNIMARC' && $field->subfield('u') ) { + # Field 5XX$u always contains URI + # Examples: 505u, 506u, 510u, 514u, 520u, 530u, 538u, 540u, 542u, 552u, 555u, 561u, 563u, 583u + # We first push the other subfields, then all $u's separately + # Leave further actions to the template (see e.g. opac-detail) + my $othersub = + join '', ( 'a' .. 't', 'v' .. 'z', '0' .. '9' ); # excl 'u' + push @marcnotes, { marcnote => $field->as_string($othersub) }; foreach my $sub ( $field->subfield('u') ) { + $sub =~ s/^\s+|\s+$//g; # trim push @marcnotes, { marcnote => $sub }; } } else { @@ -2047,6 +1921,7 @@ sub GetMarcUrls { } my @urls = $field->subfield('u'); foreach my $url (@urls) { + $url =~ s/^\s+|\s+$//g; # trim my $marcurl; if ( $marcflavour eq 'MARC21' ) { my $s3 = $field->subfield('3'); @@ -2260,42 +2135,51 @@ sub GetFrameworkCode { =head2 TransformKohaToMarc - $record = TransformKohaToMarc( $hash ) + $record = TransformKohaToMarc( $hash [, $params ] ) -This function builds partial MARC::Record from a hash -Hash entries can be from biblio or biblioitems. +This function builds a (partial) MARC::Record from a hash. +Hash entries can be from biblio, biblioitems or items. +The params hash includes the parameter no_split used in C4::Items. This function is called in acquisition module, to create a basic catalogue -entry from user entry +entry from user entry. =cut sub TransformKohaToMarc { - my $hash = shift; + my ( $hash, $params ) = @_; my $record = MARC::Record->new(); SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") ); - # FIXME Do not we want to get the marc subfield structure for the biblio framework? - my $mss = GetMarcSubfieldStructure(); + + # In the next call we use the Default framework, since it is considered + # authoritative for Koha to Marc mappings. + my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # do not change framewok my $tag_hr = {}; while ( my ($kohafield, $value) = each %$hash ) { - next unless exists $mss->{$kohafield}; - next unless $mss->{$kohafield}; - my $tagfield = $mss->{$kohafield}{tagfield} . ''; - my $tagsubfield = $mss->{$kohafield}{tagsubfield}; - foreach my $value ( split(/\s?\|\s?/, $value, -1) ) { - next if $value eq ''; - $tag_hr->{$tagfield} //= []; - push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)]; + foreach my $fld ( @{ $mss->{$kohafield} } ) { + my $tagfield = $fld->{tagfield}; + my $tagsubfield = $fld->{tagsubfield}; + next if !$tagfield; + my @values = $params->{no_split} + ? ( $value ) + : split(/\s?\|\s?/, $value, -1); + foreach my $value ( @values ) { + next if $value eq ''; + $tag_hr->{$tagfield} //= []; + push @{$tag_hr->{$tagfield}}, [($tagsubfield, $value)]; + } } } foreach my $tag (sort keys %$tag_hr) { my @sfl = @{$tag_hr->{$tag}}; @sfl = sort { $a->[0] cmp $b->[0]; } @sfl; @sfl = map { @{$_}; } @sfl; - $record->insert_fields_ordered( - MARC::Field->new($tag, " ", " ", @sfl) - ); + # Special care for control fields: remove the subfield indication @ + # and do not insert indicators. + my @ind = $tag < 10 ? () : ( " ", " " ); + @sfl = grep { $_ ne '@' } @sfl if $tag < 10; + $record->insert_fields_ordered( MARC::Field->new($tag, @ind, @sfl) ); } return $record; } @@ -2313,7 +2197,7 @@ sub PrepHostMarcField { $marcflavour ||="MARC21"; require C4::Items; - my $hostrecord = GetMarcBiblio($hostbiblionumber); + my $hostrecord = GetMarcBiblio({ biblionumber => $hostbiblionumber }); my $item = C4::Items::GetItem($hostitemnumber); my $hostmarcfield; @@ -2417,6 +2301,7 @@ sub TransformHtmlToXml { my $prevtag = -1; my $first = 1; my $j = -1; + my $close_last_tag; for ( my $i = 0 ; $i < @$tags ; $i++ ) { if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) { @@ -2437,6 +2322,7 @@ sub TransformHtmlToXml { @$values[$i] =~ s/'/'/g; if ( ( @$tags[$i] ne $prevtag ) ) { + $close_last_tag = 0; $j++ unless ( @$tags[$i] eq "" ); my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) }; my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) }; @@ -2455,6 +2341,7 @@ sub TransformHtmlToXml { $xml .= "\n"; $xml .= "@$values[$i]\n"; $first = 0; + $close_last_tag = 1; } else { $first = 1; } @@ -2474,6 +2361,7 @@ sub TransformHtmlToXml { $xml .= "\n"; $xml .= "@$values[$i]\n"; $first = 0; + $close_last_tag = 1; } } } @@ -2493,13 +2381,14 @@ sub TransformHtmlToXml { if ($first) { $xml .= "\n"; $first = 0; + $close_last_tag = 1; } $xml .= "@$values[$i]\n"; } } $prevtag = @$tags[$i]; } - $xml .= "\n" if $xml =~ m/preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) { # warn "SETTING 100 for $auth_type"; @@ -2537,7 +2426,7 @@ sub _default_ind_to_space { =head2 TransformHtmlToMarc L<$record> = TransformHtmlToMarc(L<$cgi>) - L<$cgi> is the CGI object which containts the values for subfields + L<$cgi> is the CGI object which contains the values for subfields { 'tag_010_indicator1_531951' , 'tag_010_indicator2_531951' , @@ -2655,119 +2544,44 @@ sub TransformHtmlToMarc { =head2 TransformMarcToKoha - $result = TransformMarcToKoha( $record, $frameworkcode ) + $result = TransformMarcToKoha( $record, undef, $limit ) Extract data from a MARC bib record into a hashref representing -Koha biblio, biblioitems, and items fields. +Koha biblio, biblioitems, and items fields. If passed an undefined record will log the error and return an empty -hash_ref +hash_ref. =cut sub TransformMarcToKoha { my ( $record, $frameworkcode, $limit_table ) = @_; + # FIXME Parameter $frameworkcode is obsolete and will be removed + $limit_table //= q{}; my $result = {}; if (!defined $record) { carp('TransformMarcToKoha called with undefined record'); return $result; } - $limit_table = $limit_table || 0; - $frameworkcode = '' unless defined $frameworkcode; - my $inverted_field_map = _get_inverted_marc_field_map($frameworkcode); - - my %tables = (); - if ( defined $limit_table && $limit_table eq 'items' ) { - $tables{'items'} = 1; - } else { - $tables{'items'} = 1; - $tables{'biblio'} = 1; - $tables{'biblioitems'} = 1; - } - - # traverse through record - MARCFIELD: foreach my $field ( $record->fields() ) { - my $tag = $field->tag(); - next MARCFIELD unless exists $inverted_field_map->{$tag}; - if ( $field->is_control_field() ) { - my $kohafields = $inverted_field_map->{$tag}->{list}; - ENTRY: foreach my $entry ( @{$kohafields} ) { - my ( $subfield, $table, $column ) = @{$entry}; - next ENTRY unless exists $tables{$table}; - my $key = _disambiguate( $table, $column ); - if ( $result->{$key} ) { - unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) { - $result->{$key} .= " | " . $field->data(); - } - } else { - $result->{$key} = $field->data(); - } - } - } else { - - # deal with subfields - MARCSUBFIELD: foreach my $sf ( $field->subfields() ) { - my $code = $sf->[0]; - next MARCSUBFIELD unless exists $inverted_field_map->{$tag}->{sfs}->{$code}; - my $value = $sf->[1]; - SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$tag}->{sfs}->{$code} } ) { - my ( $table, $column ) = @{$entry}; - next SFENTRY unless exists $tables{$table}; - my $key = _disambiguate( $table, $column ); - if ( $result->{$key} ) { - unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) { - $result->{$key} .= " | " . $value; - } - } else { - $result->{$key} = $value; - } - } - } - } - } - - # modify copyrightdate to keep only the 1st year found - if ( exists $result->{'copyrightdate'} ) { - my $temp = $result->{'copyrightdate'}; - $temp =~ m/c(\d\d\d\d)/; - if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first - $result->{'copyrightdate'} = $1; - } else { # if no cYYYY, get the 1st date. - $temp =~ m/(\d\d\d\d)/; - $result->{'copyrightdate'} = $1; - } + my %tables = ( biblio => 1, biblioitems => 1, items => 1 ); + if( $limit_table eq 'items' ) { + %tables = ( items => 1 ); } - # modify publicationyear to keep only the 1st year found - if ( exists $result->{'publicationyear'} ) { - my $temp = $result->{'publicationyear'}; - if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first - $result->{'publicationyear'} = $1; - } else { # if no cYYYY, get the 1st date. - $temp =~ m/(\d\d\d\d)/; - $result->{'publicationyear'} = $1; - } - } - - return $result; -} - -sub _get_inverted_marc_field_map { - my ( $frameworkcode ) = @_; - my $field_map = {}; - my $mss = GetMarcSubfieldStructure( $frameworkcode ); - + # The next call acknowledges Default as the authoritative framework + # for Koha to MARC mappings. + my $mss = GetMarcSubfieldStructure( '', { unsafe => 1 } ); # Do not change framework foreach my $kohafield ( keys %{ $mss } ) { - next unless exists $mss->{$kohafield}; # not all columns are mapped to MARC tag & subfield - my $tag = $mss->{$kohafield}{tagfield}; - my $subfield = $mss->{$kohafield}{tagsubfield}; my ( $table, $column ) = split /[.]/, $kohafield, 2; - push @{ $field_map->{$tag}->{list} }, [ $subfield, $table, $column ]; - push @{ $field_map->{$tag}->{sfs}->{$subfield} }, [ $table, $column ]; + next unless $tables{$table}; + my $val = TransformMarcToKohaOneField( $kohafield, $record ); + next if !defined $val; + my $key = _disambiguate( $table, $column ); + $result->{$key} = $val; } - return $field_map; + return $result; } =head2 _disambiguate @@ -2799,15 +2613,6 @@ more. =cut -sub CountItemsIssued { - my ($biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?'); - $sth->execute($biblionumber); - my $row = $sth->fetchrow_hashref(); - return $row->{'issuedCount'}; -} - sub _disambiguate { my ( $table, $column ) = @_; if ( $column eq "cn_sort" or $column eq "cn_source" ) { @@ -2818,117 +2623,82 @@ sub _disambiguate { } -=head2 get_koha_field_from_marc +=head2 TransformMarcToKohaOneField - $result->{_disambiguate($table, $field)} = - get_koha_field_from_marc($table,$field,$record,$frameworkcode); + $val = TransformMarcToKohaOneField( 'biblio.title', $marc ); -Internal function to map data from the MARC record to a specific non-MARC field. -FIXME: this is meant to replace TransformMarcToKohaOneField after more testing. + Note: The authoritative Default framework is used implicitly. =cut -sub get_koha_field_from_marc { - my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_; - my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode ); - my $kohafield; - foreach my $field ( $record->field($tagfield) ) { - if ( $field->tag() < 10 ) { - if ($kohafield) { - $kohafield .= " | " . $field->data(); +sub TransformMarcToKohaOneField { + my ( $kohafield, $marc ) = @_; + + my ( @rv, $retval ); + my @mss = GetMarcSubfieldStructureFromKohaField($kohafield); + foreach my $fldhash ( @mss ) { + my $tag = $fldhash->{tagfield}; + my $sub = $fldhash->{tagsubfield}; + foreach my $fld ( $marc->field($tag) ) { + if( $sub eq '@' || $fld->is_control_field ) { + push @rv, $fld->data if $fld->data; } else { - $kohafield = $field->data(); - } - } else { - if ( $field->subfields ) { - my @subfields = $field->subfields(); - foreach my $subfieldcount ( 0 .. $#subfields ) { - if ( $subfields[$subfieldcount][0] eq $subfield ) { - if ($kohafield) { - $kohafield .= " | " . $subfields[$subfieldcount][1]; - } else { - $kohafield = $subfields[$subfieldcount][1]; - } - } - } + push @rv, grep { $_ } $fld->subfield($sub); } } } - return $kohafield; + return unless @rv; + $retval = join ' | ', uniq(@rv); + + # Additional polishing for individual kohafields + if( $kohafield =~ /copyrightdate|publicationyear/ ) { + $retval = _adjust_pubyear( $retval ); + } + + return $retval; } -=head2 TransformMarcToKohaOneField +=head2 _adjust_pubyear - $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode ) + Helper routine for TransformMarcToKohaOneField =cut -sub TransformMarcToKohaOneField { - - # FIXME ? if a field has a repeatable subfield that is used in old-db, - # only the 1st will be retrieved... - my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_; - my $res = ""; - my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode ); - foreach my $field ( $record->field($tagfield) ) { - if ( $field->tag() < 10 ) { - if ( $result->{$kohafield} ) { - $result->{$kohafield} .= " | " . $field->data(); - } else { - $result->{$kohafield} = $field->data(); - } - } else { - if ( $field->subfields ) { - my @subfields = $field->subfields(); - foreach my $subfieldcount ( 0 .. $#subfields ) { - if ( $subfields[$subfieldcount][0] eq $subfield ) { - if ( $result->{$kohafield} ) { - $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1]; - } else { - $result->{$kohafield} = $subfields[$subfieldcount][1]; - } - } - } - } - } +sub _adjust_pubyear { + my $retval = shift; + # modify return value to keep only the 1st year found + if( $retval =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first + $retval = $1; + } elsif( $retval =~ m/(\d\d\d\d)/ && $1 > 0 ) { + $retval = $1; + } elsif( $retval =~ m/ + (?\d)[-]?[.Xx?]{3} + |(?\d{2})[.Xx?]{2} + |(?\d{3})[.Xx?] + |(?\d)[-]{3}\? + |(?\d\d)[-]{2}\? + |(?\d{3})[-]\? + /xms ) { # the form 198-? occurred in Dutch ISBD rules + my $digits = $+{year}; + $retval = $digits * ( 10 ** ( 4 - length($digits) )); } - return $result; + return $retval; } +=head2 CountItemsIssued -#" + my $count = CountItemsIssued( $biblionumber ); -# -# 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 -# =head2 ModZebrafiles -# -# &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server ); -# -# =cut -# -# sub ModZebrafiles { -# -# my ( $dbh, $biblionumber, $record, $folder, $server ) = @_; -# -# my $op; -# my $zebradir = -# C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/"; -# unless ( opendir( DIR, "$zebradir" ) ) { -# warn "$zebradir not found"; -# return; -# } -# closedir DIR; -# my $filename = $zebradir . $biblionumber; -# -# if ($record) { -# open( OUTPUT, ">", $filename . ".xml" ); -# print OUTPUT $record; -# close OUTPUT; -# } -# } +=cut + +sub CountItemsIssued { + my ($biblionumber) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?'); + $sth->execute($biblionumber); + my $row = $sth->fetchrow_hashref(); + return $row->{'issuedCount'}; +} =head2 ModZebra @@ -2962,7 +2732,9 @@ sub ModZebra { ); if ( $op eq 'specialUpdate' ) { unless ($record) { - $record = GetMarcBiblio($biblionumber, 1); + $record = GetMarcBiblio({ + biblionumber => $biblionumber, + embed_items => 1 }); } my $records = [$record]; $indexer->update_index_background( [$biblionumber], [$record] ); @@ -3000,7 +2772,11 @@ sub ModZebra { =head2 EmbedItemsInMarcBiblio - EmbedItemsInMarcBiblio($marc, $biblionumber, $itemnumbers, $opac); + EmbedItemsInMarcBiblio({ + marc_record => $marc, + biblionumber => $biblionumber, + item_numbers => $itemnumbers, + opac => $opac }); Given a MARC::Record object containing a bib record, modify it to include the items attached to it as 9XX @@ -3009,14 +2785,23 @@ if $itemnumbers is defined, only specified itemnumbers are embedded. If $opac is true, then opac-relevant suppressions are included. +If opac filtering will be done, borcat should be passed to properly +override if necessary. + =cut sub EmbedItemsInMarcBiblio { - my ($marc, $biblionumber, $itemnumbers, $opac) = @_; + my ($params) = @_; + my ($marc, $biblionumber, $itemnumbers, $opac, $borcat); + $marc = $params->{marc_record}; if ( !$marc ) { carp 'EmbedItemsInMarcBiblio: No MARC record passed'; return; } + $biblionumber = $params->{biblionumber}; + $itemnumbers = $params->{item_numbers}; + $opac = $params->{opac}; + $borcat = $params->{borcat} // q{}; $itemnumbers = [] unless defined $itemnumbers; @@ -3027,20 +2812,28 @@ sub EmbedItemsInMarcBiblio { my $dbh = C4::Context->dbh; my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?"); $sth->execute($biblionumber); - my @item_fields; my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode ); - my @items; + + my @item_fields; # Array holding the actual MARC data for items to be included. + my @items; # Array holding items which are both in the list (sitenumbers) + # and on this biblionumber + + # Flag indicating if there is potential hiding. my $opachiddenitems = $opac && ( C4::Context->preference('OpacHiddenItems') !~ /^\s*$/ ); + require C4::Items; while ( my ($itemnumber) = $sth->fetchrow_array ) { next if @$itemnumbers and not grep { $_ == $itemnumber } @$itemnumbers; my $i = $opachiddenitems ? C4::Items::GetItem($itemnumber) : undef; push @items, { itemnumber => $itemnumber, item => $i }; } + my @items2pass = map { $_->{item} } @items; my @hiddenitems = $opachiddenitems - ? C4::Items::GetHiddenItemnumbers( map { $_->{item} } @items ) + ? C4::Items::GetHiddenItemnumbers({ + items => \@items2pass, + borcat => $borcat }) : (); # Convert to a hash for quick searching my %hiddenitems = map { $_ => 1 } @hiddenitems; @@ -3198,7 +2991,7 @@ sub _koha_modify_biblio { $sth->execute( $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, $biblio->{'notes'}, - $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'} + $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'} ? int($biblio->{'copyrightdate'}) : undef, $biblio->{'abstract'}, $biblio->{'biblionumber'} ) if $biblio->{'biblionumber'}; if ( $dbh->errstr || !$biblio->{'biblionumber'} ) { @@ -3359,6 +3152,8 @@ sub _koha_delete_biblio { my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?"); $sth->execute($biblionumber); + # FIXME There is a transaction in _koha_delete_biblio_metadata + # But actually all the following should be done inside a single transaction if ( my $data = $sth->fetchrow_hashref ) { # save the record in deletedbiblio @@ -3376,6 +3171,8 @@ sub _koha_delete_biblio { $bkup_sth->execute(@bind); $bkup_sth->finish; + _koha_delete_biblio_metadata( $biblionumber ); + # delete the biblio my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?"); $sth2->execute($biblionumber); @@ -3437,6 +3234,31 @@ sub _koha_delete_biblioitems { return; } +=head2 _koha_delete_biblio_metadata + + $error = _koha_delete_biblio_metadata($biblionumber); + +C<$biblionumber> - the biblionumber of the biblio metadata to be deleted + +=cut + +sub _koha_delete_biblio_metadata { + my ($biblionumber) = @_; + + my $dbh = C4::Context->dbh; + my $schema = Koha::Database->new->schema; + $schema->txn_do( + sub { + $dbh->do( q| + INSERT INTO deletedbiblio_metadata (biblionumber, format, `schema`, metadata) + SELECT biblionumber, format, `schema`, metadata FROM biblio_metadata WHERE biblionumber=? + |, undef, $biblionumber ); + $dbh->do( q|DELETE FROM biblio_metadata WHERE biblionumber=?|, + undef, $biblionumber ); + } + ); +} + =head1 UNEXPORTED FUNCTIONS =head2 ModBiblioMarc @@ -3501,17 +3323,28 @@ sub ModBiblioMarc { my $metadata = { biblionumber => $biblionumber, format => 'marcxml', - marcflavour => C4::Context->preference('marcflavour'), + schema => C4::Context->preference('marcflavour'), }; - # FIXME To replace with ->find_or_create? - if ( my $m_rs = Koha::Biblio::Metadatas->find($metadata) ) { - $m_rs->metadata( $record->as_xml_record($encoding) ); - $m_rs->store; - } else { - my $m_rs = Koha::Biblio::Metadata->new($metadata); - $m_rs->metadata( $record->as_xml_record($encoding) ); - $m_rs->store; + $record->as_usmarc; # Bug 20126/10455 This triggers field length calculation + + my $m_rs = Koha::Biblio::Metadatas->find($metadata) // + Koha::Biblio::Metadata->new($metadata); + + my $userenv = C4::Context->userenv; + if ($userenv) { + my $borrowernumber = $userenv->{number}; + my $borrowername = join ' ', @$userenv{qw(firstname surname)}; + unless ($m_rs->in_storage) { + Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorId'), $borrowernumber); + Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForCreatorName'), $borrowername); + } + Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierId'), $borrowernumber); + Koha::Util::MARC::set_marc_field($record, C4::Context->preference('MarcFieldForModifierName'), $borrowername); } + + $m_rs->metadata( $record->as_xml_record($encoding) ); + $m_rs->store; + ModZebra( $biblionumber, "specialUpdate", "biblioserver", $record ); return $biblionumber; } @@ -3536,26 +3369,6 @@ sub CountBiblioInOrders { return ($count); } -=head2 GetSubscriptionsId - - $subscriptions = &GetSubscriptionsId($biblionumber); - -This function return an array of subscriptionid with $biblionumber - -=cut - -sub GetSubscriptionsId { - my ($biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $query = "SELECT subscriptionid - FROM subscription - WHERE biblionumber=?"; - my $sth = $dbh->prepare($query); - $sth->execute($biblionumber); - my @subscriptions = $sth->fetchrow_array; - return (@subscriptions); -} - =head2 prepare_host_field $marcfield = prepare_host_field( $hostbiblioitem, $marcflavour ); @@ -3566,7 +3379,7 @@ Generate the host item entry for an analytic child entry sub prepare_host_field { my ( $hostbiblio, $marcflavour ) = @_; $marcflavour ||= C4::Context->preference('marcflavour'); - my $host = GetMarcBiblio($hostbiblio); + my $host = GetMarcBiblio({ biblionumber => $hostbiblio }); # unfortunately as_string does not 'do the right thing' # if field returns undef my %sfd; @@ -3704,17 +3517,18 @@ sub UpdateTotalIssues { my ($biblionumber, $increase, $value) = @_; my $totalissues; - my $record = GetMarcBiblio($biblionumber); + my $record = GetMarcBiblio({ biblionumber => $biblionumber }); unless ($record) { carp "UpdateTotalIssues could not get biblio record"; return; } - my $data = GetBiblioData($biblionumber); - unless ($data) { + my $biblio = Koha::Biblios->find( $biblionumber ); + unless ($biblio) { carp "UpdateTotalIssues could not get datas of biblio"; return; } - my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $data->{'frameworkcode'}); + my $biblioitem = $biblio->biblioitem; + my ($totalissuestag, $totalissuessubfield) = GetMarcFromKohaField('biblioitems.totalissues', $biblio->frameworkcode); unless ($totalissuestag) { return 1; # There is nothing to do } @@ -3722,7 +3536,7 @@ sub UpdateTotalIssues { if (defined $value) { $totalissues = $value; } else { - $totalissues = $data->{'totalissues'} + $increase; + $totalissues = $biblioitem->totalissues + $increase; } my $field = $record->field($totalissuestag); @@ -3734,7 +3548,7 @@ sub UpdateTotalIssues { $record->insert_grouped_field($field); } - return ModBiblio($record, $biblionumber, $data->{'frameworkcode'}); + return ModBiblio($record, $biblionumber, $biblio->frameworkcode); } =head2 RemoveAllNsb