Browse Source

Bug 9593: improve parsing of prices from staged files

Initial bug :
When there's a round price with no decimals after it,
or when the symbol is after the digits, the price is not captured
by regular expression in MungeMarcPrice routine and the variable
is not initialized.

Enhancement :
The MungeMarcPrice routine had been widely modified.
It's still possible to priority pick the active currency but
unlike the previous mechanism that worked only for prices preceded
by the currency sign, it's now valid wherever the symbol is situated.
As symbol you may enter a pure currency sign as well as a string
including it like '$US'. Moreover, an 'isocode' column had been
added in currency table (editable in the staffo interface from
Administration/Currencies and exchange rates). So the active
currency can be picked either through its symbol or through its iso
code.

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Katrin Fischer <Katrin.Fischer.83@web.de>
Passes all tests, especially t/db_dependent/MungeMarcPrice.t
Checked currencies can be added, edited and deleted.
Notes: new ISO code field is mandatory.
       Sample sql files need to be updated (bug 12146)

Signed-off-by: Galen Charlton <gmc@esilibrary.com>
3.16.x
Lyon3 Team 8 years ago
committed by Galen Charlton
parent
commit
94d3aed746
  1. 75
      C4/Biblio.pm
  2. 7
      admin/currency.pl
  3. 1
      installer/data/mysql/kohastructure.sql
  4. 7
      installer/data/mysql/updatedatabase.pl
  5. 10
      koha-tmpl/intranet-tmpl/prog/en/modules/admin/currency.tt
  6. 57
      t/db_dependent/MungeMarcPrice.t

75
C4/Biblio.pm

@ -1512,38 +1512,53 @@ Return the best guess at what the actual price is from a price field.
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'};
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;
}

7
admin/currency.pl

