lib/Time/Fuzzy.pm

   1 #
   2 # This file is part of Time::Fuzzy
   3 # Copyright (c) 2007 Jerome Quelin, all rights reserved.
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the same terms as Perl itself.
   7 #
   8
   9 package Time::Fuzzy;
  10
  11 use warnings;
  12 use strict;
  13
  14 use Class::Accessor::Fast;
  15 use DateTime;
  16 use DateTime::Duration;
  17
  18 use base qw[ Exporter Class::Accessor::Fast ];
  19 our @EXPORT = qw[ fuzzy ];
  20 __PACKAGE__->mk_accessors( qw[ dt fuzziness ] );
  21
  22 our $VERSION   = '0.31';
  23 our $FUZZINESS = 'medium';
  24
  25 #--
  26 # private vars
  27
  28 # - for high fuzziness
  29 my %weektime = ( # define the periods of the week
  30     'start of week'  => [ 1 ],
  31     'middle of week' => [ 2..4 ],
  32     'end of week'    => [ 5 ],
  33     'week-end!'      => [ 6,7 ],
  34 );
  35 my @weektime; # a 7-slots array, one for each days
  36 { # init @weektime by walking %weektime
  37     foreach my $wt ( keys %weektime ) {
  38         my $days = $weektime{$wt};
  39         $weektime[$_] = $wt for @$days;
  40     }
  41 }
  42
  43 # - for medium fuzziness
  44 my %daytime = ( # define the periods of the day
  45     'night'         => [ 0, 1, 2, 3, 4 ],
  46     'early morning' => [ 5, 6, 7 ],
  47     'morning'       => [ 8, 9, 10 ],
  48     'noon'          => [ 11, 12, 13 ],
  49     'afternoon'     => [ 14, 15, 16, 17, 18 ],
  50     'evening'       => [ 19, 20, 21 ],
  51     'late evening'  => [ 22, 23 ],
  52 );
  53 my @daytime; # a 24-slots array, one for each hour
  54 { # init @daytime by walking %daytime
  55     foreach my $dt ( keys %daytime ) {
  56         my $hours = $daytime{$dt};
  57         $daytime[$_] = $dt for @$hours;
  58     }
  59 }
  60
  61 # - for low fuzziness
  62 my @hourtime = ( # defining the periods of the hour
  63     "%s o'clock", 'five past %s', 'ten past %s',
  64     'quarter past %s', 'twenty past %s', 'twenty five past %s',
  65     'half past %s', 'twenty five to %2$s', 'twenty to %2$s',
  66     'quarter to %2$s', 'ten to %2$s', 'five to %2$s',
  67     q{%2$s o'clock}, # needed for 58-59
  68 );
  69 my @hours = (
  70     'midnight',
  71     qw[ one two three four five six seven eight nine ten eleven noon ],
  72     qw[ one two three four five six seven eight nine ten eleven midnight ],
  73 );
  74
  75
  76 #--
  77 # public subs
  78
  79 sub fuzzy {
  80     my $dt = $_[0] || DateTime->now( time_zone=>'local' );
  81     my %fuzzysub = (
  82         low    => \&_fuzzy_low,
  83         medium => \&_fuzzy_medium,
  84         high   => \&_fuzzy_high,
  85     );
  86     return $fuzzysub{$FUZZINESS}->($dt);
  87 }
  88
  89
  90 #--
  91 # public methods
  92
  93 sub new {
  94     my $pkg = shift;
  95     my %params = (
  96         dt        => DateTime->now( time_zone=>'local' ),
  97         fuzziness => $FUZZINESS,
  98         @_,
  99     );
 100     return bless \%params, $pkg;
 101 }
 102
 103 use overload '""' => \&as_str;
 104 sub as_str {
 105     my ($self) = @_;
 106     my %fuzzysub = (
 107         low    => \&_fuzzy_low,
 108         medium => \&_fuzzy_medium,
 109         high   => \&_fuzzy_high,
 110     );
 111     return $fuzzysub{$self->fuzziness}->($self->dt);
 112 }
 113
 114
 115 #--
 116 # private subs
 117
 118 #
 119 # my $fuz = _fuzzy_low($dt)
 120 #
 121 # Return a fuzzy time defined by $dt. The fuzziness is a bit low, that
 122 # is, 5 minutes in this case.
 123 #
 124 sub _fuzzy_low {
 125     my ($dt1) = @_;
 126
 127     my $sector = int( ($dt1->minute + 2) / 5 );
 128     my $hour1 = $hours[$dt1->hour];
 129
 130     # compute next hour, for 2nd half of the hour.
 131     my $dt2   = $dt1 + DateTime::Duration->new(hours=>1);
 132     my $hour2 = $hours[$dt2->hour];
 133
 134     # midnight or noon don't need o'clock appended.
 135     return $hour1
 136         if ($sector==0  && $dt1->hour==0)    # 0:01
 137         || ($sector==0  && $dt1->hour==12);  # 12:02
 138     return $hour2
 139         if ($sector==12 && $dt1->hour==23)   # 23:58
 140         || ($sector==12 && $dt1->hour==11);  # 11:59
 141
 142     # compute fuzzy.
 143     my $fuzzy = sprintf $hourtime[$sector], $hour1, $hour2;
 144     return $fuzzy;
 145 }
 146
 147
 148 #
 149 # my $fuz = _fuzzy_medium($dt)
 150 #
 151 # Return a fuzzy time defined by $dt. The fuzziness is medium, that
 152 # is, around 3 hours in this case.
 153 #
 154 sub _fuzzy_medium {
 155     my ($dt) = @_;
 156     return $daytime[$dt->hour];
 157 }
 158
 159
 160 #
 161 # my $fuz = _fuzzy_high($dt)
 162 #
 163 # Return a fuzzy time defined by $dt. The fuzziness is high, that
 164 # is, around the day in this case.
 165 #
 166 sub _fuzzy_high {
 167     my ($dt) = @_;
 168     return $weektime[$dt->dow];
 169 }
 170
 171
 172 1;
 173 __END__
 174
 175 =head1 NAME
 176
 177 Time::Fuzzy - Time read like a human, with some fuzziness
 178
 179
 180
 181 =head1 SYNOPSIS
 182
 183     use Time::Fuzzy;
 184
 185     my $now = fuzzy();
 186     $Time::Fuzzy::FUZZINESS = 'low'; # or 'high', 'medium' (default)
 187     my $fuz = fuzzy( DateTime->new(...) );
 188
 189     my $fuzzy = Time::Fuzzy->new;
 190     print $fuzzy->as_str;
 191
 192
 193
 194 =head1 DESCRIPTION
 195
 196 Nobody will ever say "it's 11:57". People just say "it's noon".
 197
 198 This Perl module does just the same: it adds some human fuzziness to the
 199 way computer deal with time.
 200
 201 By default, C<Time::Fuzzy> is using a medium fuzziness factor. You can
 202 change that by modifying C<$Time::Fuzzy::FUZZINESS>. The accepted values
 203 are C<low>, C<medium> or C<high>.
 204
 205
 206
 207
 208 =head1 FUNCTIONS
 209
 210 =head2 my $fuzzy = fuzzy( [ $dt ] )
 211
 212 Return the fuzzy time defined by C<$dt>, a C<DateTime> object. If no
 213 argument, return the (fuzzy) current time.
 214
 215
 216
 217 =head1 METHODS
 218
 219 If you prefer, you can use C<Time::Fuzzy> in a OOP style. In that case,
 220 the following methods are available.
 221
 222
 223
 224 =head2 my $fuzzy = Item::Fuzzy->new( [dt=>$dt, fuzziness=>fuzziness] )
 225
 226 This is the constructor. It accepts the following params:
 227
 228
 229 =over 4
 230
 231 =item . dt => $dt: a C<DateTime> object, defaults to current time.
 232
 233 =item . fuzziness => $fuzziness: the wanted fuziness, defaults to
 234 current C<$Time::Fuzzy::FUZZINESS>.
 235
 236 =back
 237
 238
 239 Additionally, the accessors C<dt> and C<fuzziness> are available.
 240
 241
 242 =head2 my $str = $fuzzy->as_str()
 243
 244 Return the fuzzy string of the current time of the object.
 245
 246
 247
 248 =head1 BUGS
 249
 250 Please report any bugs or feature requests to C<< < bug-time-fuzzy at
 251 rt.cpan.org> >>, or through the web interface at
 252 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Time-Fuzzy>.  I will be
 253 notified, and then you'll automatically be notified of progress on your
 254 bug as I make changes.
 255
 256
 257
 258 =head1 SEE ALSO
 259
 260 C<Time::Fuzzy> development takes place on
 261 L<http://time-fuzzy.googlecode.com> - feel free to join us.
 262
 263
 264 You can also look for information on this module at:
 265
 266 =over 4
 267
 268 =item * AnnoCPAN: Annotated CPAN documentation
 269
 270 L<http://annocpan.org/dist/Time-Fuzzy>
 271
 272 =item * CPAN Ratings
 273
 274 L<http://cpanratings.perl.org/d/Time-Fuzzy>
 275
 276 =item * RT: CPAN's request tracker
 277
 278 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Time-Fuzzy>
 279
 280 =back
 281
 282
 283
 284 =head1 AUTHOR
 285
 286 Jerome Quelin, C<< <jquelin at cpan.org> >>
 287
 288
 289
 290 =head1 COPYRIGHT & LICENSE
 291
 292 Copyright (c) 2007 Jerome Quelin, all rights reserved.
 293
 294 This program is free software; you can redistribute it and/or modify
 295 it under the same terms as Perl itself.
 296
 297
 298 =cut
 299