|
Lines 1466-1471
sub GetMarcPrice {
Link Here
|
| 1466 |
for my $subfield_value ($field->subfield($subfield)){ |
1466 |
for my $subfield_value ($field->subfield($subfield)){ |
| 1467 |
#check value |
1467 |
#check value |
| 1468 |
$subfield_value = MungeMarcPrice( $subfield_value ); |
1468 |
$subfield_value = MungeMarcPrice( $subfield_value ); |
|
|
1469 |
( $subfield_value ) = $subfield_value =~ m/(\d[\d\,\. ]*\d{0,2})/; |
| 1470 |
# remove comma,dot or space when used as separators from hundreds |
| 1471 |
$subfield_value =~s/[\,\. ](\d{3})/$1/; |
| 1472 |
# convert comma to dot to ensure correct display of decimals if existing |
| 1473 |
$subfield_value =~s/,/./; |
| 1469 |
return $subfield_value if ($subfield_value); |
1474 |
return $subfield_value if ($subfield_value); |
| 1470 |
} |
1475 |
} |
| 1471 |
} |
1476 |
} |
|
Lines 1479-1517
Return the best guess at what the actual price is from a price field.
Link Here
|
| 1479 |
|
1484 |
|
| 1480 |
sub MungeMarcPrice { |
1485 |
sub MungeMarcPrice { |
| 1481 |
my ( $price ) = @_; |
1486 |
my ( $price ) = @_; |
| 1482 |
|
|
|
| 1483 |
return unless ( $price =~ m/\d/ ); ## No digits means no price. |
1487 |
return unless ( $price =~ m/\d/ ); ## No digits means no price. |
| 1484 |
|
1488 |
# Look for the currency symbol and the normalized code of the active currency, if it's there, |
| 1485 |
## Look for the currency symbol of the active currency, if it's there, |
1489 |
my $active_currency = C4::Budgets->GetCurrency(); |
| 1486 |
## start the price string right after the symbol. This allows us to prefer |
1490 |
my $symbol = $active_currency->{'symbol'}; |
| 1487 |
## this native currency price over other currency prices, if possible. |
1491 |
my $isocode = $active_currency->{'isocode'}; |
| 1488 |
my $active_currency = C4::Context->dbh->selectrow_hashref( 'SELECT * FROM currency WHERE active = 1', {} ); |
1492 |
my $localprice; |
| 1489 |
my $symbol = quotemeta( $active_currency->{'symbol'} ); |
1493 |
if ( $isocode and $price=~/[A-Z]{3}/ ) { |
| 1490 |
if ( $price =~ m/$symbol/ ) { |
1494 |
$price =~ s/\p{Currency_Symbol}//g; # in case price look like '$800 LRD, $10 USD'. |
| 1491 |
my @parts = split(/$symbol/, $price ); |
1495 |
# find if the currency code precedes or follows the numeric part of price |
| 1492 |
$price = $parts[1]; |
1496 |
if ( substr($price,0,1) =~/\s*[0-9]/ ) { |
| 1493 |
} |
1497 |
($localprice)=$price =~ /([\p{P}\d\s]+$isocode)/; |
| 1494 |
|
1498 |
} else { |
| 1495 |
## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator ) |
1499 |
($localprice)=$price =~ /($isocode[\p{P}\d\s]+)/; |
| 1496 |
( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/; |
1500 |
} |
| 1497 |
|
|
|
| 1498 |
## Split price into array on periods and commas |
| 1499 |
my @parts = split(/[\,\.]/, $price); |
| 1500 |
|
| 1501 |
## If the last grouping of digits is more than 2 characters, assume there is no decimal value and put it back. |
| 1502 |
my $decimal = pop( @parts ); |
| 1503 |
if ( length( $decimal ) > 2 ) { |
| 1504 |
push( @parts, $decimal ); |
| 1505 |
$decimal = ''; |
| 1506 |
} |
1501 |
} |
| 1507 |
|
1502 |
if ( !$localprice and $symbol ) { |
| 1508 |
$price = join('', @parts ); |
1503 |
if ( substr($price,0,1) =~/\s*[0-9]/ ) { |
| 1509 |
|
1504 |
($localprice)=$price =~ /([\p{P}\d\s]+\Q$symbol\E)/; |
| 1510 |
if ( $decimal ) { |
1505 |
} else { |
| 1511 |
$price .= ".$decimal"; |
1506 |
($localprice)=$price =~ /(\Q$symbol\E[\p{P}\d\s]+)/; |
|
|
1507 |
} |
| 1512 |
} |
1508 |
} |
| 1513 |
|
1509 |
$localprice||= $price; |
| 1514 |
return $price; |
1510 |
return $localprice; |
| 1515 |
} |
1511 |
} |
| 1516 |
|
1512 |
|
| 1517 |
|
1513 |
|