Lines 1483-1537
sub GetMarcPrice {
Link Here
|
1483 |
for my $field ( $record->field(@listtags) ) { |
1483 |
for my $field ( $record->field(@listtags) ) { |
1484 |
for my $subfield_value ($field->subfield($subfield)){ |
1484 |
for my $subfield_value ($field->subfield($subfield)){ |
1485 |
#check value |
1485 |
#check value |
1486 |
$subfield_value = MungeMarcPrice( $subfield_value ); |
1486 |
( $subfield_value ) = $subfield_value =~ m/(\d[\d\,\. ]*\d{0,2})/; |
|
|
1487 |
# remove comma,dot or space when used as separators from hundreds |
1488 |
$subfield_value =~s/[\,\. ](\d{3})/$1/; |
1489 |
# convert comma to dot to ensure correct display of decimals if existing |
1490 |
$subfield_value =~s/,/./; |
1487 |
return $subfield_value if ($subfield_value); |
1491 |
return $subfield_value if ($subfield_value); |
1488 |
} |
1492 |
} |
1489 |
} |
1493 |
} |
1490 |
return 0; # no price found |
1494 |
return 0; # no price found |
1491 |
} |
1495 |
} |
1492 |
|
1496 |
|
1493 |
=head2 MungeMarcPrice |
|
|
1494 |
|
1495 |
Return the best guess at what the actual price is from a price field. |
1496 |
=cut |
1497 |
|
1498 |
sub MungeMarcPrice { |
1499 |
my ( $price ) = @_; |
1500 |
|
1501 |
return unless ( $price =~ m/\d/ ); ## No digits means no price. |
1502 |
|
1503 |
## Look for the currency symbol of the active currency, if it's there, |
1504 |
## start the price string right after the symbol. This allows us to prefer |
1505 |
## this native currency price over other currency prices, if possible. |
1506 |
my $active_currency = C4::Context->dbh->selectrow_hashref( 'SELECT * FROM currency WHERE active = 1', {} ); |
1507 |
my $symbol = quotemeta( $active_currency->{'symbol'} ); |
1508 |
if ( $price =~ m/$symbol/ ) { |
1509 |
my @parts = split(/$symbol/, $price ); |
1510 |
$price = $parts[1]; |
1511 |
} |
1512 |
|
1513 |
## Grab the first number in the string ( can use commas or periods for thousands separator and/or decimal separator ) |
1514 |
( $price ) = $price =~ m/([\d\,\.]+[[\,\.]\d\d]?)/; |
1515 |
|
1516 |
## Split price into array on periods and commas |
1517 |
my @parts = split(/[\,\.]/, $price); |
1518 |
|
1519 |
## If the last grouping of digits is more than 2 characters, assume there is no decimal value and put it back. |
1520 |
my $decimal = pop( @parts ); |
1521 |
if ( length( $decimal ) > 2 ) { |
1522 |
push( @parts, $decimal ); |
1523 |
$decimal = ''; |
1524 |
} |
1525 |
|
1526 |
$price = join('', @parts ); |
1527 |
|
1528 |
if ( $decimal ) { |
1529 |
$price .= ".$decimal"; |
1530 |
} |
1531 |
|
1532 |
return $price; |
1533 |
} |
1534 |
|
1535 |
|
1497 |
|
1536 |
=head2 GetMarcQuantity |
1498 |
=head2 GetMarcQuantity |
1537 |
|
1499 |
|
1538 |
- |
|
|