@ -185,6 +185,7 @@ sub add_validate {
my $rec = {
rate => $input->param('rate'),
symbol => $input->param('symbol') || q{},
isocode => $input->param('isocode') || q{},
active => $input->param('active') || 0,
currency => $input->param('currency'),
};
@ -198,20 +199,22 @@ sub add_validate {
{}, $input->param('currency') );
if ($row_count) {
$dbh->do(
q|UPDATE currency SET rate = ?, symbol = ?, active = ? WHERE currency = ? |,
q|UPDATE currency SET rate = ?, symbol = ?, isocode = ?, active = ? WHERE currency = ? |,
{},
$rec->{rate},
$rec->{symbol},
$rec->{isocode},
$rec->{active},
$rec->{currency}
);
} else {
$dbh->do(
q|INSERT INTO currency (currency, rate, symbol, active) VALUES (?,?,?,?) |,
q|INSERT INTO currency (currency, rate, symbol, isocode, active) VALUES (?,?,?,?,?) |,
{},
$rec->{currency},
$rec->{rate},
$rec->{symbol},
$rec->{isocode},
$rec->{active}
);

1
installer/data/mysql/kohastructure.sql

@ -716,6 +716,7 @@ DROP TABLE IF EXISTS `currency`;
CREATE TABLE `currency` (
`currency` varchar(10) NOT NULL default '',
`symbol` varchar(5) default NULL,
`isocode` varchar(5) default NULL,
`timestamp` timestamp NOT NULL default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
`rate` float(15,5) default NULL,
`active` tinyint(1) default NULL,

7
installer/data/mysql/updatedatabase.pl

@ -8362,6 +8362,13 @@ if ( CheckVersion($DBversion) ) {
SetVersion ($DBversion);
}
$DBversion = "3.15.00.XXX";
if ( CheckVersion($DBversion) ) {
$dbh->do("ALTER TABLE currency ADD isocode VARCHAR(5) default NULL AFTER symbol;");
print "Upgrade to $DBversion done (Added isocode to the currency table)\n";
SetVersion($DBversion);
}
=head1 FUNCTIONS
=head2 TableExists($table)

10
koha-tmpl/intranet-tmpl/prog/en/modules/admin/currency.tt

@ -46,7 +46,8 @@
<div id="bd">
<div id="yui-main">
<div class="yui-b">
<div class="message dialog"><p style="text-align:justify" >The active currency priority will be picked during the importation process from a staged file whenever the price data is provided under different currencies.<br/>
The symbol may be the pure currency sign or a string in which it's included ( like '$US' ).</p></div>
[% IF ( else ) %]
<div id="toolbar" class="btn-toolbar">
<a class="btn btn-small" id="newcurrency" href="[% script_name %]?op=add_form"><i class="icon-plus"></i> New currency</a>
@ -81,7 +82,10 @@
<label for="symbol" class="required">Symbol: </label>
<input type="text" name="symbol" id="symbol" size="5" maxlength="5" value="[% symbol %]" required="required" class="required" /> <span class="required">Required</span>
</li>
<li>
<label for="isocode" class="required">Iso code: </label>
<input type="text" name="isocode" id="isocode" size="5" maxlength="5" value="[% isocode %]" required="required" class="required" /> <span class="required">Required</span>
</li>
<li>
<span class="label">Last updated: </span>[% timestamp %]
</li>
@ -161,6 +165,7 @@
<th>Currency</th>
<th>Rate</th>
<th>Symbol</th>
<th>Iso code</th>
<th>Last updated</th>
<th>Active</th>
<th colspan="2">Actions&nbsp;</th>
@ -174,6 +179,7 @@
<td>[% loo.currency %]</td>
<td>[% loo.rate %]</td>
<td>[% loo.symbol |html %]</td>
<td>[% loo.isocode |html %]</td>
<td>[% loo.timestamp %]</td>
<td style="color:green;">[% IF ( loo.active ) %]✓[% END %]</td>
<td><a href="[% loo.script_name %]?op=add_form&amp;searchfield=[% loo.currency %]">Edit</a></td>

57
t/db_dependent/MungeMarcPrice.t

@ -0,0 +1,57 @@
#!/usr/bin/perl
use strict;
use warnings;
use C4::Biblio;
use C4::Budgets;
use Test::More;
use utf8;
# work around wide character warnings
binmode Test::More->builder->output, ":encoding(UTF-8)";
binmode Test::More->builder->failure_output, ":encoding(UTF-8)";
# start transaction
my $dbh = C4::Context->dbh;
$dbh->{AutoCommit} = 0;
$dbh->{RaiseError} = 1;
# set some test price strings and expected output
my @prices2test=( { string => '25,5 £, $34,55, $LD35', expected => '34.55' },
{ string => '32 EUR, 42.50$ USD, 54 CAD', expected=>'42.50' },
{ string => '38.80 Ksh, ¥300, 51,50 USD', expected => '51.50' },
{ string => '44 $, 33 €, 64 Br, £30', expected => '44' },
{ string => '9 EUR,$34,55 USD,$7.35 CAN', expected => '34.55' },
{ string => '$55.32', expected => '55.32' },
{ string => '9.99 USD (paperback)', expected => '9.99' },
{ string => '$9.99 USD (paperback)', expected => '9.99' },
{ string => '18.95 (U.S.)', expected => '18.95' },
{ string => '$5.99 ($7.75 CAN)', expected => '5.99' },
{ string => '5.99 (7.75 CAN)', expected => '5.99' },
);
plan tests => scalar @prices2test;
# set active currency test data
my $CURRENCY = 'TEST';
my $SYMBOL = '$';
my $ISOCODE = 'USD';
my $RATE= 1;
# disables existing active currency if necessary.
my $active_currency = C4::Budgets->GetCurrency();
my $curr;
if ($active_currency) {
$curr = $active_currency->{'currency'};
$dbh->do("UPDATE currency set active = 0 where currency = '$curr'");
}
$dbh->do("INSERT INTO currency ( currency,symbol,isocode,rate,active )
VALUES ('$CURRENCY','$SYMBOL','$ISOCODE','$RATE',1)");
foreach my $price (@prices2test) {
my $mungemarcprice=MungeMarcPrice($price->{'string'});
my $expected=$price->{'expected'};
ok ($mungemarcprice eq $expected, "must return $price->{'expected'} from initial string : $price->{'string'}");
}
# Cleanup
$dbh->rollback;
Loading…
Cancel
Save