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

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

added Dunce::time

  • 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.02';
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             require Carp;
46             Carp::carp $dying_msg, " I'll fix it.";
47             return $this <=> $that; # goes to num_compare()
48         };
49         /^:DIE/i && return sub {
50             require Carp;
51             Carp::croak $dying_msg;
52         };
53     }
54 }
55        
56 sub timize {
57     shift->{_time};
58 }
59    
60 sub str_compare {
61     my($this, $that) = @_;
62     my $mine = (grep { ref($this) } ($this, $that))[0];
63     $mine->{_callback}->($this, $that);
64 }
65
66 sub num_compare {
67     my($this, $that) = map { $_ + 0 } @_; # numize
68     return $this <=> $that;
69 }
70
71
72 1;
73    
74 __END__
75
76
77 =head1 NAME
78
79 Dunce::time - Protects against sloppy use of time.
80
81 =head1 SYNOPSIS
82
83   use Dunce::time;
84
85   my $this = time;
86   my $that = time;
87
88   my @sorted = sort $this, $that; # die with an error
89   my @numerically_sorted = sort { $a <=> $b } $this, $that; # OK
90
91 =head1 DESCRIPTION
92
93 On Sun Sep 9 01:46:40 2001 GMT, time_t (UNIX epoch) reaches 10 digits.
94 Sorting time()'s as strings will cause unexpected result after
95 that.
96
97 When Dunce::time is used, it provides special version of time() which
98 will die with a message when compared as strings.
99
100 =head1 USAGE
101
102 Just use the module. If it detects a problem, it will cause your
103 program to abort with an error. If you don't like this behaviour, you
104 can use the module with tags like ":WARN" or ":FIX".
105
106   use Dunce::time qw(:WARN);
107
108 With ":WARN" tag, it will just warn instead of dying.
109
110   use Dunce::time qw(:FIX);
111   @sorted = sort @time; # acts like sort { $a <=> $b } @time;
112
113 With ":FIX" tag, it will warn and change the comparison behaviour so
114 that it acts like compared numerically.
115
116 =head1 CAVEATS
117
118 You store the variables into storage (like DBMs, databases), retrieve
119 them from storage, and compare them as strings ... this can't detect
120 in such a case.
121
122 =head1 AUTHOR
123
124 Tatsuhiko Miyagawa <miyagawa@bulknews.net>
125
126 This library is free software; you can redistribute it and/or modify
127 it under the same terms as Perl itself.
128
129 =head1 SEE ALSO
130
131 L<Dunce::time::Zerofill>, L<D::oh::Year>, L<overload>, L<perl>
132
133 =cut
Note: See TracBrowser for help on using the browser.