File Coverage

blib/lib/Time/Duration/fr.pm

Criterion	Covered	Total	%
statement	60	63	95.2
branch	19	22	86.3
condition	5	6	83.3
subroutine	18	21	85.7
pod	11	13	84.6
total	113	125	90.4

package Time::Duration::fr;
use encoding 'utf-8';
use strict;
use warnings;

our $VERSION = '1.01';

use base qw< Exporter >;

our @EXPORT = qw<
    later  later_exact  earlier  earlier_exact
    ago  ago_exact  from_now  from_now_exact
    duration  duration_exact  concise
>;
our @EXPORT_OK = ( "interval", @EXPORT );

use constant DEBUG => 0;
use Time::Duration ();


my %en2fr = (
    second => ["seconde", "secondes"],
    minute => ["minute" , "minutes" ],
    hour   => ["heure"  , "heures"  ],
    day    => ["jour"   , "jours"   ],
    year   => ["année"  , "années"  ],
);

my %short   = map { $_=> substr($_, 0, 1) } map { @$_ } values %en2fr;
my $comp_re = join "|", map { $_->[0] } values %en2fr;


sub concise ($) {
    my $string = $_[0];

    #print "in : $string\n";
    $string =~ tr/,//d;
    $string =~ s/\bet\b//;
    $string =~ s/\b($comp_re)s?\b/$short{$1}/g;
    $string =~ s/\s*(\d+)\s*/$1/g;

    # restore prefixed intervals
    $string =~ s/dans/dans /;
    $string =~ s/il y a/il y a /;

    return $string;
}

sub later {
    interval(      $_[0], $_[1], "%s plus tôt", "%s plus tard", "maintenant");
}

sub later_exact {
    interval_exact($_[0], $_[1], "%s plus tôt", "%s plus tard", "maintenant");
}

sub earlier {
    interval(      $_[0], $_[1], "%s plus tard", "%s plus tôt", "maintenant");
}

sub earlier_exact {
    interval_exact($_[0], $_[1], "%s plus tard", "%s plus tôt", "maintenant");
}

sub ago {
    interval(      $_[0], $_[1], 'dans %s', 'il y a %s', "maintenant");
}

sub ago_exact {
    interval_exact($_[0], $_[1], 'dans %s', 'il y a %s', "maintenant");
}

sub from_now {
    interval(      $_[0], $_[1], 'il y a %s', 'dans %s', "maintenant");
}

sub from_now_exact {
    interval_exact($_[0], $_[1], 'il y a %s', 'dans %s', "maintenant");
}


sub duration_exact {
    my $span = $_[0];   # interval in seconds
    my $precision = int($_[1] || 0) || 2;  # precision (default: 2)
    return '0 seconde' unless $span;
    _render('%s',
        Time::Duration::_separate(abs $span));
}

sub duration {
    my $span = $_[0];   # interval in seconds
    my $precision = int($_[1] || 0) || 2;  # precision (default: 2)
    return '0 seconde' unless $span;
    _render('%s',
        Time::Duration::_approximate($precision,
            Time::Duration::_separate(abs $span)));
}


sub interval_exact {
    my $span = $_[0];                       # interval, in seconds
                                            # precision is ignored
    my $direction = ($span <= -1) ? $_[2]   # what a neg number gets
                  : ($span >=  1) ? $_[3]   # what a pos number gets
                  : return          $_[4];  # what zero gets
    _render($direction,
        Time::Duration::_separate($span));
}

sub interval {
    my $span = $_[0];                       # interval, in seconds
    my $precision = int($_[1] || 0) || 2;   # precision (default: 2)
    my $direction = ($span <= -1) ? $_[2]   # what a neg number gets
                  : ($span >=  1) ? $_[3]   # what a pos number gets
                  : return          $_[4];  # what zero gets
    _render($direction,
        Time::Duration::_approximate($precision,
            Time::Duration::_separate($span)));
}


sub _render {
    # Make it into French
    my $direction = shift @_;
    my @wheel = map {
        ( $_->[1] == 0 ) ? ()  # zero wheels
            : $_->[1] . " " . $en2fr{ $_->[0] }[ $_->[1] == 1 ? 0 : 1 ]
        } @_;

    return "maintenant" unless @wheel; # sanity

    my $result;
    if (@wheel == 1) {
        $result = $wheel[0];
    }
    elsif (@wheel == 2) {
        $result = "$wheel[0] et $wheel[1]";
    }
    else {
        $wheel[-1] = "et $wheel[-1]";
        $result = join q{, }, @wheel;
    }

    return sprintf($direction, $result);
}


1;

__END__