# Look for the currency symbol and the normalized code of the active currency, if it's there,

    ## Look for the currency symbol of the active currency, if it's there,

    my $active_currency = C4::Budgets->GetCurrency();

    ## start the price string right after the symbol. This allows us to prefer

    my $symbol = $active_currency->{'symbol'};

    ## this native currency price over other currency prices, if possible.

    my $isocode = $active_currency->{'isocode'};

    my $active_currency = C4::Context->dbh->selectrow_hashref( 'SELECT * FROM currency WHERE active = 1', {} );

    my $localprice;

    my $symbol = quotemeta( $active_currency->{'symbol'} );

    if ( $symbol ) {

    if ( $price =~ m/$symbol/ ) {

        my @matches =($price=~ /

        my @parts = split(/$symbol/, $price );

            \s?

        $price = $parts[1];

            (                          # 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'

    ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )

            |(?:\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'

    ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;

            )

            \s?\p{Sc}?\s?              # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'

    ## Split price into array on periods and commas

            (?:

    my @parts = split(/[\,\.]/, $price);

            (?:[\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

    ## 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 );

            \s?                        # followed or not by a whitespace

    if ( length( $decimal ) > 2 ) {

            )                          # end of capturing parenthesis

        push( @parts, $decimal );

            (?:\p{P}|\z)               # followed by a punctuation sign or by the end of the string

        $decimal = '';

            /gx);

    }

        if ( @matches ) {

    $price = join('', @parts );

            foreach ( @matches ) {

                $localprice = $_ and last if index($_, $isocode)>=0;

    if ( $decimal ) {

            }

     $price .= ".$decimal";

            if ( !$localprice ) {

                foreach ( @matches ) {

                    $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]|\z)/;

                }

            }

        }

        $price=$localprice;

        if ($price) {

            # 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/,/./;

        }

q|UPDATE currency SET rate = ?, symbol = ?, active = ? WHERE currency = ? |,

q|UPDATE currency SET rate = ?, symbol = ?, isocode = ?, active = ? WHERE currency = ? |,

q|INSERT INTO currency (currency, rate, symbol, active) VALUES (?,?,?,?) |,

q|INSERT INTO currency (currency, rate, symbol, isocode, active) VALUES (?,?,?,?,?) |,

<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>

        <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>

- 

#!/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, ":utf8";

binmode Test::More->builder->failure_output, ":utf8";

# 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' }

                );

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;