=for gpg
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

=head1 NAME

Tie::Comma - A simple and easy way to format numbers with commas,
using a tied hash.

=head1 VERSION

This documentation describes version 0.04 of Tie::Comma, January 07, 2005

=cut

use strict;
package Tie::Comma;
$Tie::Comma::VERSION = 0.04;

use Exporter;
use vars qw/@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %comma/;
@ISA       = qw/Exporter/;
@EXPORT    = qw/%comma/;
@EXPORT_OK = qw/commify/;
%EXPORT_TAGS = (all => [@EXPORT, @EXPORT_OK]);

# Defaults
our $thou_sep = ',';
our $deci_sep = '.';
our $grouping = 3;

# Configure for locale, if possible.
eval
{
    require POSIX;
    my $loc = POSIX::setlocale(POSIX::LC_NUMERIC());
    my $lc  = POSIX::localeconv();
    $thou_sep = $lc->{thousands_sep} || $thou_sep;
    $deci_sep = $lc->{decimal_point} || $deci_sep;
    $grouping = $lc->{grouping}? unpack('c', $lc->{grouping}) : $grouping;
};   # Ignore any errors in this block -- just fall back to the defaults.

# Substitution pattern
my $num_pat = "(" . ("\\d" x $grouping) . ")(?=\\d)(?!\\d*\\$deci_sep)";
my $num_re  = qr/$num_pat/;

# Here's the statement that makes it all happen.
tie our %comma, 'Tie::Comma';

# Delay loading Carp.pm until needed.
sub Tie::Comma::croak
{
    require Carp;
    goto &Carp::croak;
}

#--->     $string = commify $number;
# commify : Formats a number with commas.
# This version is taken from the Perl Cookbook.
sub commify ($)
{
    my $rev_num = reverse shift;  # The number to be formatted, reversed.
    $rev_num =~ s/$num_re/$1$thou_sep/g;
    return scalar reverse $rev_num;
}

sub TIEHASH
{
    my $class = shift;
    my $dummy;   # not used, but we need a reference.
    bless \$dummy, $class;
}

sub FETCH
{
    my $self = shift;
    my $key  = shift;
    return '' if !defined $key;    # No args? or undef? return empty string.

    my @args = split $;, $key, -1;
    @args > 3  and Tie::Comma::croak "Too many arguments to %comma";
    my ($num, $dp, $min_fw) = @args;

    for ($dp, $min_fw)
    {
        next unless defined;
        next unless length;
        s/\Q$deci_sep\E.*//o;  # remove any fractional part
        $_ = 0 unless /^-?\d+$/;
    }
    $min_fw = 0  if (!defined $min_fw  or  length $min_fw == 0);

    # Caller specified number of decimal places?
    if (defined $dp  &&  length $dp)
    {
        Tie::Comma::croak "Negative decimal places in %comma" if $dp < 0;
        $dp = abs($dp);
        $num = sprintf "%.${dp}f", $num;
    }

    my $cnum = commify $num;

    # Pad, if necessary.
    return $cnum if length $cnum >= abs($min_fw);
    my $spaces = ' ' x (abs($min_fw) - length $cnum);
    return $min_fw < 0?  "$cnum$spaces" : "$spaces$cnum";
}

use subs qw(
 STORE    EXISTS    CLEAR    FIRSTKEY    NEXTKEY  );
*STORE = *EXISTS = *CLEAR = *FIRSTKEY = *NEXTKEY = sub
{
    Tie::Comma::croak "Invalid call to Tie::Comma internal function";
};


1;
__END__

=head1 SYNOPSIS

 # The usual case; formatting with commas.
 $comma{$number};

 # Format with commas, and to a given number of places.
 $comma{$number, $decimal_places};

 # Format as above, with a minimum field width (right-justified).
 $comma{$number, $decimal_places, $minimum_field_width};

=head1 DESCRIPTION

This module provides a global read-only hash, C<%comma>, for
formatting numbers with commas.  The tied-hash idiom is quite useful,
since you can use it within a string as easily as outside a string.

The C<%comma> hash may be "passed" one to three "arguments".

=over 4

=item One-argument form

I<$string>C< = $comma{>I<$number>C<};>

Formats I<$number> with commas.

=item Two-argument form

I<$string>C< = $comma{>I<$number>C<, >I<$decimals>C<};>

Formats I<$number> with commas and I<$decimals> decimal places.

=item Three-argument form

I<$string>C< = $comma{>I<$number>C<, >I<$decimals>C<, >I<$min_width>C<};>

Formats I<$number> with commas and I<$decimals> decimal places, and
pads it with spaces on the left (right-justifying the number) so it
takes up at least I<$min_width> characters.  If I<$decimals> is undef,
the I<$number> is formatted with commas but not to any particular
number of decimal places.

=back

=head1 EXAMPLES

 # Simple formatting with commas:
 $a = 1234567.89;
 print "With commas: $comma{$a}";      => "With commas: 1,234,567.89"

 # Specify number of decimal places:
 print "1 decimal:   $comma{$a,1}";    => "1 decimal:   1,234,567.9"
 print "3 decimals:  $comma{$a,3}";    => "3 decimals:  1,234,567.890"

 # Specify field width:
 print "Min width:  '$comma{$a,0,12}'" => "Min width:  '   1,234,568'

 # In-string computations:
 print "Seconds in a year: $comma{365 * 24 * 60 * 60}";
    => "Seconds in a year: 31,536,000";

=head1 EXPORTS

Exports C<%comma>.

=head1 REQUIREMENTS

Uses L<Carp> and L<Exporter>, which of course come with Perl.

=head1 SEE ALSO

Mark Dominus's excellent L<Interpolation> module, which provides a
much more general solution than this special-purpose module.

=head1 AUTHOR / COPYRIGHT

Eric J. Roode, roode@cpan.org

Copyright (c) 2005 by Eric J. Roode.  All Rights Reserved.
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

=begin gpg

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.6 (Cygwin)

iD8DBQFB3vj7Y96i4h5M0egRAmzGAKD3Thxv9VBwn7hcEreDk9d1tTZECQCg2XzZ
KxQ8kPcRx3aVrAE9bAIcjho=
=rZq3
-----END PGP SIGNATURE-----

=end gpg