File Coverage

blib/lib/Time/Fuzzy.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch	4	4	100.0
condition	17	21	80.9
subroutine	13	13	100.0
pod	3	3	100.0
total	80	84	95.2

#
# This file is part of Time::Fuzzy
# Copyright (c) 2007 Jerome Quelin, all rights reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#

package Time::Fuzzy;

use warnings;
use strict;

use Class::Accessor::Fast;
use DateTime;
use DateTime::Duration;

use base qw[ Exporter Class::Accessor::Fast ];
our @EXPORT = qw[ fuzzy ];
__PACKAGE__->mk_accessors( qw[ dt fuzziness ] );

our $VERSION   = '0.36';
our $FUZZINESS = 'medium';

#--
# private vars

# - for high fuzziness
my %weektime = ( # define the periods of the week
    'start of week'  => [ 1 ],
    'middle of week' => [ 2..4 ],
    'end of week'    => [ 5 ],
    'week-end!'      => [ 6,7 ],
);
my @weektime; # a 7-slots array, one for each days
{ # init @weektime by walking %weektime
    foreach my $wt ( keys %weektime ) {
        my $days = $weektime{$wt};
        $weektime[$_] = $wt for @$days;
    }
}

# - for medium fuzziness
my %daytime = ( # define the periods of the day
    'night'         => [ 0, 1, 2, 3, 4 ],
    'early morning' => [ 5, 6, 7 ],
    'morning'       => [ 8, 9, 10 ],
    'noon'          => [ 11, 12, 13 ],
    'afternoon'     => [ 14, 15, 16, 17, 18 ],
    'evening'       => [ 19, 20, 21 ],
    'late evening'  => [ 22, 23 ],
);
my @daytime; # a 24-slots array, one for each hour
{ # init @daytime by walking %daytime
    foreach my $dt ( keys %daytime ) {
        my $hours = $daytime{$dt};
        $daytime[$_] = $dt for @$hours;
    }
}

# - for low fuzziness
my @hourtime = ( # defining the periods of the hour
    "%s o'clock", 'five past %s', 'ten past %s',
    'quarter past %s', 'twenty past %s', 'twenty five past %s',
    'half past %s', 'twenty five to %2$s', 'twenty to %2$s',
    'quarter to %2$s', 'ten to %2$s', 'five to %2$s',
    q{%2$s o'clock}, # needed for 58-59
);
my @hours = (
    'midnight',
    qw[ one two three four five six seven eight nine ten eleven noon ],
    qw[ one two three four five six seven eight nine ten eleven midnight ],
);


#--
# public subs

sub fuzzy {
    my $dt = $_[0] || DateTime->now( time_zone=>'local' );
    my %fuzzysub = (
        low    => \&_fuzzy_low,
        medium => \&_fuzzy_medium,
        high   => \&_fuzzy_high,
    );
    return $fuzzysub{$FUZZINESS}->($dt);
}


#--
# public methods

sub new {
    my $pkg = shift;
    my %params = (
        dt        => DateTime->now( time_zone=>'local' ),
        fuzziness => $FUZZINESS,
        @_,
    );
    return bless \%params, $pkg;
}

use overload '""' => \&as_str;
sub as_str {
    my ($self) = @_;
    my %fuzzysub = (
        low    => \&_fuzzy_low,
        medium => \&_fuzzy_medium,
        high   => \&_fuzzy_high,
    );
    return $fuzzysub{$self->fuzziness}->($self->dt);
}


#--
# private subs

#
# my $fuz = _fuzzy_low($dt)
#
# Return a fuzzy time defined by $dt. The fuzziness is a bit low, that
# is, 5 minutes in this case.
#
sub _fuzzy_low {
    my ($dt1) = @_;

    my $sector = int( ($dt1->minute + 2) / 5 );
    my $hour1 = $hours[$dt1->hour];

    # compute next hour, for 2nd half of the hour.
    my $dt2   = $dt1 + DateTime::Duration->new(hours=>1);
    my $hour2 = $hours[$dt2->hour];

    # midnight or noon don't need o'clock appended.
    return $hour1
        if ($sector==0  && $dt1->hour==0)    # 0:01
        || ($sector==0  && $dt1->hour==12);  # 12:02
    return $hour2
        if ($sector==12 && $dt1->hour==23)   # 23:58
        || ($sector==12 && $dt1->hour==11);  # 11:59

    # compute fuzzy.
    my $fuzzy = sprintf $hourtime[$sector], $hour1, $hour2;
    return $fuzzy;
}


#
# my $fuz = _fuzzy_medium($dt)
#
# Return a fuzzy time defined by $dt. The fuzziness is medium, that
# is, around 3 hours in this case.
#
sub _fuzzy_medium {
    my ($dt) = @_;
    return $daytime[$dt->hour];
}


#
# my $fuz = _fuzzy_high($dt)
#
# Return a fuzzy time defined by $dt. The fuzziness is high, that
# is, around the day in this case.
#
sub _fuzzy_high {
    my ($dt) = @_;
    return $weektime[$dt->dow];
}


1;
__END__