File Coverage

blib/lib/Dunce/time.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	5	6	83.3
condition	3	5	60.0
subroutine	14	14	100.0
pod	0	4	0.0
total	66	73	90.4

package Dunce::time;

use strict;
use vars qw($VERSION);
$VERSION = '0.02';

use overload    '""'    =>  \&timize,
                '0+'    =>  \&timize,
                'fallback'  =>  'TRUE',
                'cmp'   =>  \&str_compare,
                '<=>'	=>  \&num_compare,
    ;

sub import {
    my($class, $reaction) = @_;
    my $caller = caller;
    {
	no strict 'refs';
	*{$caller.'::time'} = sub {
	    return Dunce::time->new($reaction);
	};
    }
}

sub new {
    my($proto, $reaction) = @_;
    $reaction ||= ':DIE';
    my $class = ref $proto || $proto;
    bless {
	_time => time,
	_callback => $class->_get_callback($reaction),
    }, $class;
}

sub _get_callback {
    my($class, $reaction) = @_;
    my $dying_msg = "Possible misuse of time().";
    for ($reaction) {
	/^:WARN/i && return sub {
	    require Carp;
	    Carp::carp $dying_msg;
	};
	/^:FIX/i && return sub {
	    my($this, $that) = @_;
	    require Carp;
	    Carp::carp $dying_msg, " I'll fix it.";
	    return $this <=> $that; # goes to num_compare()
	};
	/^:DIE/i && return sub {
	    require Carp;
	    Carp::croak $dying_msg;
	};
    }
}

sub timize {
    shift->{_time};
}

sub str_compare {
    my($this, $that) = @_;
    my $mine = (grep { ref($this) } ($this, $that))[0];
    $mine->{_callback}->($this, $that);
}

sub num_compare {
    my($this, $that) = map { $_ + 0 } @_; # numize
    return $this <=> $that;
}


1;

__END__