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;
}
} else { # assume marc21 if not unimarc
$scope = '020';
}
+
my @marcisbns;
- my $marcisbn;
foreach my $field ( $record->field($scope) ) {
my $isbn = $field->as_string();
if ( $isbn ne "" ) {
- $marcisbn = { marcisbn => $isbn, };
- push @marcisbns, $marcisbn;
+ push @marcisbns, $isbn;
}
}
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 : ''
};
}
}
}
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 : ''
};
}
}
}
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,
}
}
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;
}
projects / koha_fer / blobdiff