DateTime::Format::Baby - Parse and format baby-style time

  use DateTime::Format::Baby;

  my $Baby = DateTime::Format::Baby->new('en');
  my $dt = $Baby->parse_datetime('The big hand is on the twelve and the little hand is on the six.');

  $Baby->language('fr');

  # La grande aiguille est sur le douze et la petite aiguille est sur le six>
  $Baby->format_datetime($dt);

package DateTime::Format::Baby;

use strict;
use vars qw($VERSION);
use DateTime;
use Carp;

$VERSION = '0.15.3';

my %languages = (
    'en'      => {numbers => [qw /one two three four five six seven
                                      eight nine ten eleven twelve/],
                  format  => "The big hand is on the %s " .
                             "and the little hand is on the %s",
                  big     => [qw/big long large minute/],
                  little     => [qw/little small short hour/]},

    'br'      => {numbers => [qw /um dois trÍs quatro cinco seis
                                     sete oito nove dez onze doze/],
                  format  => "O ponteiro grande est· no %s " .
                             "e o ponteiro pequeno est· no %s"},

    'de'      => {numbers => [qw /Eins Zwei Drei Vier F¸nf Sechs Sieben
                                       Acht Neun Zehn Elf Zw–lf/],
                  format  => "Der gro\xDFe Zeiger ist auf der %s " .
                             "und der kleine Zeiger ist auf der %s",
                  big     => [qw/groß lang groß Minute/],
                  little     => [qw/wenig klein Kurzschluß Stunde/]},

    'du'      => {numbers => [qw /een twee drie vier vijf zes zeven
                                      acht negen tien elf twaalf/],
                  format  => "De grote wijzer is op de %s " .
                             "en de kleine wijzer is op de %s"},

    'es'      => {numbers => [qw /uno dos tres cuatro cinco seis siete
                                      ocho nueve diez once doce/],
                  format  => "La manecilla grande est· sobre el %s " .
                             "y la manecilla pequeÒa est· sobre el %s",
                  big     => [qw/grande grande minuto/, 'de largo'],
                  little     => [qw/poco pequeño cortocircuito hora/]},
                             

    'fr'      => {numbers => [qw /un deux trois quatre cinq six sept
                                     huit neuf dix onze douze/],
                  format  => "La grande aiguille est sur le %s " .
                             "et la petite aiguille est sur le %s",
                  big     => [qw/grand longtemps grand minute/],
                  little     => [qw/peu petit short heure/]},

    'it'      => {numbers => ['a una', 'e due', 'e tre', 'e quattro',
                                       'e cinque', 'e sei', 'e sette',
                                       'e otto', 'e nove', 'e dieci',
                                       'e undici', 'e dodici'],
                  format  => "La lancetta lunga e' sull%s " .
                             "e quella corta e' sull%s",
                  big     => [qw/grande lungamente grande minuto/],
                  little     => [qw/piccolo piccolo short ora/]},

    'no'      => {numbers => [qw /en to tre fire fem seks syv
                                     Âtte ni ti elleve tolv/],
                  format  => "Den store viseren er p %s " .
                             "og den lille viseren er p %s"},

    'se'      => {numbers => [qw /ett tv tre fyra fem sex sju
                                      Âtta nio tio elva tolv/],
                  format  => "Den stora visaren ”r p %s " .
                             "och den lilla visaren ”r p %s"},

    'swedish chef'
              => {numbers => [qw /one tvu three ffuoor ffeefe six
                                      sefen eight nine ten elefen tvelfe/],
                  format  => "Zee beeg hund is un zee %s und zee little " .
                             "hund is un zee %s. Bork, bork, bork!"},

    'warez'   => {numbers => [qw {()nE TW0 7HR3e f0uR f|ve 5ix 
                                       ZE\/3n E|6hT n1nE TeN 3L3v3gn 7wELv3}],
                  format  => 'T|-|3 bIG h4|\||) Yz 0n thE %s ' .
                             'and 7|-|3 lIttlE |-|aND |S 0|\| Th3 %s'},
	'custom'  => 1,
);


sub new {
    my $class = shift;
	my %args;
	if (scalar @_ == 1) {
		$args{language} = shift;
	} elsif (scalar @_ %2) {
		croak ("DateTime::Format::Baby must be given either one parameter (a language) or a hash");
	} else {
		%args = @_;
	}
	$args{language}	||= 'en';
	
	$args{numbers}	||= $languages{$args{language}}{numbers};
	$args{format}	||= $languages{$args{language}}{format};
	$args{big}		||= $languages{$args{language}}{big};
	$args{little}	||= $languages{$args{language}}{little};
	
	unless (exists $languages{$args{language}}) {
		croak "I do not know the language '$args{language}'. The languages I do know are: " . join(', ', sort keys %languages);
	}
	unless ($args{numbers}) {
		croak "I have no numbers for that language.";
	}
	unless ($args{format}) {
		croak "I have no format for that language.";
	}
	
    return bless \%args, $class;
}

sub languages {
	return sort keys %languages;
}

sub language {
	my $self = shift;
	my $language = shift;
	
	if ($language) {
		$self->{language}   = $language;
		$self->{numbers}	= $languages{$language}{numbers};
		$self->{format}		= $languages{$language}{format};
		$self->{big}		= $languages{$language}{big};
		$self->{little}		= $languages{$language}{little};
		
		unless (exists $languages{$language}) {
			croak "I do not know the language '$language'. The languages I do know are: " . join(', ', sort keys %languages);
		}
	}
	return $self->{language};	
}

sub parse_datetime {
    my ( $self, $date ) = @_;

	my ($littlenum,$bignum);

	if ($self->{big} && $self->{little}) {
		my $numbers = '(' . join('|',@{$self->{numbers}}) . ')';
		my $format = $self->{format};
		my $big = '(' . join('|',@{$self->{big}}) . ')';
		my $little = '(' . join('|',@{$self->{little}}) . ')';

		(undef,$littlenum) = $date =~/$little.*?$numbers/i;
		(undef,$bignum) = $date =~/$big.*?$numbers/i;

	} else {
		my $regex = $self->{format};
		$regex =~s/\%s/(\\w+)/g;
		
		($bignum,$littlenum) = $date =~ /$regex/;
	}
		
	unless ($bignum && $littlenum) {
		croak "Sorry, I didn't understand '$date' in '".$self->language ."'";
	}

	my %reverse;
	@reverse{@{$self->{numbers}}} = (1..12);
	
	my $hours = $reverse{lc($littlenum)} * 1;
	my $minutes = $reverse{lc($bignum)} * 5;
	
	$hours-- if $minutes > 30;
	if ($minutes == 60) {
		$minutes = 0; $hours++;
	}
    return DateTime->new(year=>0, hour=>$hours, minute=>$minutes);
}

sub parse_duration {
    croak "DateTime::Format::Baby doesn't do durations.";
}

sub format_datetime {
    my ( $self, $dt ) = @_;

    my ($hours, $minutes) = ($dt->hour, $dt->minute);

    $hours ++ if $minutes > 30;

    # Turn $hours into 1 .. 12 format.
    $hours  %= 12;
    $hours ||= 12;

    # Round minutes to nearest 5 minute.
    $minutes   = sprintf "%.0f" => $minutes / 5;
    $minutes ||= 12;

    local $[ = 1;
    return sprintf $self->{format} => @{$self->{numbers}} [$minutes, $hours];
}

sub format_duration {
    croak "DateTime::Format::Baby doesn't do durations.";
}


1;
__END__