fix infinite loop with empty comma
[bse.git] / site / cgi-bin / modules / BSE / Util / Format.pm
1 package BSE::Util::Format;
2 use strict;
3
4 our $VERSION = "1.002";
5
6 =head1 NAME
7
8 BSE::Util::Format - formatting tools
9
10 =head1 SYNOPSIS
11
12   # from perl
13   use BSE::Util::Format;
14   my $formatted = BSE::Util::Format::bse_numner($format, $value)
15
16   # from templates
17   <:number "money" [some value ] :>
18   <:= bse.number("money", value) :>
19
20 =head1 FUNCTIONS
21
22 =over
23
24 =item bse_number(format, value, cfg)
25
26 Format a number per rules defined in the config file.
27
28 This uses configuration from section C<< [ number I<format>] >>, so
29 formatting for format C<money> is defined by section
30 C<<[number money]>>.
31
32 Configuration parameters:
33
34 =over
35
36 =item *
37
38 C<comma> - the string to use in adding comma separators to numbers.
39 Default: C<,>.
40
41 =item *
42
43 C<comma_limit> - numbers smaller than this are not commified.
44 Default: C<1000>.
45
46 =item *
47
48 C<commify> - set to 0 to disable commification.  Default: 1.
49
50 =item *
51
52 C<decimal> - decimal point.  Default: C<.>
53
54 =item *
55
56 C<divisor> - value to divide the value by before formatting.
57 eg. C<100> to express a number in cents in dollars.  Must be non-zero.
58 Default: 1.
59
60 =item *
61
62 C<places> - the number of decimal places to force after the decimal
63 point.  If negative the natural number of places are used.  Default: -1.
64
65 =back
66
67 =cut
68
69 sub bse_number {
70   my ($format, $value, $cfg) = @_;
71
72   $cfg ||= BSE::Cfg->single;
73   my $section = "number $format";
74   my $comma_sep = $cfg->entry($section, "comma", ",");
75   $comma_sep =~ s/^"(.*)"$/$1/;
76   $comma_sep =~ /\w/ and return "* comma cannot be a word character *";
77   my $comma_limit = $cfg->entry($section, "comma_limit", 1000);
78   my $commify = $cfg->entry($section, "commify", 1);
79   my $dec_sep = $cfg->entry($section, "decimal", ".");
80   my $div = $cfg->entry($section, "divisor", 1)
81     or return "* divisor must be non-zero *";
82   my $places = $cfg->entry($section, "places", -1);
83
84   my $div_value = $value / $div;
85   my $formatted = $places < 0 ? $div_value : sprintf("%.*f", $places, $div_value);
86
87   my ($int, $frac) = split /\./, $formatted;
88   if ($commify && $int >= $comma_limit && $comma_sep ne "") {
89     1 while $int =~ s/([0-9])([0-9][0-9][0-9]\b)/$1$comma_sep$2/;
90   }
91
92   if (defined $frac) {
93     return $int . $dec_sep . $frac;
94   }
95   else {
96     return $int;
97   }
98 }
99
100 1;
101
102 =back
103
104 =head1 AUTHOR
105
106 Tony Cook <tony@develop-help.com>
107
108 =cut