@@ -, +, @@ staged file Sample sql files need to be updated (bug 12146) --- C4/Biblio.pm | 75 +++++++++++++--------- admin/currency.pl | 7 +- installer/data/mysql/kohastructure.sql | 1 + installer/data/mysql/updatedatabase.pl | 7 ++ .../prog/en/modules/admin/currency.tt | 10 ++- t/db_dependent/MungeMarcPrice.t | 57 ++++++++++++++++ 6 files changed, 123 insertions(+), 34 deletions(-) create mode 100755 t/db_dependent/MungeMarcPrice.t --- a/C4/Biblio.pm +++ a/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; } --- a/admin/currency.pl +++ a/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} ); --- a/installer/data/mysql/kohastructure.sql +++ a/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, --- a/installer/data/mysql/updatedatabase.pl +++ a/installer/data/mysql/updatedatabase.pl @@ -8202,6 +8202,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) --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/currency.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/currency.tt @@ -46,7 +46,8 @@
- +

The active currency priority will be picked during the importation process from a staged file whenever the price data is provided under different currencies.
+The symbol may be the pure currency sign or a string in which it's included ( like '$US' ).

[% IF ( else ) %]
New currency @@ -81,7 +82,10 @@ Required - +
  • + + Required +
  • Last updated: [% timestamp %]
  • @@ -161,6 +165,7 @@ Currency Rate Symbol + Iso code Last updated Active Actions  @@ -174,6 +179,7 @@ [% loo.currency %] [% loo.rate %] [% loo.symbol |html %] + [% loo.isocode |html %] [% loo.timestamp %] [% IF ( loo.active ) %]✓[% END %] Edit --- a/t/db_dependent/MungeMarcPrice.t +++ a/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; --