root/Dunce-time/trunk/lib/Dunce/time.pm

Revision 56 (checked in by miyagawa, 19 years ago)

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package Dunce::time;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = '0.01';
6
7 use overload    '""'    =>  \&timize,
8                 '0+'    =>  \&timize,
9                 'fallback'  =>  'TRUE',
10                 'cmp'   =>  \&str_compare,
11                 '<=>'   =>  \&num_compare,
12     ;
13
14 sub import {
15     my($class, $reaction) = @_;
16     my $caller = caller;
17     {
18         no strict 'refs';
19         *{$caller.'::time'} = sub {
20             return Dunce::time->new($reaction);
21         };
22     }
23 }
24
25 sub new {
26     my($proto, $reaction) = @_;
27     $reaction ||= ':DIE';
28     my $class = ref $proto || $proto;
29     bless {
30         _time => time,
31         _callback => $class->_get_callback($reaction),
32     }, $class;
33 }
34
35 sub _get_callback {
36     my($class, $reaction) = @_;
37     my $dying_msg = "Possible misuse of time().";
38     for ($reaction) {
39         /^:WARN/i && return sub {
40             require Carp;
41             Carp::carp $dying_msg;
42         };
43         /^:FIX/i && return sub {
44             my($this, $that) = @_;
45             Carp::carp $dying_msg, " I'll fix it.";
46             return $this <=> $that; # goes to num_compare()
47         };
48         return sub {
49             Carp::croak $dying_msg;
50         };
51     }
52 }
53        
54 sub timize {
55     shift->{_time};
56 }
57    
58 sub str_compare {
59     my($this, $that) = @_;
60     my $mine = (grep { ref($this) } ($this, $that))[0];
61     $mine->{_callback}->($this, $that);
62 }
63
64 sub num_compare {
65     my($this, $that) = map { $_ + 0 } @_; # numize
66     return $this <=> $that;
67 }
68
69
70 1;
71    
72 __END__
73
74
75 =head1 NAME
76
77 Dunce::time - Protects against sloppy use of time.
78
79 =head1 SYNOPSIS
80
81   use Dunce::time;
82
83   my $this = time;
84   my $that = time;
85
86   my @sorted = sort $this, $that; # die with an error
87   my @numerically_sorted = sort { $a <=> $b } $this, $that; # OK
88
89 =head1 DESCRIPTION
90
91 On Sun Sep 9 01:46:40 2001 GMT, time_t (UNIX epoch) reaches 10 digits.
92 Sorting C<time()>'s as strings will cause unexpected result after
93 that.
94
95 When Dunce::time is used, it provides special version of C<time()>
96 which will die with a message when compared as strings.
97
98 =head1 USAGE
99
100 Just use the module. If it detects a problem, it will cause your
101 program to abort with an error. If you don't like this behaviour, you
102 can use the module with tags like ":WARN" or ":FIX".
103
104   use Dunce::time qw(:WARN);
105
106 With ":WARN" tag, it will just warn instead of dying.
107
108   use Dunce::time qw(:FIX);
109   @sorted = sort @time; # acts like sort { $a <=> $b } @time;
110
111 With ":FIX" tag, it will warn and change the comparison behaviour so
112 that it acts like compared numerically.
113
114 =head1 CAVEATS
115
116 You store the variables into storage (like DBMs, databases), retrieve
117 them from storage, and compare them as strings ... this can't detect
118 in such a case.
119
120 =head1 AUTHOR
121
122 Tatsuhiko Miyagawa <miyagawa@bulknews.net>
123
124 This library is free software; you can redistribute it and/or modify
125 it under the same terms as Perl itself.
126
127 =head1 SEE ALSO
128
129 L<D::oh::Year>, L<overload>, L<perl>
130
131 =cut
Note: See TracBrowser for help on using the browser.