File Coverage

blib/lib/Time/Duration/pl.pm

Criterion	Covered	Total	%
statement	60	63	95.2
branch	19	22	86.3
condition	6	7	85.7
subroutine	19	22	86.3
pod	11	13	84.6
total	115	127	90.5

package Time::Duration::pl;
# ABSTRACT: Describe time duration in Polish

use 5.8.0;
use utf8;
use strict;
use warnings;

our $VERSION = '0.002'; # VERSION: generated by DZP::OurPkgVersion

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 Time::Duration qw();

my %en2pl = (
    #           singular   plural     plural in genitive
    second => [ 'sekunda', 'sekundy', 'sekund' ],
    minute => [ 'minuta',  'minuty',  'minut'  ],
    hour   => [ 'godzina', 'godziny', 'godzin' ],
    day    => [ 'dzień',   'dni',     'dni'    ],
    year   => [ 'rok',     'lata',    'lat'    ],
);

my %short   = map { $_ => substr($_, 0, 1) } map { @{$_} } values %en2pl;
my $comp_re = join '|', map { @{$_} } values %en2pl;

sub concise ($) {
    my ( $string ) = @_;

    for ($string) {
        tr/,//d;
        s/\bi\b//;
        s/\b($comp_re)\b/$short{$1}/g;
        s/\s*(\d+)\s*/$1/g;

        # restore prefixed intervals
        s/za/za /;
    }

    return $string;
}

sub later {
    interval(      $_[0], $_[1], '%s wcześniej', '%s później', 'teraz');
}

sub later_exact {
    interval_exact($_[0], $_[1], '%s wcześniej', '%s później', 'teraz');
}

sub earlier {
    interval(      $_[0], $_[1], '%s później', '%s wcześniej', 'teraz');
}

sub earlier_exact {
    interval_exact($_[0], $_[1], '%s później', '%s wcześniej', 'teraz');
}

sub ago {
    interval(      $_[0], $_[1], 'za %s', '%s temu', 'teraz');
}

sub ago_exact {
    interval_exact($_[0], $_[1], 'za %s', '%s temu', 'teraz');
}

sub from_now {
    interval(      $_[0], $_[1], '%s temu', 'za %s', 'teraz');
}

sub from_now_exact {
    interval_exact($_[0], $_[1], '%s temu', 'za %s', 'teraz');
}

sub duration_exact {
    my ( $span ) = @_;   # interval in seconds
    return '0 sekund' unless $span;
    _render(
        '%s',
        Time::Duration::_separate(abs $span));
}

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

sub interval_exact {
    my ( $span ) = @_;                      # interval in seconds
    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, $precision ) = @_;          # interval in seconds
    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(
            int($precision || 0) || 2,      # precision (default: 2)
            Time::Duration::_separate($span)));
}

BEGIN {
    # generally numbers' units in Polish use plural form in genitive case,
    # but for some values like 2, 3, 4, 22, 23, 24, 32, 33, 34, etc. nominative
    # is used
    my %case_index = (
        0 => 2,
        1 => 2,
        2 => 1,
        3 => 1,
        4 => 1,
        5 => 2,
        6 => 2,
        7 => 2,
        8 => 2,
        9 => 2,
        10 => 2,
        11 => 2,
        12 => 2,
        13 => 2,
        14 => 2,
    );

    sub _determine_case {
        my ( $amount ) = @_;
        return 0 if $amount == 1;         # use singular for 1
        return $case_index{$amount}       # choose case explicitely for 2..14
            || $case_index{$amount % 10}; # or use last digit for greater values
    }
}

sub _render {
    # Make it into Polish
    my $direction = shift;
    my @wheel = map {
        my ( $unit, $amount ) = @{$_};
        ( $amount == 0 )
            ? ()
            : $amount . ' ' . $en2pl{$unit}[_determine_case($amount)]
        } @_;

    return 'teraz' unless @wheel; # sanity

    my $result;
    if (@wheel == 1) {
        $result = $wheel[0];
    }
    elsif (@wheel == 2) {
        $result = $wheel[0] . ' i ' . $wheel[1];
    }
    else {
        my $last = pop @wheel;
        $result = join(', ', @wheel) . ' i ' . $last;
    }

    return sprintf($direction, $result);
}

1;

__END__