mirror of
https://github.com/perlbot/perlbuut
synced 2025-06-08 13:45:42 -04:00
260 lines
6.9 KiB
Perl
260 lines
6.9 KiB
Perl
package Math::Farnsworth::Value::Date;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Math::Farnsworth::Dimension;
|
|
use Math::Farnsworth::Value;
|
|
use Math::Farnsworth::Value::Pari;
|
|
use Carp;
|
|
|
|
use DateTime;
|
|
#use DateTime::Format::DateManip;
|
|
#use Date::Manip;
|
|
use DateTimeX::Easy;
|
|
|
|
use utf8;
|
|
|
|
our $VERSION = 0.6;
|
|
|
|
use overload
|
|
'+' => \&add,
|
|
'-' => \&subtract,
|
|
'*' => \&mult,
|
|
'/' => \&div,
|
|
'%' => \&mod,
|
|
'**' => \&pow,
|
|
'<=>' => \&compare,
|
|
'bool' => \&bool;
|
|
|
|
use base qw(Math::Farnsworth::Value);
|
|
|
|
#this is the REQUIRED fields for Math::Farnsworth::Value subclasses
|
|
#
|
|
#dimen => a Math::Farnsworth::Dimension object
|
|
#
|
|
#this is so i can make a -> conforms in Math::Farnsworth::Value, to replace the existing code, i'm also planning on adding some definitions such as, TYPE_PARI, TYPE_STRING, TYPE_LAMBDA, TYPE_DATE, etc. to make certain things easier
|
|
|
|
sub new
|
|
{
|
|
my $class = shift;
|
|
my $value = shift;
|
|
my $outmagic = shift; #i'm still not sure on this one
|
|
|
|
confess "Non string or date given as \$value to constructor" unless (ref($value) eq "" || ref($value) eq "DateTime") && defined($value);
|
|
|
|
my $self = {};
|
|
|
|
bless $self, $class;
|
|
|
|
$self->{outmagic} = $outmagic;
|
|
|
|
if (ref($value) ne "DateTime")
|
|
{
|
|
my $dt = DateTimeX::Easy->parse($value);
|
|
die "failed to parse date!" unless defined $dt;
|
|
$dt->set_time_zone('UTC'); #supposed to make things easier and more predictable
|
|
|
|
$self->{date} = $dt;
|
|
}
|
|
else
|
|
{
|
|
$self->{date} = $value;
|
|
}
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub getdate
|
|
{
|
|
return $_[0]->{date};
|
|
}
|
|
|
|
#######
|
|
#The rest of this code can be GREATLY cleaned up by assuming that $one is of type, Math::Farnsworth::Value::Pari, this means that i can slowly redo a lot of this code
|
|
|
|
sub add
|
|
{
|
|
my ($one, $two, $rev) = @_;
|
|
|
|
confess "Non reference given to addition" unless ref($two);
|
|
|
|
#if we're not being added to a Math::Farnsworth::Value::Pari, the higher class object needs to handle it.
|
|
|
|
if ($two->isa("Math::Farnsworth::Value::Pari"))
|
|
{
|
|
if ($two->conforms($one->TYPE_TIME))
|
|
{
|
|
return new Math::Farnsworth::Value::Date($one->getdate()->clone()->add(seconds => "".$two->getpari()));
|
|
}
|
|
else
|
|
{
|
|
confess "Scalar value given to addition to string" if ($two->isa("Math::Farnsworth::Value::Pari"));
|
|
}
|
|
}
|
|
else
|
|
{
|
|
return $two->add($one, !$rev) unless ($two->ismediumtype());
|
|
|
|
if (!$two->istype("Date"))
|
|
{
|
|
confess "Given non date to date operation";
|
|
}
|
|
|
|
die "Adding dates does nothing useful.";
|
|
}
|
|
}
|
|
|
|
sub subtract
|
|
{
|
|
my ($one, $two, $rev) = @_;
|
|
|
|
confess "Non reference given to addition" unless ref($two);
|
|
|
|
#if we're not being added to a Math::Farnsworth::Value::Pari, the higher class object needs to handle it.
|
|
|
|
if ($two->isa("Math::Farnsworth::Value::Pari"))
|
|
{
|
|
if ($two->conforms($one->TYPE_TIME))
|
|
{
|
|
if (!$rev) #we're first!
|
|
{
|
|
return new Math::Farnsworth::Value::Date($one->getdate()->clone()->add(seconds => "".(-$two->getpari())));
|
|
}
|
|
else
|
|
{
|
|
die "And just now what is that supposed to do? a negative date? what the hell is that?";
|
|
}
|
|
}
|
|
else
|
|
{
|
|
confess "Scalar value given to addition to string" if ($two->isa("Math::Farnsworth::Value::Pari"));
|
|
}
|
|
}
|
|
else
|
|
{
|
|
return $two->subtract($one, !$rev) unless ($two->ismediumtype());
|
|
|
|
if (!$two->istype("Date"))
|
|
{
|
|
confess "Given non date to date operation";
|
|
}
|
|
|
|
my $diff;
|
|
$diff = $one->getdate()->subtract_datetime_absolute($two->getdate()) unless $rev;
|
|
$diff = $two->getdate()->subtract_datetime_absolute($one->getdate()) if $rev;
|
|
|
|
my ($secs, $nano) = $diff->in_units('seconds','nanoseconds');
|
|
my $rdiff = $secs + 0.000000001 *$nano;
|
|
|
|
my $ret = Math::Farnsworth::Value::Pari->new($rdiff, {time => 1});
|
|
|
|
return $ret;
|
|
}
|
|
}
|
|
|
|
sub modulus
|
|
{
|
|
my ($one, $two, $rev) = @_;
|
|
|
|
confess "Non reference given to modulus" unless ref($two);
|
|
|
|
#if there's a higher type, use it, subtraction otherwise doesn't make sense on arrays
|
|
confess "Scalar value given to modulus to date" if ($two->isa("Math::Farnsworth::Value::Pari"));
|
|
return $two->mod($one, !$rev) unless ($two->ismediumtype());
|
|
if (!$two->istype("Date"))
|
|
{
|
|
confess "Given non date to date operation";
|
|
}
|
|
|
|
die "Modulusing dates? what did you think this would do, create a black hole?";
|
|
}
|
|
|
|
sub mult
|
|
{
|
|
my ($one, $two, $rev) = @_;
|
|
|
|
confess "Non reference given to multiplication" unless ref($two);
|
|
|
|
#if there's a higher type, use it, subtraction otherwise doesn't make sense on arrays
|
|
confess "Scalar value given to multiplcation to dates" if ($two->isa("Math::Farnsworth::Value::Pari"));
|
|
return $two->mult($one, !$rev) unless ($two->ismediumtype());
|
|
if (!$two->istype("Date"))
|
|
{
|
|
confess "Given non date to date operation";
|
|
}
|
|
|
|
die "Multiplying dates? what did you think this would do, create a black hole?";
|
|
}
|
|
|
|
sub div
|
|
{
|
|
my ($one, $two, $rev) = @_;
|
|
|
|
confess "Non reference given to division" unless ref($two);
|
|
|
|
#if there's a higher type, use it, subtraction otherwise doesn't make sense on arrays
|
|
confess "Scalar value given to division to date" if ($two->isa("Math::Farnsworth::Value::Pari"));
|
|
return $two->div($one, !$rev) unless ($two->ismediumtype());
|
|
if (!$two->istype("Date"))
|
|
{
|
|
confess "Given non date to dates operation";
|
|
}
|
|
|
|
die "Dividing date? what did you think this would do, create a black hole?";
|
|
}
|
|
|
|
sub bool
|
|
{
|
|
my $self = shift;
|
|
|
|
#seems good enough of an idea to me
|
|
#i have a bug HERE
|
|
#print "BOOLCONV\n";
|
|
#print Dumper($self);
|
|
#print "ENDBOOLCONV\n";
|
|
return 1; #what else should it be?
|
|
}
|
|
|
|
sub pow
|
|
{
|
|
my ($one, $two, $rev) = @_;
|
|
|
|
confess "Non reference given to exponentiation" unless ref($two);
|
|
|
|
#if there's a higher type, use it, subtraction otherwise doesn't make sense on arrays
|
|
confess "Exponentiating dates? what did you think this would do, create a black hole?" if ($two->isa("Math::Farnsworth::Value::Pari"));
|
|
return $two->pow($one, !$rev) unless ($two->ismediumtype());
|
|
if (!$two->istype("Date"))
|
|
{
|
|
confess "Given non date to date operation";
|
|
}
|
|
|
|
die "Exponentiating dates? what did you think this would do, create a black hole?";
|
|
}
|
|
|
|
sub compare
|
|
{
|
|
my ($one, $two, $rev) = @_;
|
|
|
|
confess "Non reference given to compare" unless ref($two);
|
|
|
|
#if we're not being added to a Math::Farnsworth::Value::Pari, the higher class object needs to handle it.
|
|
confess "Scalar value given to division to dates" if ($two->isa("Math::Farnsworth::Value::Pari"));
|
|
return $two->compare($one, !$rev) unless ($two->ismediumtype());
|
|
|
|
my $rv = $rev ? -1 : 1;
|
|
#check for $two being a simple value
|
|
my $tv = $two->getdate();
|
|
my $ov = $one->getdate();
|
|
|
|
#i also need to check the units, but that will come later
|
|
#NOTE TO SELF this needs to be more helpful, i'll probably do something by adding stuff in ->new to be able to fetch more about the processing
|
|
die "Unable to process different units in compare\n" unless $one->conforms($two); #always call this on one, since $two COULD be some other object
|
|
|
|
#moving this down so that i don't do any math i don't have to
|
|
my $new = $ov <=> $tv;
|
|
|
|
return $new * $rv;
|
|
}
|
|
|