package Units::Height::DWIM;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter);
@EXPORT_OK = qw(
	height2metric
    parse_height
    pretty_height
);
$VERSION = '0.01';

my $FEET2METERS=0.3048;
my $INCHES2METERS=0.0254;

#########################################################################
sub height2metric
{
    my($height)=@_;
    return (parse_height($height))[0];
}

#########################################################################
sub parse_height
{
    my($height)=@_;
    my $units='metric';
    my $meters;

    $height=~s/^\s//;           # strip leading and tailing
    $height=~s/\s$//;

    if($height=~/^(\d+([,\.]\d*)?)$/) { # 3, 120, 1.4, 1,4 (ie, in french)
        $meters=$1;
        $meters=~tr/,/./ if $2;
        if($meters <= 3) {                       # in meters
            # leave as is
        }
        elsif($meters <= 10) {                  # acutally imperial
            $units="imperial";
            $meters *= $FEET2METERS;
        }
        else {                                  # in cm
            $meters /= 100;                     # convert to meters
        }
    }
    elsif($height =~ /^(\d)'((\d+)"?)?$/) {        # 6' 6'1 5'3"
        $units="imperial";
        $meters=$1*$FEET2METERS + ($3||0)*$INCHES2METERS;
    }

    return ($meters, $units);
}

#########################################################################
sub pretty_height
{
    my($height, $units)=@_;

    if($units eq 'cm' or $units eq 'centimeters') {
        return int($height*100+0.5);
    }
    elsif($units eq 'm' or $units eq 'meters' or $units eq 'metric') {
        return sprintf "%.2f", $height;
    }
    elsif($units ne 'imperial') {
        return;
    }

    my($feet, $inch)=(0,0);

    $inch=$height / $INCHES2METERS + 0.5;
    if($inch > 12) {
        $feet=int($inch/12);
        $inch-=$feet*12;
    }
    $inch=int $inch;

    my $ret='';
    $ret.=qq($feet\') if $feet;
    $ret.=qq($inch\") if $inch;
    return $ret;
}

1;
__END__

=head1 NAME

Units::Height::DWIM - Parses heights of people

=head1 SYNOPSIS

    use Units::Height::DWIM qw(parse_height height2metric);

    my($meters, $system)=parse_height($some_text);
    die "Unable to parse $some_text\n" unless defined $meters;
    print "$some_text is $meters meters in $system units";

    $meters=height2metric("6'3");
    print "6 foot 3 is $meters meters\n";

    

=head1 DESCRIPTION

This module parses text and attemps to extract a height.  It assumes you
are looking at a human height.  The following forms are accepted:

    Feet and inches:
    3
    4'
    4'10
    5'3"

    Centimeters:
    120

    Meters:
    1.35
    1,5
    2    

=head1 FUNCTIONS

=head2 parse_height

    my($meters, $system)=height2meters($some_string);

Attemps to parse C<$some_string> and returns C<undef()> if it can't.  The
height in meters.  C<$system> is one of C<imperial> or C<metric>, depending
on wether C<$some_string> was in metric or not.

Parsing a lone number can be ambiguous.  Any number smaller than 3 is
assumed to be in meters.  Any number between 3 and 10 is assumed to be feet.
Any number greater then 10 is assumed to be centimeters.  This means that

    3 is 3 meters
    3.1 is 3.1 feet (ie 0.94488 meters)
    6 is 6 feet (ie 1.8288 meters)
    10 is 10 feet (ie 3.048 meters)
    10.1 is 10.1 cm (ie 0.101 meters)
    130 is 130 cm (ie 1.3 meters)

Also, this means you will have to be smart if you want people to input the
height of their small children.



=head2 pretty_height

    print pretty_height($meters, $unit);

Converts the height C<$meters> into a I<pretty-printed> string.
C<$unit> can be one of 'metric' or 'm' (in which case the height is returned
with 2 digits after the decimal), 'centimeter' or 'cm' (in which case the
height is multiplied by 100 and rounded) , or 'imperial' (in which case the
height is returned in either feet' or feet'inches" format).





=head2 height2meters

    my $meters=height2meters($some_string);

Parses C<$some_string> and returns the height in meters, or C<undef()> if
C<$some_string> can't be parsed.






=head1 AUTHOR


Philip Gwyn, perl at pied.nu

=head1 SEE ALSO

perl(1).

=cut