From 285f06e394cd270b978e63173b6cdcb1a0746320 Mon Sep 17 00:00:00 2001
From: Kyle M Hall
Date: Wed, 8 Feb 2012 12:16:20 -0500
Subject: [PATCH] Bug 7112 - Having two prices in 020$c causes basket creation
to fail from staged marc import
The root problem here is that the price is being pulled from the MARC record
and is then run through Number::Format::unformat_number. This routine is
really being misused, and should only be used to reverse the effects of
Number::Format on a number string. We are apparently using it to strip
out currency characters and the like.
Number::Format::unformat_number will choke if there is more than one period (.)
in the price field. MARC standards do not limit this field to a single period,
so unless there is only one period, we should skip number unformatting.
Examples of that break unformat_number include '18.95 (U.S.)', and
'$5.99 ($7.75 CAN)', both of which are perfectly valid.
This commit adds the function MungeMarcPrice that will better handle
find a real price value in a given price field. It does a very good
job at finding a price in any currency format, and attempts to find
a price in whichever currency is active before falling back to
the first valid price it can find.
The variable $price may fail to have an actual price, in which case
the price then defaults to '0.00', which would be rarely if ever the
correct price. To combat this, I have added highlighting to any
price in the Order Details table that begins with 0 ( i.e. '0.00' ).
Also, fixed the incomplete table footer, adding a new td with a
span of 3 to fill in the nonexistant cells.
Signed-off-by: Jared Camins-Esakov
---
C4/Biblio.pm | 45 +++++++++++++++++++
acqui/addorderiso2709.pl | 10 ++---
.../prog/en/modules/acqui/basket.tt | 9 ++--
3 files changed, 53 insertions(+), 11 deletions(-)
diff --git a/C4/Biblio.pm b/C4/Biblio.pm
index 5508cbebeb..2aa17d50e4 100644
--- a/C4/Biblio.pm
+++ b/C4/Biblio.pm
@@ -83,6 +83,7 @@ BEGIN {
&GetXmlBiblio
&GetCOinSBiblio
&GetMarcPrice
+ &MungeMarcPrice
&GetMarcQuantity
&GetAuthorisedValueDesc
@@ -1405,12 +1406,56 @@ sub GetMarcPrice {
for my $field ( $record->field(@listtags) ) {
for my $subfield_value ($field->subfield($subfield)){
#check value
+ $subfield_value = MungeMarcPrice( $subfield_value );
return $subfield_value if ($subfield_value);
}
}
return 0; # no price found
}
+=head2 MungeMarcPrice
+
+Return the best guess at what the actual price is from a price field.
+=cut
+
+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";
+ }
+
+ return $price;
+}
+
+
=head2 GetMarcQuantity
return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
diff --git a/acqui/addorderiso2709.pl b/acqui/addorderiso2709.pl
index 8d9c0e3fc5..23020c7177 100755
--- a/acqui/addorderiso2709.pl
+++ b/acqui/addorderiso2709.pl
@@ -202,13 +202,9 @@ if ($op eq ""){
"notes", $cgiparams->{'notes'}, "budget_id", $cgiparams->{'budget_id'},
"currency",$cgiparams->{'currency'},
);
- # get the price if there is one.
- # filter by storing only the 1st number
- # we suppose the currency is correct, as we have no possibilities to get it.
- my $price= GetMarcPrice($marcrecord, C4::Context->preference('marcflavour'));
- if ($price){
- $price = $num->unformat_number($price);
- }
+
+ my $price = GetMarcPrice($marcrecord, C4::Context->preference('marcflavour'));
+
if ($price){
$orderinfo{'listprice'} = $price;
eval {
diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt
index 84f6681312..1f71a95a71 100644
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt
+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt
@@ -271,6 +271,7 @@
|
[% qty_total %] |
[% total_est_gsti %] |
+ |
[% END %]
@@ -298,10 +299,10 @@
[% END %]
- [% books_loo.rrp %] |
- [% books_loo.ecost %] |
- [% books_loo.quantity %] |
- [% books_loo.line_total %] |
+ [% books_loo.rrp %] |
+ [% books_loo.ecost %] |
+ [% books_loo.quantity %] |
+ [% books_loo.line_total %] |
[% books_loo.budget_name %] |
[% IF ( active ) %]
[% UNLESS ( closedate ) %]
--
2.39.5