package C4::Biblio;
# Copyright 2000-2002 Katipo Communications
+# Copyright 2010 BibLibre
+# Copyright 2011 Equinox Software, Inc.
#
# This file is part of Koha.
#
use strict;
use warnings;
+use Carp;
# use utf8;
use MARC::Record;
use MARC::File::USMARC;
use MARC::File::XML;
-use ZOOM;
use POSIX qw(strftime);
use C4::Koha;
use C4::Log; # logaction
use C4::ClassSource;
use C4::Charset;
-require C4::Heading;
-require C4::Serials;
+use C4::Linker;
+use C4::OAI::Sets;
use vars qw($VERSION @ISA @EXPORT);
&GetMarcControlnumber
&GetMarcNotes
+ &GetMarcISBN
+ &GetMarcISSN
&GetMarcSubjects
&GetMarcBiblio
&GetMarcAuthors
&GetMarcSeries
+ &GetMarcHosts
GetMarcUrls
&GetUsedMarcStructure
&GetXmlBiblio
&GetCOinSBiblio
+ &GetMarcPrice
+ &GetMarcQuantity
&GetAuthorisedValueDesc
&GetMarcStructure
&GetMarcFromKohaField
&GetFrameworkCode
- &GetPublisherNameFromIsbn
&TransformKohaToMarc
+ &PrepHostMarcField
&CountItemsIssued
+ &CountBiblioInOrders
+ &GetSubscriptionsId
+ &GetHolds
);
# To modify something
# To link headings in a bib record
# to authority records.
push @EXPORT, qw(
+ &BiblioAutoLink
&LinkBibHeadingsToAuthorities
);
&TransformHtmlToMarc2
&TransformHtmlToMarc
&TransformHtmlToXml
- &PrepareItemrecordDisplay
&GetNoZebraIndexes
+ prepare_host_field
);
}
eval {
- my $servers = C4::Context->config('memcached_servers');
- if ($servers) {
+ if (C4::Context->ismemcached) {
require Memoize::Memcached;
import Memoize::Memcached qw(memoize_memcached);
- my $memcached = {
- servers => [$servers],
- key_prefix => C4::Context->config('memcached_namespace') || 'koha',
- };
- memoize_memcached( 'GetMarcStructure', memcached => $memcached, expire_time => 600 ); #cache for 10 minutes
+ memoize_memcached( 'GetMarcStructure',
+ memcached => C4::Context->memcached);
}
};
my $dbh = C4::Context->dbh;
# transform the data into koha-table style data
+ SetUTF8Flag($record);
my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
( $biblionumber, $error ) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
$olddata->{'biblionumber'} = $biblionumber;
# now add the record
ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
+ # update OAI-PMH sets
+ if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
+ C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
+ }
+
logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
return ( $biblionumber, $biblioitemnumber );
}
sub ModBiblio {
my ( $record, $biblionumber, $frameworkcode ) = @_;
+ croak "No record" unless $record;
+
if ( C4::Context->preference("CataloguingLog") ) {
my $newrecord = GetMarcBiblio($biblionumber);
logaction( "CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>" . $newrecord->as_formatted );
}
- my $dbh = C4::Context->dbh;
-
- $frameworkcode = "" unless $frameworkcode;
-
- # get the items before and append them to the biblio before updating the record, atm we just have the biblio
- my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
- my $oldRecord = GetMarcBiblio($biblionumber);
-
- # delete any item fields from incoming record to avoid
- # duplication or incorrect data - use AddItem() or ModItem()
- # to change items
- foreach my $field ( $record->field($itemtag) ) {
- $record->delete_field($field);
- }
-
- # parse each item, and, for an unknown reason, re-encode each subfield
- # if you don't do that, the record will have encoding mixed
- # and the biblio will be re-encoded.
- # strange, I (Paul P.) searched more than 1 day to understand what happends
- # but could only solve the problem this way...
- my @fields = $oldRecord->field($itemtag);
- foreach my $fielditem (@fields) {
- my $field;
- foreach ( $fielditem->subfields() ) {
- if ($field) {
- $field->add_subfields( Encode::encode( 'utf-8', $_->[0] ) => Encode::encode( 'utf-8', $_->[1] ) );
- } else {
- $field = MARC::Field->new( "$itemtag", '', '', Encode::encode( 'utf-8', $_->[0] ) => Encode::encode( 'utf-8', $_->[1] ) );
+ # 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()) {
+ if (! $field->is_control_field()) {
+ if (scalar($field->subfields()) == 0 || (scalar($field->subfields()) == 1 && $field->subfield('9'))) {
+ $record->delete_field($field);
}
}
- $record->append_fields($field);
}
+ SetUTF8Flag($record);
+ my $dbh = C4::Context->dbh;
+
+ $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX
+
+ _strip_item_fields($record, $frameworkcode);
+
# update biblionumber and biblioitemnumber in MARC
# FIXME - this is assuming a 1 to 1 relationship between
# biblios and biblioitems
# modify the other koha tables
_koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
_koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
+
+ # update OAI-PMH sets
+ if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
+ C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
+ }
+
return 1;
}
+=head2 _strip_item_fields
+
+ _strip_item_fields($record, $frameworkcode)
+
+Utility routine to remove item tags from a
+MARC bib.
+
+=cut
+
+sub _strip_item_fields {
+ my $record = shift;
+ my $frameworkcode = shift;
+ # get the items before and append them to the biblio before updating the record, atm we just have the biblio
+ my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
+
+ # delete any item fields from incoming record to avoid
+ # duplication or incorrect data - use AddItem() or ModItem()
+ # to change items
+ foreach my $field ( $record->field($itemtag) ) {
+ $record->delete_field($field);
+ }
+}
+
=head2 ModBiblioframework
ModBiblioframework($biblionumber,$frameworkcode);
=head2 DelBiblio
- my $error = &DelBiblio($dbh,$biblionumber);
+ my $error = &DelBiblio($biblionumber);
Exported function (core API) for deleting a biblio in koha.
Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
return $error if $error;
# We delete attached subscriptions
- my $subscriptions = &C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
+ require C4::Serials;
+ my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber);
foreach my $subscription (@$subscriptions) {
- &C4::Serials::DelSubscription( $subscription->{subscriptionid} );
+ C4::Serials::DelSubscription( $subscription->{subscriptionid} );
+ }
+
+ # We delete any existing holds
+ require C4::Reserves;
+ my ($count, $reserves) = C4::Reserves::GetReservesFromBiblionumber($biblionumber);
+ foreach my $res ( @$reserves ) {
+ C4::Reserves::CancelReserve( $res->{'biblionumber'}, $res->{'itemnumber'}, $res->{'borrowernumber'} );
}
# Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
return;
}
+
+=head2 BiblioAutoLink
+
+ my $headings_linked = BiblioAutoLink($record, $frameworkcode)
+
+Automatically links headings in a bib record to authorities.
+
+=cut
+
+sub BiblioAutoLink {
+ my $record = shift;
+ my $frameworkcode = shift;
+ my ( $num_headings_changed, %results );
+
+ my $linker_module =
+ "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
+ eval { eval "require $linker_module"; };
+ if ($@) {
+ $linker_module = 'C4::Linker::Default';
+ eval "require $linker_module";
+ }
+ if ($@) {
+ return 0, 0;
+ }
+
+ my $linker = $linker_module->new(
+ { 'options' => C4::Context->preference("LinkerOptions") } );
+ my ( $headings_changed, undef ) =
+ LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' );
+ # By default we probably don't want to relink things when cataloging
+ return $headings_changed;
+}
+
=head2 LinkBibHeadingsToAuthorities
- my $headings_linked = LinkBibHeadingsToAuthorities($marc);
+ my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]);
Links bib headings to authority records by checking
each authority-controlled field in the C<MARC::Record>
and setting the linking subfield $9 to the ID of that
authority record.
-If no matching authority exists, or if multiple
-authorities match, no $9 will be added, and any
-existing one inthe field will be deleted.
+If $allowrelink is false, existing authids will never be
+replaced, regardless of the values of LinkerKeepStale and
+LinkerRelink.
Returns the number of heading links changed in the
MARC record.
=cut
sub LinkBibHeadingsToAuthorities {
- my $bib = shift;
+ my $linker = shift;
+ my $bib = shift;
+ my $frameworkcode = shift;
+ my $allowrelink = shift;
+ my %results;
+ require C4::Heading;
+ require C4::AuthoritiesMarc;
+ $allowrelink = 1 unless defined $allowrelink;
my $num_headings_changed = 0;
foreach my $field ( $bib->fields() ) {
- my $heading = C4::Heading->new_from_bib_field($field);
+ my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode );
next unless defined $heading;
# check existing $9
my $current_link = $field->subfield('9');
- # look for matching authorities
- my $authorities = $heading->authorities();
+ if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) )
+ {
+ $results{'linked'}->{ $heading->display_form() }++;
+ next;
+ }
- # want only one exact match
- if ( $#{$authorities} == 0 ) {
- my $authority = MARC::Record->new_from_usmarc( $authorities->[0] );
- my $authid = $authority->field('001')->data();
- next if defined $current_link and $current_link eq $authid;
+ my ( $authid, $fuzzy ) = $linker->get_link($heading);
+ if ($authid) {
+ $results{ $fuzzy ? 'fuzzy' : 'linked' }
+ ->{ $heading->display_form() }++;
+ next if defined $current_link and $current_link == $authid;
$field->delete_subfield( code => '9' ) if defined $current_link;
$field->add_subfields( '9', $authid );
$num_headings_changed++;
- } else {
- if ( defined $current_link ) {
+ }
+ else {
+ if ( defined $current_link
+ && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) )
+ {
+ $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' );
+ }
+ 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
+# automatically for UNIMARC (by not transcoding)
+# FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record
+# 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 ) );
+ }
+
+ # 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() }++;
+ }
+ elsif ( defined $current_link ) {
$field->delete_subfield( code => '9' );
$num_headings_changed++;
+ $results{'unlinked'}->{ $heading->display_form() }++;
+ }
+ else {
+ $results{'unlinked'}->{ $heading->display_form() }++;
}
}
}
- return $num_headings_changed;
+ return $num_headings_changed, \%results;
}
=head2 GetRecordValue
sub GetISBDView {
my ( $biblionumber, $template ) = @_;
- my $record = GetMarcBiblio($biblionumber);
+ my $record = GetMarcBiblio($biblionumber, 1);
+ return undef unless defined $record;
my $itemtype = &GetFrameworkCode($biblionumber);
my ( $holdingbrtagf, $holdingbrtagsubf ) = &GetMarcFromKohaField( "items.holdingbranch", $itemtype );
my $tagslib = &GetMarcStructure( 1, $itemtype );
- my $ISBD = C4::Context->preference('ISBD');
+ my $ISBD = C4::Context->preference('isbd');
my $bloc = $ISBD;
my $res;
my $blocres;
sub GetMarcFromKohaField {
my ( $kohafield, $frameworkcode ) = @_;
- return 0, 0 unless $kohafield and defined $frameworkcode;
+ return (0, undef) unless $kohafield and defined $frameworkcode;
my $relations = C4::Context->marcfromkohafield;
- return ( $relations->{$frameworkcode}->{$kohafield}->[0], $relations->{$frameworkcode}->{$kohafield}->[1] );
+ if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) {
+ return @$mf;
+ }
+ return (0, undef);
}
=head2 GetMarcBiblio
- my $record = GetMarcBiblio($biblionumber);
+ my $record = GetMarcBiblio($biblionumber, [$embeditems]);
Returns MARC::Record representing bib identified by
C<$biblionumber>. If no bib exists, returns undef.
-The MARC record contains both biblio & item data.
+C<$embeditems>. If set to true, items data are included.
+The MARC record contains biblio data, and items data if $embeditems is set to true.
=cut
sub GetMarcBiblio {
my $biblionumber = shift;
+ my $embeditems = shift || 0;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
$sth->execute($biblionumber);
if ($marcxml) {
$record = eval { MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour') ) };
if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; }
+ return unless $record;
+
+ C4::Biblio::_koha_marc_update_bib_ids($record, '', $biblionumber, $biblionumber);
+ C4::Biblio::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems);
- # $record = MARC::Record::new_from_usmarc( $marc) if $marc;
return $record;
} else {
return undef;
=head2 GetCOinSBiblio
- my $coins = GetCOinSBiblio($biblionumber);
+ my $coins = GetCOinSBiblio($record);
-Returns the COinS(a span) which can be included in a biblio record
+Returns the COinS (a span) which can be included in a biblio record
=cut
sub GetCOinSBiblio {
- my ($biblionumber) = @_;
- my $record = GetMarcBiblio($biblionumber);
+ my $record = shift;
# get the coin format
if ( ! $record ) {
- # can't get a valid MARC::Record object, bail out at this point
- warn "We called GetMarcBiblio with a biblionumber that doesn't exist biblionumber=$biblionumber";
return;
}
my $pos7 = substr $record->leader(), 7, 1;
my $isbn = '';
my $issn = '';
my $publisher = '';
-
- if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
- my $fmts6;
- my $fmts7;
- %$fmts6 = (
- 'a' => 'book',
- 'b' => 'manuscript',
- 'c' => 'book',
- 'd' => 'manuscript',
- 'e' => 'map',
- 'f' => 'map',
- 'g' => 'film',
- 'i' => 'audioRecording',
- 'j' => 'audioRecording',
- 'k' => 'artwork',
- 'l' => 'document',
- 'm' => 'computerProgram',
- 'r' => 'document',
-
- );
- %$fmts7 = (
- 'a' => 'journalArticle',
- 's' => 'journal',
- );
-
- $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
-
- if ( $genre eq 'book' ) {
+ my $pages = '';
+ my $titletype = 'b';
+
+ # For the purposes of generating COinS metadata, LDR/06-07 can be
+ # considered the same for UNIMARC and MARC21
+ my $fmts6;
+ my $fmts7;
+ %$fmts6 = (
+ 'a' => 'book',
+ 'b' => 'manuscript',
+ 'c' => 'book',
+ 'd' => 'manuscript',
+ 'e' => 'map',
+ 'f' => 'map',
+ 'g' => 'film',
+ 'i' => 'audioRecording',
+ 'j' => 'audioRecording',
+ 'k' => 'artwork',
+ 'l' => 'document',
+ 'm' => 'computerProgram',
+ 'o' => 'document',
+ 'r' => 'document',
+ );
+ %$fmts7 = (
+ 'a' => 'journalArticle',
+ 's' => 'journal',
+ );
+
+ $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book';
+
+ if ( $genre eq 'book' ) {
$genre = $fmts7->{$pos7} if $fmts7->{$pos7};
- }
+ }
- ##### We must transform mtx to a valable mtx and document type ####
- if ( $genre eq 'book' ) {
+ ##### We must transform mtx to a valable mtx and document type ####
+ if ( $genre eq 'book' ) {
$mtx = 'book';
- } elsif ( $genre eq 'journal' ) {
+ } elsif ( $genre eq 'journal' ) {
$mtx = 'journal';
- } elsif ( $genre eq 'journalArticle' ) {
+ $titletype = 'j';
+ } elsif ( $genre eq 'journalArticle' ) {
$mtx = 'journal';
$genre = 'article';
- } else {
+ $titletype = 'a';
+ } else {
$mtx = 'dc';
- }
+ }
+
+ $genre = ( $mtx eq 'dc' ) ? "&rft.type=$genre" : "&rft.genre=$genre";
- $genre = ( $mtx eq 'dc' ) ? "&rft.type=$genre" : "&rft.genre=$genre";
+ if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
# Setting datas
- $aulast = $record->subfield( '700', 'a' );
- $aufirst = $record->subfield( '700', 'b' );
+ $aulast = $record->subfield( '700', 'a' ) || '';
+ $aufirst = $record->subfield( '700', 'b' ) || '';
$oauthors = "&rft.au=$aufirst $aulast";
# others authors
( $mtx eq 'dc' )
? "&rft.title=" . $record->subfield( '200', 'a' )
: "&rft.title=" . $record->subfield( '200', 'a' ) . "&rft.btitle=" . $record->subfield( '200', 'a' );
- $pubyear = $record->subfield( '210', 'd' );
- $publisher = $record->subfield( '210', 'c' );
- $isbn = $record->subfield( '010', 'a' );
- $issn = $record->subfield( '011', 'a' );
+ $pubyear = $record->subfield( '210', 'd' ) || '';
+ $publisher = $record->subfield( '210', 'c' ) || '';
+ $isbn = $record->subfield( '010', 'a' ) || '';
+ $issn = $record->subfield( '011', 'a' ) || '';
} else {
# MARC21 need some improve
- my $fmts;
- $mtx = 'book';
- $genre = "&rft.genre=book";
# Setting datas
if ( $record->field('100') ) {
$oauthors .= "&rft.au=$au";
}
}
- $title = "&rft.btitle=" . $record->subfield( '245', 'a' );
+ $title = "&rft." . $titletype . "title=" . $record->subfield( '245', 'a' );
$subtitle = $record->subfield( '245', 'b' ) || '';
$title .= $subtitle;
- $pubyear = $record->subfield( '260', 'c' ) || '';
- $publisher = $record->subfield( '260', 'b' ) || '';
- $isbn = $record->subfield( '020', 'a' ) || '';
- $issn = $record->subfield( '022', 'a' ) || '';
+ if ($titletype eq 'a') {
+ $pubyear = $record->field('008') || '';
+ $pubyear = substr($pubyear->data(), 7, 4) if $pubyear;
+ $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')));
+ } else {
+ $title .= "&rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
+ }
+ foreach my $rel ($record->subfield( '773', 'g' )) {
+ if ($pages) {
+ $pages .= ', ';
+ }
+ $pages .= $rel;
+ }
+ } else {
+ $pubyear = $record->subfield( '260', 'c' ) || '';
+ $publisher = $record->subfield( '260', 'b' ) || '';
+ $isbn = $record->subfield( '020', 'a' ) || '';
+ $issn = $record->subfield( '022', 'a' ) || '';
+ }
}
my $coins_value =
-"ctx_ver=Z39.88-2004&rft_val_fmt=info%3Aofi%2Ffmt%3Akev%3Amtx%3A$mtx$genre$title&rft.isbn=$isbn&rft.issn=$issn&rft.aulast=$aulast&rft.aufirst=$aufirst$oauthors&rft.pub=$publisher&rft.date=$pubyear";
+"ctx_ver=Z39.88-2004&rft_val_fmt=info%3Aofi%2Ffmt%3Akev%3Amtx%3A$mtx$genre$title&rft.isbn=$isbn&rft.issn=$issn&rft.aulast=$aulast&rft.aufirst=$aufirst$oauthors&rft.pub=$publisher&rft.date=$pubyear&rft.pages=$pages";
$coins_value =~ s/(\ |&[^a])/\+/g;
$coins_value =~ s/\"/\"\;/g;
return $coins_value;
}
+
+=head2 GetMarcPrice
+
+return the prices in accordance with the Marc format.
+=cut
+
+sub GetMarcPrice {
+ my ( $record, $marcflavour ) = @_;
+ my @listtags;
+ my $subfield;
+
+ if ( $marcflavour eq "MARC21" ) {
+ @listtags = ('345', '020');
+ $subfield="c";
+ } elsif ( $marcflavour eq "UNIMARC" ) {
+ @listtags = ('345', '010');
+ $subfield="d";
+ } else {
+ return;
+ }
+
+ for my $field ( $record->field(@listtags) ) {
+ for my $subfield_value ($field->subfield($subfield)){
+ #check value
+ return $subfield_value if ($subfield_value);
+ }
+ }
+ return 0; # no price found
+}
+
+=head2 GetMarcQuantity
+
+return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
+Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
+
+=cut
+
+sub GetMarcQuantity {
+ my ( $record, $marcflavour ) = @_;
+ my @listtags;
+ my $subfield;
+
+ if ( $marcflavour eq "MARC21" ) {
+ return 0
+ } elsif ( $marcflavour eq "UNIMARC" ) {
+ @listtags = ('969');
+ $subfield="a";
+ } else {
+ return;
+ }
+
+ for my $field ( $record->field(@listtags) ) {
+ for my $subfield_value ($field->subfield($subfield)){
+ #check value
+ if ($subfield_value) {
+ # in France, the cents separator is the , but sometimes, ppl use a .
+ # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
+ $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
+ return $subfield_value;
+ }
+ }
+ }
+ return 0; # no price found
+}
+
+
=head2 GetAuthorisedValueDesc
my $subfieldvalue =get_authorised_value_desc(
sub GetMarcControlnumber {
my ( $record, $marcflavour ) = @_;
my $controlnumber = "";
- # Control number or Record identifier are the same field in MARC21 and UNIMARC
+ # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
# Keep $marcflavour for possible later use
- if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC") {
+ if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") {
my $controlnumberField = $record->field('001');
if ($controlnumberField) {
$controlnumber = $controlnumberField->data();
return $controlnumber;
}
+=head2 GetMarcISBN
+
+ $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
+
+Get all ISBNs from the MARC record and returns them in an array.
+ISBNs stored in different fields depending on MARC flavour
+
+=cut
+
+sub GetMarcISBN {
+ my ( $record, $marcflavour ) = @_;
+ my $scope;
+ if ( $marcflavour eq "UNIMARC" ) {
+ $scope = '010';
+ } else { # assume marc21 if not unimarc
+ $scope = '020';
+ }
+ my @marcisbns;
+ my $isbn = "";
+ my $tag = "";
+ my $marcisbn;
+ foreach my $field ( $record->field($scope) ) {
+ my $value = $field->as_string();
+ if ( $isbn ne "" ) {
+ $marcisbn = { marcisbn => $isbn, };
+ push @marcisbns, $marcisbn;
+ $isbn = $value;
+ }
+ if ( $isbn ne $value ) {
+ $isbn = $isbn . " " . $value;
+ }
+ }
+
+ if ($isbn) {
+ $marcisbn = { marcisbn => $isbn };
+ push @marcisbns, $marcisbn; #load last tag into array
+ }
+ return \@marcisbns;
+} # end GetMarcISBN
+
+
+=head2 GetMarcISSN
+
+ $marcissnsarray = GetMarcISSN( $record, $marcflavour );
+
+Get all valid ISSNs from the MARC record and returns them in an array.
+ISSNs are stored in different fields depending on MARC flavour
+
+=cut
+
+sub GetMarcISSN {
+ my ( $record, $marcflavour ) = @_;
+ my $scope;
+ if ( $marcflavour eq "UNIMARC" ) {
+ $scope = '011';
+ }
+ else { # assume MARC21 or NORMARC
+ $scope = '022';
+ }
+ my @marcissns;
+ foreach my $field ( $record->field($scope) ) {
+ push @marcissns, $field->subfield( 'a' );
+ }
+ return \@marcissns;
+} # end GetMarcISSN
+
=head2 GetMarcNotes
$marcnotesarray = GetMarcNotes( $record, $marcflavour );
Get all notes from the MARC record and returns them in an array.
-The note are stored in differents places depending on MARC flavour
+The note are stored in different fields depending on MARC flavour
=cut
sub GetMarcNotes {
my ( $record, $marcflavour ) = @_;
my $scope;
- if ( $marcflavour eq "MARC21" ) {
- $scope = '5..';
- } else { # assume unimarc if not marc21
+ if ( $marcflavour eq "UNIMARC" ) {
$scope = '3..';
+ } else { # assume marc21 if not unimarc
+ $scope = '5..';
}
my @marcnotes;
my $note = "";
$marcsubjcts = GetMarcSubjects($record,$marcflavour);
Get all subjects from the MARC record and returns them in an array.
-The subjects are stored in differents places depending on MARC flavour
+The subjects are stored in different fields depending on MARC flavour
=cut
sub GetMarcSubjects {
my ( $record, $marcflavour ) = @_;
my ( $mintag, $maxtag );
- if ( $marcflavour eq "MARC21" ) {
- $mintag = "600";
- $maxtag = "699";
- } else { # assume unimarc if not marc21
+ if ( $marcflavour eq "UNIMARC" ) {
$mintag = "600";
$maxtag = "611";
+ } else { # assume marc21 if not unimarc
+ $mintag = "600";
+ $maxtag = "699";
}
my @marcsubjects;
my $subfield = "";
my $marcsubject;
+ my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
+
foreach my $field ( $record->field('6..') ) {
next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
my @subfields_loop;
my $value = $subject_subfield->[1];
my $linkvalue = $value;
$linkvalue =~ s/(\(|\))//g;
- my $operator = " and " unless $counter == 0;
+ 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' => 'su', link => $linkvalue, operator => $operator };
+ push @link_loop, { 'limit' => $subject_limit, link => $linkvalue, operator => $operator };
+ }
+ my $separator;
+ if ( $counter != 0 ) {
+ $separator = C4::Context->preference('authoritysep');
}
- my $separator = C4::Context->preference("authoritysep") unless $counter == 0;
# ignore $9
my @this_link_loop = @link_loop;
authors = GetMarcAuthors($record,$marcflavour);
Get all authors from the MARC record and returns them in an array.
-The authors are stored in differents places depending on MARC flavour
+The authors are stored in different fields depending on MARC flavour
=cut
# tagslib useful for UNIMARC author reponsabilities
my $tagslib =
&GetMarcStructure( 1, '' ); # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct.
- if ( $marcflavour eq "MARC21" ) {
- $mintag = "700";
- $maxtag = "720";
- } elsif ( $marcflavour eq "UNIMARC" ) { # assume unimarc if not marc21
+ if ( $marcflavour eq "UNIMARC" ) {
$mintag = "700";
$maxtag = "712";
+ } elsif ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) { # assume marc21 or normarc if not unimarc
+ $mintag = "700";
+ $maxtag = "720";
} else {
return;
}
my $value = $authors_subfield->[1];
my $linkvalue = $value;
$linkvalue =~ s/(\(|\))//g;
- my $operator = " and " unless $count_auth == 0;
+ 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) {
$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 = C4::Context->preference("authoritysep") unless $count_auth == 0;
- push @subfields_loop, { code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $authors_subfield->[0] eq '9' );
+ my $separator;
+ if ( $count_auth != 0 ) {
+ $separator = C4::Context->preference('authoritysep');
+ }
+ push @subfields_loop,
+ { tag => $field->tag(),
+ code => $subfieldcode,
+ value => $value,
+ link_loop => \@this_link_loop,
+ separator => $separator
+ }
+ unless ( $authors_subfield->[0] eq '9' );
$count_auth++;
}
push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
$marcseriesarray = GetMarcSeries($record,$marcflavour);
Get all series from the MARC record and returns them in an array.
-The series are stored in differents places depending on MARC flavour
+The series are stored in different fields depending on MARC flavour
=cut
sub GetMarcSeries {
my ( $record, $marcflavour ) = @_;
my ( $mintag, $maxtag );
- if ( $marcflavour eq "MARC21" ) {
- $mintag = "440";
- $maxtag = "490";
- } else { # assume unimarc if not marc21
+ if ( $marcflavour eq "UNIMARC" ) {
$mintag = "600";
$maxtag = "619";
+ } else { # assume marc21 if not unimarc
+ $mintag = "440";
+ $maxtag = "490";
}
my @marcseries;
my $value = $series_subfield->[1];
my $linkvalue = $value;
$linkvalue =~ s/(\(|\))//g;
- my $operator = " and " unless $counter == 0;
- push @link_loop, { link => $linkvalue, operator => $operator };
- my $separator = C4::Context->preference("authoritysep") unless $counter == 0;
+ 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');
+ }
if ($volume_number) {
push @subfields_loop, { volumenum => $value };
} else {
- push @subfields_loop, { code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number };
+ if ( $series_subfield->[0] ne '9' ) {
+ push @subfields_loop, {
+ code => $code,
+ value => $value,
+ link_loop => \@link_loop,
+ separator => $separator,
+ volumenum => $volume_number,
+ };
+ }
}
$counter++;
}
return $marcseriessarray;
} #end getMARCseriess
+=head2 GetMarcHosts
+
+ $marchostsarray = GetMarcHosts($record,$marcflavour);
+
+Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
+
+=cut
+
+sub GetMarcHosts {
+ my ( $record, $marcflavour ) = @_;
+ my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
+ $marcflavour ||="MARC21";
+ if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
+ $tag = "773";
+ $title_subf = "t";
+ $bibnumber_subf ="0";
+ $itemnumber_subf='9';
+ }
+ elsif ($marcflavour eq "UNIMARC") {
+ $tag = "461";
+ $title_subf = "t";
+ $bibnumber_subf ="0";
+ $itemnumber_subf='9';
+ };
+
+ my @marchosts;
+
+ foreach my $field ( $record->field($tag)) {
+
+ my @fields_loop;
+
+ my $hostbiblionumber = $field->subfield("$bibnumber_subf");
+ my $hosttitle = $field->subfield($title_subf);
+ my $hostitemnumber=$field->subfield($itemnumber_subf);
+ push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
+ push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
+
+ }
+ my $marchostsarray = \@marchosts;
+ return $marchostsarray;
+}
+
=head2 GetFrameworkCode
$frameworkcode = GetFrameworkCode( $biblionumber )
return $frameworkcode;
}
-=head2 GetPublisherNameFromIsbn
-
- $name = GetPublishercodeFromIsbn($isbn);
- if(defined $name){
- ...
- }
-
-=cut
-
-sub GetPublisherNameFromIsbn($) {
- my $isbn = shift;
- $isbn =~ s/[- _]//g;
- $isbn =~ s/^0*//;
- my @codes = ( split '-', DisplayISBN($isbn) );
- my $code = $codes[0] . $codes[1] . $codes[2];
- my $dbh = C4::Context->dbh;
- my $query = qq{
- SELECT distinct publishercode
- FROM biblioitems
- WHERE isbn LIKE ?
- AND publishercode IS NOT NULL
- LIMIT 1
- };
- my $sth = $dbh->prepare($query);
- $sth->execute("$code%");
- my $name = $sth->fetchrow;
- return $name if length $name;
- return undef;
-}
-
=head2 TransformKohaToMarc
$record = TransformKohaToMarc( $hash )
This function builds partial MARC::Record from a hash
Hash entries can be from biblio or biblioitems.
-This function is called in acquisition module, to create a basic catalogue entry from user entry
+This function is called in acquisition module, to create a basic catalogue
+entry from user entry
=cut
+
sub TransformKohaToMarc {
- my ($hash) = @_;
- my $sth = C4::Context->dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" );
+ my $hash = shift;
my $record = MARC::Record->new();
SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
- foreach ( keys %{$hash} ) {
- &TransformKohaToMarcOneField( $sth, $record, $_, $hash->{$_}, '' );
+ my $db_to_marc = C4::Context->marcfromkohafield;
+ while ( my ($name, $value) = each %$hash ) {
+ next unless my $dtm = $db_to_marc->{''}->{$name};
+ my ($tag, $letter) = @$dtm;
+ foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
+ if ( my $field = $record->field($tag) ) {
+ $field->add_subfields( $letter => $value );
+ }
+ else {
+ $record->insert_fields_ordered( MARC::Field->new(
+ $tag, " ", " ", $letter => $value ) );
+ }
+ }
+
}
return $record;
}
-=head2 TransformKohaToMarcOneField
+=head2 PrepHostMarcField
- $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
+ $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
-=cut
+This function returns a host field populated with data from the host record, the field can then be added to an analytical record
-sub TransformKohaToMarcOneField {
- my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
- $frameworkcode = '' unless $frameworkcode;
- my $tagfield;
- my $tagsubfield;
+=cut
- if ( !defined $sth ) {
- my $dbh = C4::Context->dbh;
- $sth = $dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" );
- }
- $sth->execute( $frameworkcode, $kohafieldname );
- if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
- my $tag = $record->field($tagfield);
- if ($tag) {
- $tag->update( $tagsubfield => $value );
- $record->delete_field($tag);
- $record->insert_fields_ordered($tag);
+sub PrepHostMarcField {
+ my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
+ $marcflavour ||="MARC21";
+
+ require C4::Items;
+ my $hostrecord = GetMarcBiblio($hostbiblionumber);
+ my $item = C4::Items::GetItem($hostitemnumber);
+
+ my $hostmarcfield;
+ if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
+
+ #main entry
+ my $mainentry;
+ if ($hostrecord->subfield('100','a')){
+ $mainentry = $hostrecord->subfield('100','a');
+ } elsif ($hostrecord->subfield('110','a')){
+ $mainentry = $hostrecord->subfield('110','a');
} else {
- $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
+ $mainentry = $hostrecord->subfield('111','a');
}
- }
- return $record;
+
+ # qualification info
+ my $qualinfo;
+ if (my $field260 = $hostrecord->field('260')){
+ $qualinfo = $field260->as_string( 'abc' );
+ }
+
+
+ #other fields
+ my $ed = $hostrecord->subfield('250','a');
+ my $barcode = $item->{'barcode'};
+ my $title = $hostrecord->subfield('245','a');
+
+ # record control number, 001 with 003 and prefix
+ my $recctrlno;
+ if ($hostrecord->field('001')){
+ $recctrlno = $hostrecord->field('001')->data();
+ if ($hostrecord->field('003')){
+ $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
+ }
+ }
+
+ # issn/isbn
+ my $issn = $hostrecord->subfield('022','a');
+ my $isbn = $hostrecord->subfield('020','a');
+
+
+ $hostmarcfield = MARC::Field->new(
+ 773, '0', '',
+ '0' => $hostbiblionumber,
+ '9' => $hostitemnumber,
+ 'a' => $mainentry,
+ 'b' => $ed,
+ 'd' => $qualinfo,
+ 'o' => $barcode,
+ 't' => $title,
+ 'w' => $recctrlno,
+ 'x' => $issn,
+ 'z' => $isbn
+ );
+ } elsif ($marcflavour eq "UNIMARC") {
+ $hostmarcfield = MARC::Field->new(
+ 461, '', '',
+ '0' => $hostbiblionumber,
+ 't' => $hostrecord->subfield('200','a'),
+ '9' => $hostitemnumber
+ );
+ };
+
+ return $hostmarcfield;
}
=head2 TransformHtmlToXml
}
$prevtag = @$tags[$i];
}
- $xml .= "</datafield>\n" if @$tags > 0;
+ $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
# warn "SETTING 100 for $auth_type";
=head2 TransformHtmlToMarc
- L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
- L<$params> is a ref to an array as below:
+ L<$record> = TransformHtmlToMarc(L<$cgi>)
+ L<$cgi> is the CGI object which containts the values for subfields
{
'tag_010_indicator1_531951' ,
'tag_010_indicator2_531951' ,
'tag_200_code_f_873510_110730' ,
'tag_200_subfield_f_873510_110730' ,
}
- L<$cgi> is the CGI object which containts the value.
L<$record> is the MARC::Record object.
=cut
sub TransformHtmlToMarc {
- my $params = shift;
my $cgi = shift;
+ my @params = $cgi->param();
+
# explicitly turn on the UTF-8 flag for all
# 'tag_' parameters to avoid incorrect character
# conversion later on
my $record = MARC::Record->new();
my $i = 0;
my @fields;
- while ( $params->[$i] ) { # browse all CGI params
- my $param = $params->[$i];
+#FIXME This code assumes that the CGI params will be in the same order as the fields in the template; this is no absolute guarantee!
+ while ( $params[$i] ) { # browse all CGI params
+ my $param = $params[$i];
my $newfield = 0;
# if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
my $tag = $1;
my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
- my $ind2 = _default_ind_to_space( substr( $cgi->param( $params->[ $i + 1 ] ), 0, 1 ) );
+ my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
$newfield = 0;
my $j = $i + 2;
if ( $tag < 10 ) { # no code for theses fields
# in MARC editor, 000 contains the leader.
if ( $tag eq '000' ) {
- $record->leader( $cgi->param( $params->[ $j + 1 ] ) ) if length( $cgi->param( $params->[ $j + 1 ] ) ) == 24;
-
+ # Force a fake leader even if not provided to avoid crashing
+ # during decoding MARC record containing UTF-8 characters
+ $record->leader(
+ length( $cgi->param($params[$j+1]) ) == 24
+ ? $cgi->param( $params[ $j + 1 ] )
+ : ' nam a22 4500'
+ )
+ ;
# between 001 and 009 (included)
- } elsif ( $cgi->param( $params->[ $j + 1 ] ) ne '' ) {
- $newfield = MARC::Field->new( $tag, $cgi->param( $params->[ $j + 1 ] ), );
+ } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
+ $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
}
# > 009, deal with subfields
} else {
- while ( defined $params->[$j] && $params->[$j] =~ /_code_/ ) { # browse all it's subfield
- my $inner_param = $params->[$j];
- if ($newfield) {
- if ( $cgi->param( $params->[ $j + 1 ] ) ne '' ) { # only if there is a value (code => value)
- $newfield->add_subfields( $cgi->param($inner_param) => $cgi->param( $params->[ $j + 1 ] ) );
- }
- } else {
- if ( $cgi->param( $params->[ $j + 1 ] ) ne '' ) { # creating only if there is a value (code => value)
- $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($inner_param) => $cgi->param( $params->[ $j + 1 ] ), );
- }
+ # browse subfields for this tag (reason for _code_ match)
+ while(defined $params[$j] && $params[$j] =~ /_code_/) {
+ last unless defined $params[$j+1];
+ #if next param ne subfield, then it was probably empty
+ #try next param by incrementing j
+ if($params[$j+1]!~/_subfield_/) {$j++; next; }
+ my $fval= $cgi->param($params[$j+1]);
+ #check if subfield value not empty and field exists
+ if($fval ne '' && $newfield) {
+ $newfield->add_subfields( $cgi->param($params[$j]) => $fval);
+ }
+ elsif($fval ne '') {
+ $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($params[$j]) => $fval );
}
$j += 2;
- }
+ } #end-of-while
+ $i= $j-1; #update i for outer loop accordingly
}
push @fields, $newfield if ($newfield);
}
return $result;
}
-=head1 OTHER FUNCTIONS
-
-
-=head2 PrepareItemrecordDisplay
-
- PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber,$frameworkcode);
-
-Returns a hash with all the fields for Display a given item data in a template
-
-The $frameworkcode returns the item for the given frameworkcode, ONLY if bibnum is not provided
-
-=cut
-
-sub PrepareItemrecordDisplay {
-
- my ( $bibnum, $itemnum, $defaultvalues, $frameworkcode ) = @_;
-
- my $dbh = C4::Context->dbh;
- $frameworkcode = &GetFrameworkCode($bibnum) if $bibnum;
- my ( $itemtagfield, $itemtagsubfield ) = &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
- my $tagslib = &GetMarcStructure( 1, $frameworkcode );
-
- # return nothing if we don't have found an existing framework.
- return "" unless $tagslib;
- my $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum ) if ($itemnum);
- my @loop_data;
- my $authorised_values_sth = $dbh->prepare( "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib" );
- foreach my $tag ( sort keys %{$tagslib} ) {
- my $previous_tag = '';
- if ( $tag ne '' ) {
-
- # loop through each subfield
- my $cntsubf;
- foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
- next if ( subfield_is_koha_internal_p($subfield) );
- next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
- my %subfield_data;
- $subfield_data{tag} = $tag;
- $subfield_data{subfield} = $subfield;
- $subfield_data{countsubfield} = $cntsubf++;
- $subfield_data{kohafield} = $tagslib->{$tag}->{$subfield}->{'kohafield'};
-
- # $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
- $subfield_data{marc_lib} = $tagslib->{$tag}->{$subfield}->{lib};
- $subfield_data{mandatory} = $tagslib->{$tag}->{$subfield}->{mandatory};
- $subfield_data{repeatable} = $tagslib->{$tag}->{$subfield}->{repeatable};
- $subfield_data{hidden} = "display:none"
- if $tagslib->{$tag}->{$subfield}->{hidden};
- my ( $x, $defaultvalue );
- if ($itemrecord) {
- ( $x, $defaultvalue ) = _find_value( $tag, $subfield, $itemrecord );
- }
- $defaultvalue = $tagslib->{$tag}->{$subfield}->{defaultvalue} unless $defaultvalue;
- if ( !defined $defaultvalue ) {
- $defaultvalue = q||;
- }
- $defaultvalue =~ s/"/"/g;
-
- # search for itemcallnumber if applicable
- if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
- && C4::Context->preference('itemcallnumber') ) {
- my $CNtag = substr( C4::Context->preference('itemcallnumber'), 0, 3 );
- my $CNsubfield = substr( C4::Context->preference('itemcallnumber'), 3, 1 );
- my $temp = $itemrecord->field($CNtag) if ($itemrecord);
- if ($temp) {
- $defaultvalue = $temp->subfield($CNsubfield);
- }
- }
- if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
- && $defaultvalues
- && $defaultvalues->{'callnumber'} ) {
- my $temp = $itemrecord->field($subfield) if ($itemrecord);
- unless ($temp) {
- $defaultvalue = $defaultvalues->{'callnumber'} if $defaultvalues;
- }
- }
- if ( ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.holdingbranch' || $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.homebranch' )
- && $defaultvalues
- && $defaultvalues->{'branchcode'} ) {
- my $temp = $itemrecord->field($subfield) if ($itemrecord);
- unless ($temp) {
- $defaultvalue = $defaultvalues->{branchcode} if $defaultvalues;
- }
- }
- if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
- my @authorised_values;
- my %authorised_lib;
-
- # builds list, depending on authorised value...
- #---- branch
- if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
- if ( ( C4::Context->preference("IndependantBranches") )
- && ( C4::Context->userenv->{flags} % 2 != 1 ) ) {
- my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname" );
- $sth->execute( C4::Context->userenv->{branch} );
- push @authorised_values, ""
- unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
- while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
- push @authorised_values, $branchcode;
- $authorised_lib{$branchcode} = $branchname;
- }
- } else {
- my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches ORDER BY branchname" );
- $sth->execute;
- push @authorised_values, ""
- unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
- while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
- push @authorised_values, $branchcode;
- $authorised_lib{$branchcode} = $branchname;
- }
- }
-
- #----- itemtypes
- } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes" ) {
- my $sth = $dbh->prepare( "SELECT itemtype,description FROM itemtypes ORDER BY description" );
- $sth->execute;
- push @authorised_values, ""
- unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
- while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
- push @authorised_values, $itemtype;
- $authorised_lib{$itemtype} = $description;
- }
- #---- class_sources
- } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "cn_source" ) {
- push @authorised_values, "" unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
-
- my $class_sources = GetClassSources();
- my $default_source = C4::Context->preference("DefaultClassificationSource");
-
- foreach my $class_source (sort keys %$class_sources) {
- next unless $class_sources->{$class_source}->{'used'} or
- ($class_source eq $default_source);
- push @authorised_values, $class_source;
- $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
- }
-
- #---- "true" authorised value
- } else {
- $authorised_values_sth->execute( $tagslib->{$tag}->{$subfield}->{authorised_value} );
- push @authorised_values, ""
- unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
- while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
- push @authorised_values, $value;
- $authorised_lib{$value} = $lib;
- }
- }
- $subfield_data{marc_value} = CGI::scrolling_list(
- -name => 'field_value',
- -values => \@authorised_values,
- -default => "$defaultvalue",
- -labels => \%authorised_lib,
- -size => 1,
- -tabindex => '',
- -multiple => 0,
- );
- } else {
- $subfield_data{marc_value} = "<input type=\"text\" name=\"field_value\" value=\"$defaultvalue\" size=\"50\" maxlength=\"255\" />";
- }
- push( @loop_data, \%subfield_data );
- }
- }
- }
- my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
- if ( $itemrecord && $itemrecord->field($itemtagfield) );
- return {
- 'itemtagfield' => $itemtagfield,
- 'itemtagsubfield' => $itemtagsubfield,
- 'itemnumber' => $itemnumber,
- 'iteminformation' => \@loop_data
- };
-}
#"
return %indexes;
}
+=head2 EmbedItemsInMarcBiblio
+
+ EmbedItemsInMarcBiblio($marc, $biblionumber);
+
+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.
+
+=cut
+
+sub EmbedItemsInMarcBiblio {
+ my ($marc, $biblionumber) = @_;
+ croak "No MARC record" unless $marc;
+
+ my $frameworkcode = GetFrameworkCode($biblionumber);
+ _strip_item_fields($marc, $frameworkcode);
+
+ # ... and embed the current items
+ 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 );
+ while (my ($itemnumber) = $sth->fetchrow_array) {
+ require C4::Items;
+ my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
+ push @item_fields, $item_marc->field($itemtag);
+ }
+ $marc->append_fields(@item_fields);
+}
+
=head1 INTERNAL FUNCTIONS
=head2 _DelBiblioNoZebra($biblionumber,$record,$server);
return %result;
}
-=head2 _find_value
-
- ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
-
-Find the given $subfield in the given $tag in the given
-MARC::Record $record. If the subfield is found, returns
-the (indicators, value) pair; otherwise, (undef, undef) is
-returned.
-
-PROPOSITION :
-Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
-I suggest we export it from this module.
-
-=cut
-
-sub _find_value {
- my ( $tagfield, $insubfield, $record, $encoding ) = @_;
- my @result;
- my $indicator;
- if ( $tagfield < 10 ) {
- if ( $record->field($tagfield) ) {
- push @result, $record->field($tagfield)->data();
- } else {
- push @result, "";
- }
- } else {
- foreach my $field ( $record->field($tagfield) ) {
- my @subfields = $field->subfields();
- foreach my $subfield (@subfields) {
- if ( @$subfield[0] eq $insubfield ) {
- push @result, @$subfield[1];
- $indicator = $field->indicator(1) . $field->indicator(2);
- }
- }
- }
- }
- return ( $indicator, @result );
-}
-
=head2 _koha_marc_update_bib_ids
# we drop the original field
# we add the new builded field.
my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode );
+ die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag;
my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
+ die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblio_tag;
+
+ if ( $biblio_tag == $biblioitem_tag ) {
- if ( $biblio_tag != $biblioitem_tag ) {
+ # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
+ my $new_field = MARC::Field->new(
+ $biblio_tag, '', '',
+ "$biblio_subfield" => $biblionumber,
+ "$biblioitem_subfield" => $biblioitemnumber
+ );
+
+ # drop old field and create new one...
+ my $old_field = $record->field($biblio_tag);
+ $record->delete_field($old_field) if $old_field;
+ $record->insert_fields_ordered($new_field);
+ } else {
# biblionumber & biblioitemnumber are in different fields
# drop old field and create new one...
$old_field = $record->field($biblio_tag);
$record->delete_field($old_field) if $old_field;
- $record->append_fields($new_field);
+ $record->insert_fields_ordered($new_field);
# deal with biblioitemnumber
if ( $biblioitem_tag < 10 ) {
$old_field = $record->field($biblioitem_tag);
$record->delete_field($old_field) if $old_field;
$record->insert_fields_ordered($new_field);
-
- } else {
-
- # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
- my $new_field = MARC::Field->new(
- $biblio_tag, '', '',
- "$biblio_subfield" => $biblionumber,
- "$biblioitem_subfield" => $biblioitemnumber
- );
-
- # drop old field and create new one...
- my $old_field = $record->field($biblio_tag);
- $record->delete_field($old_field) if $old_field;
- $record->insert_fields_ordered($new_field);
}
}
$bkup_sth->finish;
# delete the biblio
- my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
- $del_sth->execute($biblionumber);
- $del_sth->finish;
+ my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
+ $sth2->execute($biblionumber);
+ # update the timestamp (Bugzilla 7146)
+ $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
+ $sth2->execute($biblionumber);
+ $sth2->finish;
}
$sth->finish;
return undef;
$bkup_sth->finish;
# delete the biblioitem
- my $del_sth = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
- $del_sth->execute($biblioitemnumber);
- $del_sth->finish;
+ my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
+ $sth2->execute($biblioitemnumber);
+ # update the timestamp (Bugzilla 7146)
+ $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
+ $sth2->execute($biblioitemnumber);
+ $sth2->finish;
}
$sth->finish;
return undef;
=cut
sub ModBiblioMarc {
-
- # pass the MARC::Record to this function, and it will create the records in the marc field
+ # pass the MARC::Record to this function, and it will create the records in
+ # the marc field
my ( $record, $biblionumber, $frameworkcode ) = @_;
+
+ # Clone record as it gets modified
+ $record = $record->clone();
my $dbh = C4::Context->dbh;
my @fields = $record->fields();
if ( !$frameworkcode ) {
}
substr( $string, 22, 6, "frey50" );
unless ( $record->subfield( 100, "a" ) ) {
- $record->insert_grouped_field( MARC::Field->new( 100, "", "", "a" => $string ) );
+ $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
}
}
+
+ #enhancement 5374: update transaction date (005) for marc21/unimarc
+ if($encoding =~ /MARC21|UNIMARC/) {
+ my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
+ # YY MM DD HH MM SS (update year and month)
+ my $f005= $record->field('005');
+ $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
+ }
+
my $oldRecord;
if ( C4::Context->preference("NoZebra") ) {
return $biblionumber;
}
-=head2 z3950_extended_services
-
- z3950_extended_services($serviceType,$serviceOptions,$record);
-
-z3950_extended_services is used to handle all interactions with Zebra's extended serices package, which is employed to perform all management of the MARC data stored in Zebra.
-
-C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
-
-C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
-
- action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
-
-and maybe
-
- recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
- syntax => the record syntax (transfer syntax)
- databaseName = Database from connection object
-
-To set serviceOptions, call set_service_options($serviceType)
-
-C<$record> the record, if one is needed for the service type
-
-A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
-
-=cut
-
-sub z3950_extended_services {
- my ( $server, $serviceType, $action, $serviceOptions ) = @_;
-
- # get our connection object
- my $Zconn = C4::Context->Zconn( $server, 0, 1 );
-
- # create a new package object
- my $Zpackage = $Zconn->package();
-
- # set our options
- $Zpackage->option( action => $action );
-
- if ( $serviceOptions->{'databaseName'} ) {
- $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
- }
- if ( $serviceOptions->{'recordIdNumber'} ) {
- $Zpackage->option( recordIdNumber => $serviceOptions->{'recordIdNumber'} );
- }
- if ( $serviceOptions->{'recordIdOpaque'} ) {
- $Zpackage->option( recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
- }
-
- # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
- #if ($serviceType eq 'itemorder') {
- # $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
- # $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
- # $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
- # $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
- #}
-
- if ( $serviceOptions->{record} ) {
- $Zpackage->option( record => $serviceOptions->{record} );
-
- # can be xml or marc
- if ( $serviceOptions->{'syntax'} ) {
- $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
- }
- }
-
- # send the request, handle any exception encountered
- eval { $Zpackage->send($serviceType) };
- if ( $@ && $@->isa("ZOOM::Exception") ) {
- return "error: " . $@->code() . " " . $@->message() . "\n";
- }
-
- # free up package resources
- $Zpackage->destroy();
-}
-
-=head2 set_service_options
-
- my $serviceOptions = set_service_options($serviceType);
-
-C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
-
-Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
-
-=cut
-
-sub set_service_options {
- my ($serviceType) = @_;
- my $serviceOptions;
-
- # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
- # $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
-
- if ( $serviceType eq 'commit' ) {
-
- # nothing to do
- }
- if ( $serviceType eq 'create' ) {
-
- # nothing to do
- }
- if ( $serviceType eq 'drop' ) {
- die "ERROR: 'drop' not currently supported (by Zebra)";
- }
- return $serviceOptions;
-}
-
=head2 get_biblio_authorised_values
find the types and values for all authorised values assigned to this biblio.
return $authorised_values;
}
+=head2 CountBiblioInOrders
+
+=over 4
+$count = &CountBiblioInOrders( $biblionumber);
+
+=back
+
+This function return count of biblios in orders with $biblionumber
+
+=cut
+
+sub CountBiblioInOrders {
+ my ($biblionumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = "SELECT count(*)
+ FROM aqorders
+ WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($biblionumber);
+ my $count = $sth->fetchrow;
+ return ($count);
+}
+
+=head2 GetSubscriptionsId
+
+=over 4
+$subscriptions = &GetSubscriptionsId($biblionumber);
+
+=back
+
+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 GetHolds
+
+=over 4
+$holds = &GetHolds($biblionumber);
+
+=back
+
+This function return the count of holds with $biblionumber
+
+=cut
+
+sub GetHolds {
+ my ($biblionumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query = "SELECT count(*)
+ FROM reserves
+ WHERE biblionumber=?";
+ my $sth = $dbh->prepare($query);
+ $sth->execute($biblionumber);
+ my $holds = $sth->fetchrow;
+ return ($holds);
+}
+
+=head2 prepare_host_field
+
+$marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
+Generate the host item entry for an analytic child entry
+
+=cut
+
+sub prepare_host_field {
+ my ( $hostbiblio, $marcflavour ) = @_;
+ $marcflavour ||= C4::Context->preference('marcflavour');
+ my $host = GetMarcBiblio($hostbiblio);
+ # unfortunately as_string does not 'do the right thing'
+ # if field returns undef
+ my %sfd;
+ my $field;
+ my $host_field;
+ if ( $marcflavour eq 'MARC21' || $marcflavour eq 'NORMARC' ) {
+ if ( $field = $host->field('100') || $host->field('110') || $host->field('11') ) {
+ my $s = $field->as_string('ab');
+ if ($s) {
+ $sfd{a} = $s;
+ }
+ }
+ if ( $field = $host->field('245') ) {
+ my $s = $field->as_string('a');
+ if ($s) {
+ $sfd{t} = $s;
+ }
+ }
+ if ( $field = $host->field('260') ) {
+ my $s = $field->as_string('abc');
+ if ($s) {
+ $sfd{d} = $s;
+ }
+ }
+ if ( $field = $host->field('240') ) {
+ my $s = $field->as_string();
+ if ($s) {
+ $sfd{b} = $s;
+ }
+ }
+ if ( $field = $host->field('022') ) {
+ my $s = $field->as_string('a');
+ if ($s) {
+ $sfd{x} = $s;
+ }
+ }
+ if ( $field = $host->field('020') ) {
+ my $s = $field->as_string('a');
+ if ($s) {
+ $sfd{z} = $s;
+ }
+ }
+ if ( $field = $host->field('001') ) {
+ $sfd{w} = $field->data(),;
+ }
+ $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
+ return $host_field;
+ }
+ elsif ( $marcflavour eq 'UNIMARC' ) {
+ #author
+ if ( $field = $host->field('700') || $host->field('710') || $host->field('720') ) {
+ my $s = $field->as_string('ab');
+ if ($s) {
+ $sfd{a} = $s;
+ }
+ }
+ #title
+ if ( $field = $host->field('200') ) {
+ my $s = $field->as_string('a');
+ if ($s) {
+ $sfd{t} = $s;
+ }
+ }
+ #place of publicaton
+ if ( $field = $host->field('210') ) {
+ my $s = $field->as_string('a');
+ if ($s) {
+ $sfd{c} = $s;
+ }
+ }
+ #date of publication
+ if ( $field = $host->field('210') ) {
+ my $s = $field->as_string('d');
+ if ($s) {
+ $sfd{d} = $s;
+ }
+ }
+ #edition statement
+ if ( $field = $host->field('205') ) {
+ my $s = $field->as_string();
+ if ($s) {
+ $sfd{a} = $s;
+ }
+ }
+ #URL
+ if ( $field = $host->field('856') ) {
+ my $s = $field->as_string('u');
+ if ($s) {
+ $sfd{u} = $s;
+ }
+ }
+ #ISSN
+ if ( $field = $host->field('011') ) {
+ my $s = $field->as_string('a');
+ if ($s) {
+ $sfd{x} = $s;
+ }
+ }
+ #ISBN
+ if ( $field = $host->field('010') ) {
+ my $s = $field->as_string('a');
+ if ($s) {
+ $sfd{y} = $s;
+ }
+ }
+ if ( $field = $host->field('001') ) {
+ $sfd{0} = $field->data(),;
+ }
+ $host_field = MARC::Field->new( 461, '0', ' ', %sfd );
+ return $host_field;
+ }
+ return;
+}
+
1;
+
__END__
=head1 AUTHOR
projects / koha_gimpoz / blobdiff