view release on metacpan or  search on metacpan

lib/uny2k.pm  view on Meta::CPAN

package uny2k;

use strict;
use warnings;

our $VERSION = '19.1080828';

use Carp;

use overload '+' => \&add,
             '%' => \&mod,
             ''  => \&stringize,
             '0+'=> \&numize,
             'fallback' => 'TRUE';

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;
    my($year, $reaction) = @_;

    my $self = {};
    $self->{_Year}      = $year;
    $self->{_Reaction}  = $reaction || 'die';

    return bless $self => $class;
}


sub stringize {
    return shift->{_Year};
}


sub numize {
    return shift->{_Year};
}


sub _mk_localtime {
    my($reaction) = shift;
	
    return sub {
        return @_  ? localtime($_[0]) : localtime() unless wantarray;
        my @t = @_ ? localtime($_[0]) : localtime();
        $t[5] = __PACKAGE__->new($t[5], $reaction);
        @t;
    }
}

sub _mk_gmtime {
    my($reaction) = shift;

    return sub {
        return @_  ? gmtime($_[0]) : gmtime() unless wantarray;
        my @t = @_ ? gmtime($_[0]) : gmtime();
        $t[5] = __PACKAGE__->new($t[5], $reaction);
        @t;
    }
}


sub import {
    () = shift; # Dump the package.
    my $reaction = shift;
    my $caller = caller;
	
    $reaction = ':DIE' unless defined $reaction;

    $reaction = $reaction eq ':WARN' ? 'warn' : 'die';
	
    {
        no strict 'refs';
        *{$caller . '::localtime'} = _mk_localtime($reaction);
        *{$caller . '::gmtime'}    = _mk_gmtime($reaction);
    }

    return 1;
}

sub add {
    my($self, $a2) = @_;

    if( $a2 == 1900 ) {
        carp("Possible y2k fix found!  Unfixing.");
        return "19" . $self->{_Year};