File Coverage

blib/lib/Acme/Numbers.pm

Criterion	Covered	Total	%
statement	77	81	95.0
branch	31	34	91.1
condition	28	32	87.5
subroutine	12	15	80.0
pod	5	5	100.0
total	153	167	91.6

package Acme::Numbers;
use strict;
use Lingua::EN::Words2Nums qw(words2nums);
our $AUTOLOAD;
our $VERSION = '1.2';


=head1 NAME

Acme::Numbers - a fluent numeric interface

=head1 SYNOPSIS

    use Acme::Numbers;

    print one."\n";                       # prints 1
    print two.hundred."\n";               # prints 200
    print forty.two."\n";                 # prints 42
    print six.hundred.and.sixty.six."\n"; # prints 666
    print one.million."\n";               # prints 1000000

    print three.point.one.four."\n";      # prints 3.14
    print one.point.zero.two."\n";        # prints 1.02
    print zero.point.zero.five."\n";      # prints 0.05

    print four.pounds."\n";               # prints "4.00"
    print four.pounds.five."\n";          # prints "4.05"
    print four.pounds.fifty."\n";         # prints "4.50"
    print four.pounds.fifty.five."\n";    # prints "4.55"

    print fifty.pence."\n";               # prints "0.50"
    print fifty.five.pence."\n";          # prints "0.55"
    print four.pounds.fifty.pence."\n";   # prints "4.50"
    print four.pounds.and.fifty.p."\n";   # prints "4.50"

    print fifty.cents."\n";               # prints "0.50"
    print fifty.five.cents."\n";          # prints "0.55"
    print four.dollars.fifty.cents."\n";  # prints "4.55"



=head1 DESCRIPTION

Inspired by this post

http://beautifulcode.oreillynet.com/2007/12/the_cardinality_of_a_fluent_in.php

and a burning curiosity. At leats, I hope the burning
was curiosity.

=head1 ONE BIIIIIIIIIIIILLION

By default billion is 10**12 because, dammit, that's right.

If you want it to be an American billion then do

    use Acme::Numbers billion => 10**9;

Setting this automatically changes all the larger numbers
(trillion, quadrillion, etc) to match.

=head1 METHODS

You should never really use these methods on the class directly.

All numbers handled by C are handled by this module.

In addition ...

=cut

sub import {
    my $class = shift;
    my %opts  = @_;

    $opts{billion} = 10**12 unless defined $opts{billion};
    no strict 'refs';
    no warnings 'redefine';
    my ($pkg, $file) = caller;
    $Lingua::EN::Words2Nums::billion = $opts{billion};
    foreach my $num ((keys %Lingua::EN::Words2Nums::nametosub,
                      'and', 'point', 'zero',
                      'pound', 'pounds', 'pence', 'p',
                      'dollars', 'cents'))
    {
        *{"$pkg\::$num"} = sub { $class->$num };
    }
};



=head2 new

C can be 'num', 'and' or 'point'

=cut

sub new {
    my $class = shift;
    $class = ref $class if ref $class;
    my $val   = shift;
    my $op    = shift;
    my $name  = shift || $op;
    bless { value => $val, operator => $op, name => $name }, $class;
}

=head2 name

The name of this object (i.e the method that was originally called).

=cut

sub name {
	return $_[0]->{name};
}

=head2 value

The current numeric value

=cut

sub value {
    my $self = shift;
    my $val = $self->{value};
    # if we're 'pence' then divide by 100 and then pretend we're pounds
    if ($self->{operator} =~ m!^p(ence)?$!) {
        # this fixes something where there's 0
        # pounds and a trailing zero like 0.50
        $self->{last_added} = $val;
        $val = $val/100;
        $self->{operator} = 'pounds';
    }
    if ($self->{operator} =~ m!^pounds?$!) {
        my ($num, $frac) = split /\./, $val;
        $frac ||= 0;
        # this also fixes 0 pounds trailing zero
        $frac = $self->{last_added} if defined $self->{last_added} && $self->{last_added}>$frac;
        # we substr to fix one.pound.fifty.pence which
        # leaves $frac as '500'
        $val  = sprintf("%d.%02d",$num,substr($frac,0,2));
    }

    return $val;
}

sub AUTOLOAD {
    my $self   = shift;
    my $method = $AUTOLOAD;
    $method    =~ s/.*://;   # strip fully-qualified portion
    my $val;
    # nasty override - we should probably have a
    # generic major or minor currency indicator
    # if we could store and propogate the currency
    # then we could also throw errors at mismatched
    # units e.g five.pounds.and.fifty.cents
    # but maybe also print out the correct sigil
    # e.g $5.50
    $method = 'pounds' if $method eq 'dollars';
    $method = 'pence'  if $method eq 'cents';

    # dummy methods
    if ($method eq 'and' || $method =~ m!^p!) {
        $val = $self->new(0, $method)
    } else {
        # bit of a hack here
        my $tmp = ($method eq 'zero')? 0 : words2nums($method);
        # maybe this should die
        return unless defined $tmp;
        $val = $self->new($tmp, 'num', $method);
    }

    # If we're the first number in the chain
    # then just return ourselves
    if (!ref $self) {
        return $val;
    } else {
        # Otherwise do the magic
        return $self->handle($val);
    }
}

=head2 handle

Handle putting these two objects together

=cut

sub handle {
    my ($self, $val) = @_;
    # If we haven't passed a pounds, pence or point marker
    if ($self->{operator} !~ m!^p!) {
        # If the new object is marker ...
        if ($val->{operator} =~ m!^p!) {
            # ... Just propogate along but make a note
            # A pound should not be overidden by a pence
            $self->{operator} = $val->{operator} unless $self->{operator} =~ m!^pounds?$!;
            return $self;

        # Otherwise ...
        } else {
            my $val = $val->{value};
            # If we're not currently adding and the new more than the old
            # e.g two.hundred then multiply
            if ($self->{value} < $val && $self->{operator} ne 'add') {
                $val *= $self->{value};
            # Otherwise add
            } else {
                $val += $self->{value};
            }
            return $self->new($val, 'num', $self->{operator});
        }
    } else { # point, pound, pence
        # first get the fractional part
        my ($num, $frac) = split /\./, $self->{value};
        #$frac ||= 0;
        # Cope with four.point.zero.four
        if ((defined $frac && $frac>0 && $frac<10) || $val->{value} == 0 || (defined $self->{last_added} and $self->{last_added} eq '0')) {
            $frac .= $val->{value};
        } else {
            $frac += $val->{value};
        }
        # Create the new object
        my $new = $self->new("${num}.${frac}", $self->{operator});
        # We use this to be able to do point.fifty.five and point.five.five
        $new->{last_added} = $val->{value};
        return $new;
    }
}

=head2 concat

Concatenate two things.

=cut

sub concat {
    my ($self, $new) = @_;
    my $class = shift;
    # If both objects are special numbers handle them
    if (ref($new) && $new->isa(__PACKAGE__)) {
        return $self->handle($new);
    # Otherwise stringify both and concat
    } else {
        return $self->value.$new;
    }
}

sub _bool {
    my ($self, $new, $op) = @_;
}

use overload '""'       => 'value',
             '+0'       => 'value',
             '.'        => 'concat';
#             'bool'     => 'bool';


sub DESTROY {}

1;