#
# 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.34';
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__

=head1 NAME

Time::Fuzzy - Time read like a human, with some fuzziness



=head1 SYNOPSIS

    use Time::Fuzzy;

    my $now = fuzzy();
    $Time::Fuzzy::FUZZINESS = 'low'; # or 'high', 'medium' (default)
    my $fuz = fuzzy( DateTime->new(...) );

    my $fuzzy = Time::Fuzzy->new;
    print $fuzzy->as_str;



=head1 DESCRIPTION

Nobody will ever say "it's 11:57". People just say "it's noon".

This Perl module does just the same: it adds some human fuzziness to the
way computer deal with time.

By default, C<Time::Fuzzy> is using a medium fuzziness factor. You can
change that by modifying C<$Time::Fuzzy::FUZZINESS>. The accepted values
are C<low>, C<medium> or C<high>.




=head1 FUNCTIONS

=head2 my $fuzzy = fuzzy( [ $dt ] )

Return the fuzzy time defined by C<$dt>, a C<DateTime> object. If no
argument, return the (fuzzy) current time.



=head1 METHODS

If you prefer, you can use C<Time::Fuzzy> in a OOP style. In that case,
the following methods are available.



=head2 my $fuzzy = Item::Fuzzy->new( [dt=>$dt, fuzziness=>fuzziness] )

This is the constructor. It accepts the following params:


=over 4

=item . dt => $dt: a C<DateTime> object, defaults to current time.

=item . fuzziness => $fuzziness: the wanted fuziness, defaults to
current C<$Time::Fuzzy::FUZZINESS>.

=back


Additionally, the accessors C<dt> and C<fuzziness> are available.


=head2 my $str = $fuzzy->as_str()

Return the fuzzy string of the current time of the object. This method
is also the overloaded stringified method.



=head1 BUGS

Please report any bugs or feature requests to C<< < bug-time-fuzzy at
rt.cpan.org> >>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Time-Fuzzy>.  I will be
notified, and then you'll automatically be notified of progress on your
bug as I make changes.



=head1 SEE ALSO

C<Time::Fuzzy> development takes place on
L<http://time-fuzzy.googlecode.com> - feel free to join us.


You can also look for information on this module at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Time-Fuzzy>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Time-Fuzzy>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Time-Fuzzy>

=back



=head1 AUTHOR

Jerome Quelin, C<< <jquelin at cpan.org> >>



=head1 COPYRIGHT & LICENSE

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.


=cut

