File Coverage

blib/lib/Acme/Time/Baby.pm

Criterion	Covered	Total	%
statement	41	44	93.1
branch	15	22	68.1
condition	4	4	100.0
subroutine	7	7	100.0
pod	0	1	0.0
total	67	78	85.9

package Acme::Time::Baby;

use strict;
use warnings;
no  warnings 'syntax';

use vars qw /$VERSION/;

our $VERSION  = '2010090301';

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"},

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

    'ceb'     => {numbers => [qw /usa duha tulo upat lima unom pito
                                  walo siyam napulo/,
                                 "napulo'g usa", "napulo'g duha"],
                  format  => "Ang dako nga kamut naa sa %s " .
                             "ang gamay nga kamut naa sa %s"},

    'de'      => {numbers => [split ' ' =>
                              qq /Eins Zwei Drei Vier F\x{FC}nf Sechs Sieben
                                       Acht Neun Zehn Elf Zw\x{F6}lf/],
                  format  => "Der gro\x{DF}e Zeiger ist auf der %s " .
                             "und der kleine Zeiger ist auf der %s"},

    'de_ch'   => {numbers => [split ' ' =>
                              qq /eis zw\x{F6}i  dr\x{FC}  vieri f\x{F6}ifi
                                  s\x{E4}chsi sibni
                                      achti n\x{FC}ni z\x{E4}ni  elfi
                                  zw\x{F6}lfi/],
                  format  => "De gross zeiger isch uf em %s " .
                             "und de chlii zeiger isch uf em %s"},

    '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\x{E1} sobre el %s y " .
                             "la manecilla peque\x{F1}a est\x{E1} sobre el %s"},

    '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"},

    'hr'      => {numbers => [split ' ' =>
                              qq /jedan dva tri \x{010d}etiri pet \x{0161}est
                                  sedam osam devet deset jedanaest dvanaest/],
                  format  => "Velika kazaljka pokazuje %s " .
                             "a mala kazaljka pokazuje %s"},

    '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"},

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

    'se'      => {numbers => [split ' ' =>
                              qq /ett tv\x{E5} tre fyra fem sex sju
                                      \x{E5}tta nio tio elva tolv/],
                  format  => "Den stora visaren \x{E4}r p\x{E5} %s " .
                             "och den lilla visaren \x{E4}r p\x{E5} %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'},

);

my @numbers = @{$languages {en} {numbers}};
my $format  =   $languages {en} {format};

sub import {
    my $class  = shift;
    my $pkg    = __PACKAGE__;
    my $caller = caller;

    my %args   = @_;

    if ($args {language}) {
        if (exists $languages {$args {language}}) {
            @numbers = @{$languages {$args {language}} {numbers}};
            $format  =   $languages {$args {language}} {format};
        }
        else {
            warn "There is no support for language `$args{language}'\n" if $^W;
        }
    }

    @numbers   = @{$args {numbers}} if exists $args {numbers};
    $format    =   $args {format}   if exists $args {format};

    if (@numbers < 12) {die "You didn't pass in twelve numbers.\n";}

    no strict 'refs';
    *{$caller . '::babytime'} = \&{__PACKAGE__ . '::babytime'}
         unless $args {noimport};
}

sub babytime {
    my ($hours, $minutes);
    if (@_) {
        ($hours, $minutes) = $_ [0] =~ /^(\d+):(\d+)$/
                  or die "$_[0] is not of the form hh:mm\n";
    }
    else {
        ($hours, $minutes) = (localtime) [2, 1];
    }

    $hours ++ if $minutes > 30;

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

    die "There are just 60 minutes in an hour\n" if $minutes >= 60;

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

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

1;

__END__