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;
}
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'),
};
{}, $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}
);
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,
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)
<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>
<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>
<th>Currency</th>
<th>Rate</th>
<th>Symbol</th>
+ <th>Iso code</th>
<th>Last updated</th>
<th>Active</th>
<th colspan="2">Actions </th>
<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&searchfield=[% loo.currency %]">Edit</a></td>
--- /dev/null
+#!/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;
projects / koha_fer / commitdiff