View | Details | Raw Unified | Return to bug 9593
Collapse All | Expand All

(-)a/C4/Biblio.pm (-30 / +45 lines)
Lines 1512-1549 Return the best guess at what the actual price is from a price field. Link Here
1512
1512
1513
sub MungeMarcPrice {
1513
sub MungeMarcPrice {
1514
    my ( $price ) = @_;
1514
    my ( $price ) = @_;
1515
1516
    return unless ( $price =~ m/\d/ ); ## No digits means no price.
1515
    return unless ( $price =~ m/\d/ ); ## No digits means no price.
1517
1516
    # Look for the currency symbol and the normalized code of the active currency, if it's there,
1518
    ## Look for the currency symbol of the active currency, if it's there,
1517
    my $active_currency = C4::Budgets->GetCurrency();
1519
    ## start the price string right after the symbol. This allows us to prefer
1518
    my $symbol = $active_currency->{'symbol'};
1520
    ## this native currency price over other currency prices, if possible.
1519
    my $isocode = $active_currency->{'isocode'};
1521
    my $active_currency = C4::Context->dbh->selectrow_hashref( 'SELECT * FROM currency WHERE active = 1', {} );
1520
    my $localprice;
1522
    my $symbol = quotemeta( $active_currency->{'symbol'} );
1521
    if ( $symbol ) {
1523
    if ( $price =~ m/$symbol/ ) {
1522
        my @matches =($price=~ /
1524
        my @parts = split(/$symbol/, $price );
1523
            \s?
1525
        $price = $parts[1];
1524
            (                          # start of capturing parenthesis
1526
    }
1525
            (?:
1527
1526
            (?:[\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'
1528
    ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1527
            |(?:\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'
1529
    ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1528
            )
1530
1529
            \s?\p{Sc}?\s?              # followed or not by a whitespace. \p{Sc}?\s? are for cases like '25$ USD'
1531
    ## Split price into array on periods and commas
1530
            (?:
1532
    my @parts = split(/[\,\.]/, $price);
1531
            (?:[\p{Sc}\p{L}\/.]){1,4}  # followed by same block as symbol block
1533
1532
            |(?:\d+[\p{P}\s]?){1,4}    # or by same block as digits block
1534
    ## If the last grouping of digits is more than 2 characters, assume there is no decimal value and put it back.
1533
            )
1535
    my $decimal = pop( @parts );
1534
            \s?\p{L}{0,4}\s?           # followed or not by a whitespace. \p{L}{0,4}\s? are for cases like '$9.50 USD'
1536
    if ( length( $decimal ) > 2 ) {
1535
            )                          # end of capturing parenthesis
1537
        push( @parts, $decimal );
1536
            (?:\p{P}|\z)               # followed by a punctuation sign or by the end of the string
1538
        $decimal = '';
1537
            /gx);
1539
    }
1538
1540
1539
        if ( @matches ) {
1541
    $price = join('', @parts );
1540
            foreach ( @matches ) {
1542
1541
                $localprice = $_ and last if index($_, $isocode)>=0;
1543
    if ( $decimal ) {
1542
            }
1544
     $price .= ".$decimal";
1543
            if ( !$localprice ) {
1544
                foreach ( @matches ) {
1545
                    $localprice = $_ and last if $_=~ /(^|[^\p{Sc}\p{L}\/])\Q$symbol\E([^\p{Sc}\p{L}\/]+\z|\z)/;
1546
                }
1547
            }
1548
        }
1545
    }
1549
    }
1546
1550
    if ( $localprice ) {
1551
        $price = $localprice;
1552
    } else {
1553
        ## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator )
1554
        ( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/;
1555
    }
1556
    # eliminate symbol/isocode, space and any final dot from the string
1557
    $price =~ s/[\p{Sc}\p{L}\/ ]|\.$//g;
1558
    # remove comma,dot when used as separators from hundreds
1559
    $price =~s/[\,\.](\d{3})/$1/g;
1560
    # convert comma to dot to ensure correct display of decimals if existing
1561
    $price =~s/,/./;
1547
    return $price;
1562
    return $price;
1548
}
1563
}
1549
1564
(-)a/admin/currency.pl (-2 / +5 lines)
Lines 185-190 sub add_validate { Link Here
185
    my $rec = {
185
    my $rec = {
186
        rate     => $input->param('rate'),
186
        rate     => $input->param('rate'),
187
        symbol   => $input->param('symbol') || q{},
187
        symbol   => $input->param('symbol') || q{},
188
        isocode  => $input->param('isocode') || q{},
188
        active   => $input->param('active') || 0,
189
        active   => $input->param('active') || 0,
189
        currency => $input->param('currency'),
190
        currency => $input->param('currency'),
190
    };
191
    };
Lines 198-217 sub add_validate { Link Here
198
        {}, $input->param('currency') );
199
        {}, $input->param('currency') );
199
    if ($row_count) {
200
    if ($row_count) {
200
        $dbh->do(
201
        $dbh->do(
201
q|UPDATE currency SET rate = ?, symbol = ?, active = ? WHERE currency = ? |,
202
q|UPDATE currency SET rate = ?, symbol = ?, isocode = ?, active = ? WHERE currency = ? |,
202
            {},
203
            {},
203
            $rec->{rate},
204
            $rec->{rate},
204
            $rec->{symbol},
205
            $rec->{symbol},
206
            $rec->{isocode},
205
            $rec->{active},
207
            $rec->{active},
206
            $rec->{currency}
208
            $rec->{currency}
207
        );
209
        );
208
    } else {
210
    } else {
209
        $dbh->do(
211
        $dbh->do(
210
q|INSERT INTO currency (currency, rate, symbol, active) VALUES (?,?,?,?) |,
212
q|INSERT INTO currency (currency, rate, symbol, isocode, active) VALUES (?,?,?,?,?) |,
211
            {},
213
            {},
212
            $rec->{currency},
214
            $rec->{currency},
213
            $rec->{rate},
215
            $rec->{rate},
214
            $rec->{symbol},
216
            $rec->{symbol},
217
            $rec->{isocode},
215
            $rec->{active}
218
            $rec->{active}
216
        );
219
        );
217
220
(-)a/installer/data/mysql/kohastructure.sql (+1 lines)
Lines 716-721 DROP TABLE IF EXISTS `currency`; Link Here
716
CREATE TABLE `currency` (
716
CREATE TABLE `currency` (
717
  `currency` varchar(10) NOT NULL default '',
717
  `currency` varchar(10) NOT NULL default '',
718
  `symbol` varchar(5) default NULL,
718
  `symbol` varchar(5) default NULL,
719
  `isocode` varchar(5) default NULL,
719
  `timestamp` timestamp NOT NULL default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
720
  `timestamp` timestamp NOT NULL default CURRENT_TIMESTAMP on update CURRENT_TIMESTAMP,
720
  `rate` float(15,5) default NULL,
721
  `rate` float(15,5) default NULL,
721
  `active` tinyint(1) default NULL,
722
  `active` tinyint(1) default NULL,
(-)a/installer/data/mysql/updatedatabase.pl (+7 lines)
Lines 8202-8207 if ( CheckVersion($DBversion) ) { Link Here
8202
    SetVersion($DBversion);
8202
    SetVersion($DBversion);
8203
}
8203
}
8204
8204
8205
$DBversion = "3.15.00.XXX";
8206
if ( CheckVersion($DBversion) ) {
8207
    $dbh->do("ALTER TABLE currency ADD isocode VARCHAR(5) default NULL AFTER symbol;");
8208
    print "Upgrade to $DBversion done (Added isocode to the currency table)\n";
8209
    SetVersion($DBversion);
8210
}
8211
8205
=head1 FUNCTIONS
8212
=head1 FUNCTIONS
8206
8213
8207
=head2 TableExists($table)
8214
=head2 TableExists($table)
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/currency.tt (-2 / +8 lines)
Lines 46-52 Link Here
46
<div id="bd">
46
<div id="bd">
47
    <div id="yui-main">
47
    <div id="yui-main">
48
    <div class="yui-b">
48
    <div class="yui-b">
49
49
<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/>
50
The symbol may be the pure currency sign or a string in which it's included ( like '$US' ).</p></div>
50
[% IF ( else ) %]
51
[% IF ( else ) %]
51
<div id="toolbar" class="btn-toolbar">
52
<div id="toolbar" class="btn-toolbar">
52
    <a class="btn btn-small" id="newcurrency" href="[% script_name %]?op=add_form"><i class="icon-plus"></i> New currency</a>
53
    <a class="btn btn-small" id="newcurrency" href="[% script_name %]?op=add_form"><i class="icon-plus"></i> New currency</a>
Lines 81-87 Link Here
81
            <label for="symbol" class="required">Symbol: </label>
82
            <label for="symbol" class="required">Symbol: </label>
82
            <input type="text" name="symbol" id="symbol" size="5" maxlength="5" value="[% symbol %]" required="required" class="required" /> <span class="required">Required</span>
83
            <input type="text" name="symbol" id="symbol" size="5" maxlength="5" value="[% symbol %]" required="required" class="required" /> <span class="required">Required</span>
83
        </li>
84
        </li>
84
85
        <li>
86
            <label for="isocode" class="required">Iso code: </label>
87
            <input type="text" name="isocode" id="isocode" size="5" maxlength="5" value="[% isocode %]" required="required"  class="required" /> <span class="required">Required</span>
88
        </li>
85
        <li>
89
        <li>
86
            <span class="label">Last updated: </span>[% timestamp %]
90
            <span class="label">Last updated: </span>[% timestamp %]
87
        </li>
91
        </li>
Lines 161-166 Link Here
161
            <th>Currency</th>
165
            <th>Currency</th>
162
            <th>Rate</th>
166
            <th>Rate</th>
163
            <th>Symbol</th>
167
            <th>Symbol</th>
168
            <th>Iso code</th>
164
            <th>Last updated</th>
169
            <th>Last updated</th>
165
            <th>Active</th>
170
            <th>Active</th>
166
            <th colspan="2">Actions&nbsp;</th>
171
            <th colspan="2">Actions&nbsp;</th>
Lines 174-179 Link Here
174
            <td>[% loo.currency %]</td>
179
            <td>[% loo.currency %]</td>
175
            <td>[% loo.rate %]</td>
180
            <td>[% loo.rate %]</td>
176
            <td>[% loo.symbol |html %]</td>
181
            <td>[% loo.symbol |html %]</td>
182
            <td>[% loo.isocode |html %]</td>
177
            <td>[% loo.timestamp %]</td>
183
            <td>[% loo.timestamp %]</td>
178
            <td style="color:green;">[% IF ( loo.active ) %]✓[% END %]</td>
184
            <td style="color:green;">[% IF ( loo.active ) %]✓[% END %]</td>
179
            <td><a href="[% loo.script_name %]?op=add_form&amp;searchfield=[% loo.currency %]">Edit</a></td>
185
            <td><a href="[% loo.script_name %]?op=add_form&amp;searchfield=[% loo.currency %]">Edit</a></td>
(-)a/t/db_dependent/MungeMarcPrice.t (-1 / +57 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
use strict;
4
use warnings;
5
use C4::Biblio;
6
use C4::Budgets;
7
use Test::More;
8
use utf8;
9
10
# work around wide character warnings
11
binmode Test::More->builder->output, ":encoding(UTF-8)";
12
binmode Test::More->builder->failure_output, ":encoding(UTF-8)";
13
14
# start transaction
15
my $dbh = C4::Context->dbh;
16
$dbh->{AutoCommit} = 0;
17
$dbh->{RaiseError} = 1;
18
19
# set some test price strings and expected output
20
my @prices2test=( { string => '25,5 £, $34,55, $LD35',       expected => '34.55' },
21
                  { string => '32 EUR, 42.50$ USD, 54 CAD',  expected=>'42.50' },
22
                  { string => '38.80 Ksh, ¥300, 51,50 USD',  expected => '51.50' },
23
                  { string => '44 $, 33 €, 64 Br, £30',      expected => '44' },
24
                  { string => '9 EUR,$34,55 USD,$7.35 CAN',  expected => '34.55' },
25
                  { string => '$55.32',                      expected => '55.32' },
26
                  { string => '9.99 USD (paperback)',        expected => '9.99' },
27
                  { string => '$9.99 USD (paperback)',       expected => '9.99' },
28
                  { string => '18.95 (U.S.)',                expected => '18.95' },
29
                  { string => '$5.99 ($7.75 CAN)',           expected => '5.99' },
30
                  { string => '5.99 (7.75 CAN)',             expected => '5.99' },
31
                );
32
33
plan tests => scalar  @prices2test;
34
35
# set active currency test data
36
my $CURRENCY = 'TEST';
37
my $SYMBOL = '$';
38
my $ISOCODE = 'USD';
39
my $RATE= 1;
40
41
# disables existing active currency if necessary.
42
my $active_currency = C4::Budgets->GetCurrency();
43
my $curr;
44
if ($active_currency) {
45
    $curr = $active_currency->{'currency'};
46
    $dbh->do("UPDATE currency set active = 0 where currency = '$curr'");
47
}
48
49
$dbh->do("INSERT INTO currency ( currency,symbol,isocode,rate,active )
50
          VALUES ('$CURRENCY','$SYMBOL','$ISOCODE','$RATE',1)");
51
foreach my $price (@prices2test) {
52
    my $mungemarcprice=MungeMarcPrice($price->{'string'});
53
    my $expected=$price->{'expected'};
54
    ok ($mungemarcprice eq $expected, "must return $price->{'expected'} from initial string : $price->{'string'}");
55
}
56
# Cleanup
57
$dbh->rollback;

Return to bug 9593