# # 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__ =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 is using a medium fuzziness factor. You can change that by modifying C<$Time::Fuzzy::FUZZINESS>. The accepted values are C, C or C. =head1 FUNCTIONS =head2 my $fuzzy = fuzzy( [ $dt ] ) Return the fuzzy time defined by C<$dt>, a C object. If no argument, return the (fuzzy) current time. =head1 METHODS If you prefer, you can use C 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 object, defaults to current time. =item . fuzziness => $fuzziness: the wanted fuziness, defaults to current C<$Time::Fuzzy::FUZZINESS>. =back Additionally, the accessors C
and C 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. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SEE ALSO C development takes place on L - feel free to join us. You can also look for information on this module at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =back =head1 AUTHOR Jerome Quelin, C<< >> =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