Business::Shipping::Util - Miscellaneous functions


Business-Shipping documentation Contained in the Business-Shipping distribution.

Index


Code Index:

NAME

Top

Business::Shipping::Util - Miscellaneous functions

DESCRIPTION

Top

Misc functions.

METHODS

Top

* currency( $opt, $amount )

Formats a number for display as currency in the current locale (currently, the only locale supported is USD).

* unique( @ary )

Removes duplicates (but leaves at least one).

* looks_like_number( $scalar )

Shamelessly stolen from Scalar::Util 1.10 in order to reduce dependancies. Not part of the normal copyright.

uneval

Takes any built-in object and returns the perl representation of it as a string of text. It was copied from Interchange http://www.icdevgroup.org, written by Mike Heins <mike@perusion.com>.

AUTHOR

Top

Daniel Browning, db@kavod.com, http://www.kavod.com/

COPYRIGHT AND LICENCE

Top


Business-Shipping documentation Contained in the Business-Shipping distribution.
package Business::Shipping::Util;

use strict;
use warnings;
use base ('Exporter');
use Data::Dumper;
use Business::Shipping::Logging;
use Carp;
use File::Find;
use File::Copy;
use Fcntl ':flock';
use English;
use version; our $VERSION = qv('400');
use vars qw(@EXPORT_OK);

@EXPORT_OK = qw( looks_like_number unique );

sub currency {
    my ($opt, $amount) = @_;

    return unless $amount;
    $amount = sprintf("%.2f", $amount);
    $amount = "\$$amount" unless $opt->{no_format};

    return $amount;
}

sub unique {
    my (@ary) = @_;

    my %seen;
    my @unique;
    foreach my $item (@ary) {
        push(@unique, $item) unless $seen{$item}++;
    }

    return @unique;
}

sub looks_like_number {
    local $_ = shift;

    # checks from perlfaq4
    return $] < 5.009002 unless defined;
    return 1 if (/^[+-]?\d+$/);    # is a +/- integer
    return 1
        if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/);   # a C float
    return 1
        if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i)
        or ($] >= 5.006001 and /^Inf$/i);

    0;
}

sub uneval {
    my ($self, $o) = @_;    # recursive
    my ($r, $s, $key, $value);

    local ($^W) = 0;
    no warnings;            #supress 'use of unitialized values'

    $r = ref $o;
    if (!$r) {
        $o =~ s/([\\"\$@])/\\$1/g;
        $s = '"' . $o . '"';
    }
    elsif ($r eq 'ARRAY') {
        $s = "[";
        for my $i (0 .. $#$o) {
            $s .= uneval($o->[$i]) . ",";
        }
        $s .= "]";
    }
    elsif ($r eq 'HASH') {
        $s = "{";
        while (($key, $value) = each %$o) {
            $s .= "'$key' => " . uneval($value) . ",";
        }
        $s .= "}";
    }
    else {
        $s = "'something else'";
    }

    $s;
}

1;

__END__