package Locale::Formatmoney; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(format_money); @EXPORT_OK = qw(%monetary_presentation, %monetary_specific); $Locale::Formatmoney::VERSION = '0.9'; use vars qw($VERSION %monetary_presentation %monetary_specific); use strict; BEGIN { # please use ISO 639 two letter language codes %monetary_presentation=( 'fr' , { 'sep_decimal' => ',', 'sep_milliers' => ' ', }, 'en' , { 'sep_decimal' => '.', 'sep_milliers' => ',', }, ); %monetary_specific=( 'frf' , { 'abrevated_name' => 'FRF', 'long_name' => 'franc', 'long_names' => 'francs', 'apres_virgule' => 2 }, 'eur' , { 'abrevated_name' => 'EUR', 'long_name' => 'euro', 'long_names' => 'euros', 'apres_virgule' => 2 }, ); } # format_money amount language money [ long_name ] # The result is a string following the local convention, for exemple: # format_money(123456789.123457, 'fr', 'frf', 0)="123 456 789,12 FRF" # amount: a reel number # language: the country of the reader (see %monetary_presentation) # money: the money of the amount (see %monetary_specific) # long_name: do we print the money with the long name (1) or with the # abreviation (0), default is 0 sub format_money { my $amount=shift; my $langue=shift; my $money=shift; my $long_name= scalar(@_) ? shift : 0; my $sign=1; my $currency; exists $monetary_presentation{$langue} or die("convertion: language \"$langue\" does'nt exists"); exists $monetary_specific{$money} or die("convertion: money \"$money\" does'nt exists"); my $sep_decimal=$monetary_presentation{$langue}->{'sep_decimal'}; my $sep_milliers=$monetary_presentation{$langue}->{'sep_milliers'}; my $apres_virgule=$monetary_specific{$money}->{'apres_virgule'}; # what sign if($amount <0) { $sign=-1; $amount = - $amount; } # what currency if($long_name) { $currency=$monetary_specific{$money}->{'long_name' . ( $amount>=2 ? 's' : '' ) }; } else { $currency=$monetary_specific{$money}->{'abrevated_name'}; } my $r1=sprintf "%.${apres_virgule}f", $amount; my ($p1, $p2)=split(/\./,$r1); if($p2 =~ /\A0*\Z/) { $p2=""; } $p1=reverse($p1); $p1 =~ s/(...)/$1$sep_milliers/g; $p1 =~ s/$sep_milliers\Z//g; $p1=reverse($p1); my $result=$p1; if($p2 ne "") { $result .=$sep_decimal . $p2; } if($sign == -1) { $result = "-$result"; } $result .= " " . $currency; return $result; } 1; __END__ =head1 NAME Locale::Formatmoney::format_money - format an amount of money for output =head1 SYNOPSIS use Locale::Formatmoney; print format_money(-123456789.123457, 'fr', 'frf'), "\n"; =head1 DESCRIPTION Format an amount of money and return the result in a string. Two hash arrays are used to configure the output (%monetary_presentation and %monetary_specific). B The result is a string following the local convention, for exemple: format_money(123456789.123457, 'fr', 'frf', 0)="123 456 789,12 FRF" =over 4 =item amount a reel number =item language the country of the reader (fr or en), see %monetary_presentation to extend the choice. =item money the money of the amount (frf ou eur), see %monetary_specific to extend the choice. =item long_name do we print the money with the long name (1) or with the abreviation (0), default is 0 =back =head1 EXAMPLE print format_money(-123456789.123457, 'fr', 'frf'); will print "-123 456 789,12 FRF". =head1 BUGS There is problem with "cents", the sprintf function rouded off the amount and I don't control the result wich is BAD in my case: 0.045 -> "0,04 FRF" 0.005 -> "0,01 FRF" There are plenty other bugs and at least one with terrible concequances for you, you have been warned. =head1 AUTHOR AND COPYRIGHT Copyright Emmanuel Chantréau echant@maretamanu.org 1999, Distributed under the terms of the Gnu General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU General Public License for more details. =cut