my $frameworkcode = shift;
my $options = @_ ? shift : undef;
my $defer_marc_save = 0;
+ if (!$record) {
+ carp('AddBiblio called with undefined record');
+ return;
+ }
if ( defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'} ) {
$defer_marc_save = 1;
}
which fields are used to store embedded item, biblioitem,
and biblionumber data for indexing.
+Returns 1 on success 0 on failure
+
=cut
sub ModBiblio {
my ( $record, $biblionumber, $frameworkcode ) = @_;
- croak "No record" unless $record;
+ if (!$record) {
+ carp 'No record passed to ModBiblio';
+ return 0;
+ }
if ( C4::Context->preference("CataloguingLog") ) {
my $newrecord = GetMarcBiblio($biblionumber);
- logaction( "CATALOGUING", "MODIFY", $biblionumber, "BEFORE=>" . $newrecord->as_formatted );
+ logaction( "CATALOGUING", "MODIFY", $biblionumber, "biblio BEFORE=>" . $newrecord->as_formatted );
}
# Cleaning up invalid fields must be done early or SetUTF8Flag is liable to
# We delete any existing holds
require C4::Reserves;
- my ($count, $reserves) = C4::Reserves::GetReservesFromBiblionumber($biblionumber);
+ my $reserves = C4::Reserves::GetReservesFromBiblionumber({ biblionumber => $biblionumber });
foreach my $res ( @$reserves ) {
C4::Reserves::CancelReserve({ reserve_id => $res->{'reserve_id'} });
}
# from being generated by _koha_delete_biblioitems
$error = _koha_delete_biblio( $dbh, $biblionumber );
- logaction( "CATALOGUING", "DELETE", $biblionumber, "" ) if C4::Context->preference("CataloguingLog");
+ logaction( "CATALOGUING", "DELETE", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
return;
}
Automatically links headings in a bib record to authorities.
+Returns the number of headings changed
+
=cut
sub BiblioAutoLink {
my $record = shift;
my $frameworkcode = shift;
+ if (!$record) {
+ carp('Undefined record passed to BiblioAutoLink');
+ return 0;
+ }
my ( $num_headings_changed, %results );
my $linker_module =
unless ( can_load( modules => { $linker_module => undef } ) ) {
$linker_module = 'C4::Linker::Default';
unless ( can_load( modules => { $linker_module => undef } ) ) {
- return 0, 0;
+ return 0;
}
}
my $frameworkcode = shift;
my $allowrelink = shift;
my %results;
+ if (!$bib) {
+ carp 'LinkBibHeadingsToAuthorities called on undefined bib record';
+ return ( 0, {});
+ }
require C4::Heading;
require C4::AuthoritiesMarc;
sub GetRecordValue {
my ( $field, $record, $frameworkcode ) = @_;
+
+ if (!$record) {
+ carp 'GetRecordValue called with undefined record';
+ return;
+ }
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?');
# get the coin format
if ( ! $record ) {
- return;
+ carp 'GetCOinSBiblio called with undefined record';
+ return;
}
my $pos7 = substr $record->leader(), 7, 1;
my $pos6 = substr $record->leader(), 6, 1;
=head2 GetMarcPrice
return the prices in accordance with the Marc format.
+
+returns 0 if no price found
+returns undef if called without a marc record or with
+an unrecognized marc format
+
=cut
sub GetMarcPrice {
my ( $record, $marcflavour ) = @_;
+ if (!$record) {
+ carp 'GetMarcPrice called on undefined record';
+ return;
+ }
+
my @listtags;
my $subfield;
sub MungeMarcPrice {
my ( $price ) = @_;
-
return unless ( $price =~ m/\d/ ); ## No digits means no price.
-
- ## Look for the currency symbol of the active currency, if it's there,
- ## start the price string right after the symbol. This allows us to prefer
- ## this native currency price over other currency prices, if possible.
- my $active_currency = C4::Context->dbh->selectrow_hashref( 'SELECT * FROM currency WHERE active = 1', {} );
- my $symbol = quotemeta( $active_currency->{'symbol'} );
- if ( $price =~ m/$symbol/ ) {
- my @parts = split(/$symbol/, $price );
- $price = $parts[1];
- }
-
- ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
- ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
-
- ## Split price into array on periods and commas
- my @parts = split(/[\,\.]/, $price);
-
- ## If the last grouping of digits is more than 2 characters, assume there is no decimal value and put it back.
- my $decimal = pop( @parts );
- if ( length( $decimal ) > 2 ) {
- push( @parts, $decimal );
- $decimal = '';
- }
-
- $price = join('', @parts );
-
- if ( $decimal ) {
- $price .= ".$decimal";
+ # Look for the currency symbol and the normalized code of the active currency, if it's there,
+ my $active_currency = C4::Budgets->GetCurrency();
+ my $symbol = $active_currency->{'symbol'};
+ my $isocode = $active_currency->{'isocode'};
+ $isocode = $active_currency->{'currency'} unless defined $isocode;
+ my $localprice;
+ if ( $symbol ) {
+ my @matches =($price=~ /
+ \s?
+ ( # start of capturing parenthesis
+ (?:
+ (?:[\p{Sc}\p{L}\/.]){1,4} # any character from Currency signs or Letter Unicode categories or slash or dot within 1 to 4 occurrences : call this whole block 'symbol block'
+ |(?:\d+[\p{P}\s]?){1,4} # or else at least one digit followed or not by a punctuation sign or whitespace, all theese within 1 to 4 occurrences : call this whole block 'digits block'
+ )
+ \s?\p{Sc}?\s? # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
+ (?:
+ (?:[\p{Sc}\p{L}\/.]){1,4} # followed by same block as symbol block
+ |(?:\d+[\p{P}\s]?){1,4} # or by same block as digits block
+ )
+ \s?\p{L}{0,4}\s? # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
+ ) # end of capturing parenthesis
+ (?:\p{P}|\z) # followed by a punctuation sign or by the end of the string
+ /gx);
+
+ if ( @matches ) {
+ foreach ( @matches ) {
+ $localprice = $_ and last if index($_, $isocode)>=0;
+ }
+ if ( !$localprice ) {
+ foreach ( @matches ) {
+ $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
+ }
+ }
+ }
}
-
+ if ( $localprice ) {
+ $price = $localprice;
+ } else {
+ ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
+ ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
+ }
+ # eliminate symbol/isocode, space and any final dot from the string
+ $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
+ # remove comma,dot when used as separators from hundreds
+ $price =~s/[\,\.](\d{3})/$1/g;
+ # convert comma to dot to ensure correct display of decimals if existing
+ $price =~s/,/./;
return $price;
}
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
+returns 0 if no quantity found
+returns undef if called without a marc record or with
+an unrecognized marc format
+
=cut
sub GetMarcQuantity {
my ( $record, $marcflavour ) = @_;
+ if (!$record) {
+ carp 'GetMarcQuantity called on undefined record';
+ return;
+ }
+
my @listtags;
my $subfield;
sub GetMarcControlnumber {
my ( $record, $marcflavour ) = @_;
+ if (!$record) {
+ carp 'GetMarcControlnumber called on undefined record';
+ return;
+ }
my $controlnumber = "";
# Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC
# Keep $marcflavour for possible later use
sub GetMarcISBN {
my ( $record, $marcflavour ) = @_;
+ if (!$record) {
+ carp 'GetMarcISBN called on undefined record';
+ return;
+ }
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();
+ my $isbn = $field->as_string();
if ( $isbn ne "" ) {
- $marcisbn = { marcisbn => $isbn, };
- push @marcisbns, $marcisbn;
- $isbn = $value;
- }
- if ( $isbn ne $value ) {
- $isbn = $isbn . " " . $value;
+ push @marcisbns, $isbn;
}
}
- if ($isbn) {
- $marcisbn = { marcisbn => $isbn };
- push @marcisbns, $marcisbn; #load last tag into array
- }
return \@marcisbns;
} # end GetMarcISBN
sub GetMarcISSN {
my ( $record, $marcflavour ) = @_;
+ if (!$record) {
+ carp 'GetMarcISSN called on undefined record';
+ return;
+ }
my $scope;
if ( $marcflavour eq "UNIMARC" ) {
$scope = '011';
sub GetMarcNotes {
my ( $record, $marcflavour ) = @_;
+ if (!$record) {
+ carp 'GetMarcNotes called on undefined record';
+ return;
+ }
my $scope;
if ( $marcflavour eq "UNIMARC" ) {
$scope = '3..';
sub GetMarcSubjects {
my ( $record, $marcflavour ) = @_;
+ if (!$record) {
+ carp 'GetMarcSubjects called on undefined record';
+ return;
+ }
my ( $mintag, $maxtag, $fields_filter );
if ( $marcflavour eq "UNIMARC" ) {
$mintag = "600";
my @marcsubjects;
my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
- my $authoritysep = C4::Context->preference('authoritysep');
+ my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
foreach my $field ( $record->field($fields_filter) ) {
next unless ($field->tag() >= $mintag && $field->tag() <= $maxtag);
code => $code,
value => $value,
link_loop => \@this_link_loop,
- separator => (scalar @subfields_loop) ? $authoritysep : ''
+ separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
};
}
}
sub GetMarcAuthors {
my ( $record, $marcflavour ) = @_;
+ if (!$record) {
+ carp 'GetMarcAuthors called on undefined record';
+ return;
+ }
my ( $mintag, $maxtag, $fields_filter );
# tagslib useful for UNIMARC author reponsabilities
}
my @marcauthors;
- my $authoritysep = C4::Context->preference('authoritysep');
+ my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
foreach my $field ( $record->field($fields_filter) ) {
next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
code => $code,
value => $value,
link_loop => \@this_link_loop,
- separator => (scalar @subfields_loop) ? $authoritysep : ''
+ separator => (scalar @subfields_loop) ? $AuthoritySeparator : ''
};
}
}
sub GetMarcUrls {
my ( $record, $marcflavour ) = @_;
+ if (!$record) {
+ carp 'GetMarcUrls called on undefined record';
+ return;
+ }
my @marcurls;
for my $field ( $record->field('856') ) {
sub GetMarcSeries {
my ( $record, $marcflavour ) = @_;
+ if (!$record) {
+ carp 'GetMarcSeries called on undefined record';
+ return;
+ }
+
my ( $mintag, $maxtag, $fields_filter );
if ( $marcflavour eq "UNIMARC" ) {
$mintag = "225";
}
my @marcseries;
- my $authoritysep = C4::Context->preference('authoritysep');
+ my $AuthoritySeparator = C4::Context->preference('AuthoritySeparator');
foreach my $field ( $record->field($fields_filter) ) {
next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
code => $code,
value => $value,
link_loop => \@link_loop,
- separator => (scalar @subfields_loop) ? $authoritysep : '',
+ separator => (scalar @subfields_loop) ? $AuthoritySeparator : '',
volumenum => $volume_number,
}
}
sub GetMarcHosts {
my ( $record, $marcflavour ) = @_;
+ if (!$record) {
+ carp 'GetMarcHosts called on undefined record';
+ return;
+ }
+
my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
$marcflavour ||="MARC21";
if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
my $record = MARC::Record->new();
SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
my $db_to_marc = C4::Context->marcfromkohafield;
+ my $tag_hr = {};
while ( my ($name, $value) = each %$hash ) {
next unless my $dtm = $db_to_marc->{''}->{$name};
next unless ( scalar( @$dtm ) );
my ($tag, $letter) = @$dtm;
+ $tag .= '';
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 ) );
- }
+ next if $value eq '';
+ $tag_hr->{$tag} //= [];
+ push @{$tag_hr->{$tag}}, [($letter, $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)
+ );
}
return $record;
}
Extract data from a MARC bib record into a hashref representing
Koha biblio, biblioitems, and items fields.
+If passed an undefined record will log the error and return an empty
+hash_ref
+
=cut
sub TransformMarcToKoha {
my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
- my $result;
+ my $result = {};
+ if (!defined $record) {
+ carp('TransformMarcToKoha called with undefined record');
+ return $result;
+ }
$limit_table = $limit_table || 0;
$frameworkcode = '' unless defined $frameworkcode;
sub EmbedItemsInMarcBiblio {
my ($marc, $biblionumber, $itemnumbers) = @_;
- croak "No MARC record" unless $marc;
+ if ( !$marc ) {
+ carp 'EmbedItemsInMarcBiblio: No MARC record passed';
+ return;
+ }
$itemnumbers = [] unless defined $itemnumbers;
# pass the MARC::Record to this function, and it will create the records in
# the marc field
my ( $record, $biblionumber, $frameworkcode ) = @_;
+ if ( !$record ) {
+ carp 'ModBiblioMarc passed an undefined record';
+ return;
+ }
# Clone record as it gets modified
$record = $record->clone();
sub RemoveAllNsb {
my $record = shift;
+ if (!$record) {
+ carp 'RemoveAllNsb called with undefined record';
+ return;
+ }
SetUTF8Flag($record);