Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Date / Calc / Object.pm

###############################################################################
##                                                                           ##
##    Copyright (c) 2000 - 2002 by Steffen Beyer.                            ##
##    All rights reserved.                                                   ##
##                                                                           ##
##    This package is free software; you can redistribute it                 ##
##    and/or modify it under the same terms as Perl itself.                  ##
##                                                                           ##
###############################################################################

###############################################################################
##                                                                           ##
## Mottos of this module:                                                    ##
##                                                                           ##
## 1) Small is beautiful.                                                    ##
##                                                                           ##
## 2) Make frequent things easy and infrequent or hard things possible.      ##
##                                                                           ##
###############################################################################

package Date::Calc::Object;

use strict;
use vars qw(@ISA @AUXILIARY @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);

use Carp::Clan qw(^Date::);

BEGIN # Re-export imports from Date::Calc:
{
   require Exporter;
   require Date::Calc;
   @ISA         = qw(Exporter Date::Calc);
   @AUXILIARY   = qw(shift_year shift_date shift_time shift_datetime);
   @EXPORT      = @Date::Calc::EXPORT;
   @EXPORT_OK   = (@Date::Calc::EXPORT_OK,@AUXILIARY);
   %EXPORT_TAGS = (all => [@Date::Calc::EXPORT_OK],
                   aux => [@AUXILIARY],
                   ALL => [@EXPORT_OK]);
   $VERSION     = '5.3';
   Date::Calc->import(@Date::Calc::EXPORT,@Date::Calc::EXPORT_OK);
}

sub shift_year
{
   croak("internal error - parameter is not an ARRAY ref") if (ref($_[0]) ne 'ARRAY');

   if (ref($_[0][0]))
   {
       if (ref($_[0][0]) eq 'ARRAY')
       {
           if (@{$_[0][0]} == 3) # otherwise anonymous array is pointless
           {
               return ${shift(@{$_[0]})}[0];
           }
           else
           {
               croak("wrong number of elements in date constant");
           }
       }
       elsif (ref($_[0][0]) =~ /[^:]::[^:]/)
       {
           return shift(@{$_[0]})->year();
       }
       else
       {
           croak("input parameter is neither ARRAY ref nor object");
       }
   }
   else
   {
       if (@{$_[0]} >= 1)
       {
           return shift(@{$_[0]});
       }
       else
       {
           croak("not enough input parameters for a year");
       }
   }
}

sub shift_date
{
   croak("internal error - parameter is not an ARRAY ref") if (ref($_[0]) ne 'ARRAY');

   if (ref($_[0][0]))
   {
       if (ref($_[0][0]) eq 'ARRAY')
       {
           if (@{$_[0][0]} == 3)
           {
               return( @{shift(@{$_[0]})} );
           }
           else
           {
               croak("wrong number of elements in date constant");
           }
       }
       elsif (ref($_[0][0]) =~ /[^:]::[^:]/)
       {
           return( shift(@{$_[0]})->date() );
       }
       else
       {
           croak("input parameter is neither ARRAY ref nor object");
       }
   }
   else
   {
       if (@{$_[0]} >= 3)
       {
           return( shift(@{$_[0]}), shift(@{$_[0]}), shift(@{$_[0]}) );
       }
       else
       {
           croak("not enough input parameters for a date");
       }
   }
}

sub shift_time
{
   croak("internal error - parameter is not an ARRAY ref") if (ref($_[0]) ne 'ARRAY');

   if (ref($_[0][0]))
   {
       if (ref($_[0][0]) eq 'ARRAY')
       {
           if (@{$_[0][0]} == 3)
           {
               return( @{shift(@{$_[0]})} );
           }
           else
           {
               croak("wrong number of elements in time constant");
           }
       }
       elsif (ref($_[0][0]) =~ /[^:]::[^:]/)
       {
           return( (shift(@{$_[0]})->datetime())[3,4,5] );
       }
       else
       {
           croak("input parameter is neither ARRAY ref nor object");
       }
   }
   else
   {
       if (@{$_[0]} >= 3)
       {
           return( shift(@{$_[0]}), shift(@{$_[0]}), shift(@{$_[0]}) );
       }
       else
       {
           croak("not enough input parameters for time values");
       }
   }
}

sub shift_datetime
{
   croak("internal error - parameter is not an ARRAY ref") if (ref($_[0]) ne 'ARRAY');

   if (ref($_[0][0]))
   {
       if (ref($_[0][0]) eq 'ARRAY')
       {
           if (@{$_[0][0]} == 6)
           {
               return( @{shift(@{$_[0]})} );
           }
           else
           {
               croak("wrong number of elements in date-time constant");
           }
       }
       elsif (ref($_[0][0]) =~ /[^:]::[^:]/)
       {
           return( shift(@{$_[0]})->datetime() );
       }
       else
       {
           croak("input parameter is neither ARRAY ref nor object");
       }
   }
   else
   {
       if (@{$_[0]} >= 6)
       {
           return( shift(@{$_[0]}), shift(@{$_[0]}), shift(@{$_[0]}),
                   shift(@{$_[0]}), shift(@{$_[0]}), shift(@{$_[0]}) );
       }
       else
       {
           croak("not enough input parameters for a date and time");
       }
   }
}

package Date::Calc;

use strict;

use Carp::Clan qw(^Date::);

use overload
     '0+' => 'number',
     '""' => 'string',
   'bool' => 'is_valid',
    'neg' => '_unary_minus_',
    'abs' => 'number',
    '<=>' => '_compare_date_',
    'cmp' => '_compare_date_time_',
     '==' => '_equal_date_',
     '!=' => '_not_equal_date_',
     'eq' => '_equal_date_time_',
     'ne' => '_not_equal_date_time_',
      '+' => '_plus_',
      '-' => '_minus_',
     '+=' => '_plus_equal_',
     '-=' => '_minus_equal_',
     '++' => '_increment_',
     '--' => '_decrement_',
      'x' => '_times_',
     'x=' => '_times_equal_',
      '=' => 'clone',
'nomethod' => 'OVERLOAD', # equivalent of AUTOLOAD ;-)
'fallback' =>  undef;

# Report unimplemented overloaded operators:

sub OVERLOAD
{
   croak("operator '$_[3]' is unimplemented");
}

# Prevent nearly infinite loops:

sub _times_
{
   $_[3] = 'x';
   goto &OVERLOAD;
}

sub _times_equal_
{
   $_[3] = 'x=';
   goto &OVERLOAD;
}

my $ACCURATE_MODE = 1;
my $NUMBER_FORMAT = 0;
my $DELTA_FORMAT = 0;
my $DATE_FORMAT = 0;

sub accurate_mode
{
   my($flag) = $ACCURATE_MODE;

   if (@_ > 1)
   {
       $ACCURATE_MODE = $_[1] || 0;
   }
   return $flag;
}

sub number_format
{
   my($flag) = $NUMBER_FORMAT;

   if (@_ > 1)
   {
       $NUMBER_FORMAT = $_[1] || 0;
   }
   return $flag;
}

sub delta_format
{
   my($self) = shift;
   my($flag);

   if (ref $self) # object method
   {
       $flag = defined($self->[0][1]) ? $self->[0][1] : undef;
       if (@_ > 0)
       {
           $self->[0][1] = defined($_[0]) ? $_[0] : undef;
       }
   }
   else           # class method
   {
       $flag = $DELTA_FORMAT;
       if (@_ > 0)
       {
           $DELTA_FORMAT = $_[0] || 0;
       }
   }
   return $flag;
}

sub date_format
{
   my($self) = shift;
   my($flag);

   if (ref $self) # object method
   {
       $flag = defined($self->[0][2]) ? $self->[0][2] : undef;
       if (@_ > 0)
       {
           $self->[0][2] = defined($_[0]) ? $_[0] : undef;
       }
   }
   else           # class method
   {
       $flag = $DATE_FORMAT;
       if (@_ > 0)
       {
           $DATE_FORMAT = $_[0] || 0;
       }
   }
   return $flag;
}

sub language
{
   my($self) = shift;
   my($lang,$temp);

   eval
   {
       if (ref $self) # object method
       {
           $lang = defined($self->[0][3]) ? Language_to_Text($self->[0][3]) : undef;
           if (@_ > 0)
           {
               if (defined $_[0])
               {
                   $temp = $_[0];
                   if ($temp !~ /^\d+$/)
                       { $temp = Decode_Language($temp); }
                   if ($temp > 0 and $temp <= Languages())
                       { $self->[0][3] = $temp; }
                   else
                       { die "no such language '$_[0]'"; }
               }
               else { $self->[0][3] = undef; }
           }
       }
       else           # class method
       {
           $lang = Language_to_Text(Language());
           if (@_ > 0)
           {
               $temp = $_[0];
               if ($temp !~ /^\d+$/)
                   { $temp = Decode_Language($temp); }
               if ($temp > 0 and $temp <= Languages())
                   { Language($temp); }
               else
                   { die "no such language '$_[0]'"; }
           }
       }
   };
   if ($@)
   {
       $@ =~ s!^.*[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s*!!;
       $@ =~ s!\s+at\s+\S.*\s*$!!;
       croak($@);
   }
   return $lang;
}

sub is_delta
{
   my($self) = @_;
   my($bool) = undef;

   eval
   {
       if (defined($self->[0]) and
           ref($self->[0]) eq 'ARRAY' and
           defined($self->[0][0]))
       { $bool = ($self->[0][0] ? 1 : 0); }
   };
   if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   return $bool;
}

sub is_date
{
   my($self) = @_;
   my($bool) = undef;

   eval
   {
       if (defined($self->[0]) and
           ref($self->[0]) eq 'ARRAY' and
           defined($self->[0][0]))
       { $bool = ($self->[0][0] ? 0 : 1); }
   };
   if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   return $bool;
}

sub is_short
{
   my($self) = @_;
   my($bool) = undef;

   eval
   {
       if    (@{$self} == 4) { $bool = 1; }
       elsif (@{$self} == 7) { $bool = 0; }
   };
   if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   return $bool;
}

sub is_long
{
   my($self) = @_;
   my($bool) = undef;

   eval
   {
       if    (@{$self} == 7) { $bool = 1; }
       elsif (@{$self} == 4) { $bool = 0; }
   };
   if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   return $bool;
}

sub is_valid
{
   my($self) = @_;
   my($bool);

   $bool = eval
   {
       if (defined($self->[0]) and
           ref($self->[0]) eq 'ARRAY' and
           @{$self->[0]} > 0 and
           defined($self->[0][0]) and
           not ref($self->[0][0]) and
           ($self->[0][0] == 0 or $self->[0][0] == 1) and
           (@{$self} == 4 or @{$self} == 7))
       {
           if ($self->[0][0]) # is_delta
           {
               return 0 unless
               (
                   defined($self->[1]) and not ref($self->[1]) and
                   defined($self->[2]) and not ref($self->[2]) and
                   defined($self->[3]) and not ref($self->[3])
               );
               if (@{$self} > 4) # is_long
               {
                   return 0 unless
                   (
                       defined($self->[4]) and not ref($self->[4]) and
                       defined($self->[5]) and not ref($self->[5]) and
                       defined($self->[6]) and not ref($self->[6])
                   );
               }
               return 1;
           }
           else # is_date
           {
               return 0 unless
               (
                   defined($self->[1]) and not ref($self->[1]) and
                   defined($self->[2]) and not ref($self->[2]) and
                   defined($self->[3]) and not ref($self->[3]) and
                   check_date(@{$self}[1..3])
               );
               if (@{$self} > 4) # is_long
               {
                   return 0 unless
                   (
                       defined($self->[4]) and not ref($self->[4]) and
                       defined($self->[5]) and not ref($self->[5]) and
                       defined($self->[6]) and not ref($self->[6]) and
                       check_time(@{$self}[4..6])
                   );
               }
               return 1;
           }
       }
       return undef;
   };
   if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   return $bool;
}

sub normalize
{
   my($self) = shift;
   my($quot);

   if ($self->is_valid())
   {
       if ($self->is_delta())
       {
           if ($self->is_long())
           {
               splice( @{$self}, 3, 4, Normalize_DHMS(@{$self}[3..6]) );
           }
           unless ($ACCURATE_MODE) # YMD_MODE
           {
               if ($self->[2] and ($quot = int($self->[2] / 12)))
               {
                   $self->[1] += $quot;
                   $self->[2] -= $quot * 12;
               }
               if
               (
                   $self->[2] < 0 and
                 ( $self->[3] > 0 or
                   $self->[4] > 0 or
                   $self->[5] > 0 or
                   $self->[6] > 0 )
               )
               {
                   $self->[1]--;
                   $self->[2] += 12;
               }
               elsif
               (
                   $self->[2] > 0 and
                 ( $self->[3] < 0 or
                   $self->[4] < 0 or
                   $self->[5] < 0 or
                   $self->[6] < 0 )
               )
               {
                   $self->[1]++;
                   $self->[2] -= 12;
               }
           }
       }
       else
       {
           carp("normalizing a date is a no-op") if ($^W);
       }
   }
   return $self;
}

sub new
{
   my($class,$list,$type,$self);

   if (@_)
   {
       $class = shift;
       if (@_ == 1 and ref($_[0]) eq 'ARRAY') { $list = $_[0]; } else { $list = \@_; }
   }
   croak("wrong number of arguments")
       unless (defined($list) and
       (@$list == 0 or @$list == 1 or @$list == 3 or @$list == 4 or @$list == 6 or @$list == 7));
   if (@$list == 1 or @$list == 4 or @$list == 7)
   {
       $type = (shift(@$list) ? 1 : 0);
       $self = [ [$type], @$list ];
   }
   elsif (@$list == 3 or @$list == 6)
   {
       $self = [ [0], @$list ];
   }
   else
   {
       $self = [ [] ];
   }
   bless($self, ref($class) || $class || 'Date::Calc');
   return $self;
}

sub clone
{
   my($self) = @_;
   my($this);

   croak("invalid date/time") unless ($self->is_valid());
   $this = $self->new();
   @{$this} = @{$self};
   $this->[0] = [];
   @{$this->[0]} = @{$self->[0]};
   return $this;
}

sub copy
{
   my($self) = shift;
   my($this);

   eval
   {
       if (@_ == 1 and ref($_[0])) { $this = $_[0]; } else { $this = \@_; }
       @{$self} = @{$this};
       $self->[0] = [];
       if (defined $this->[0])
       {
           if (ref($this->[0]) eq 'ARRAY') { @{$self->[0]} = @{$this->[0]}; }
           else                            { $self->[0][0] = $this->[0]; }
       }
   };
   if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   croak("invalid date/time") unless ($self->is_valid());
   return $self;
}

sub date
{
   my($self,$list);

   if (@_)
   {
       $self = shift;
       if (@_ == 1 and ref($_[0]) eq 'ARRAY') { $list = $_[0]; } else { $list = \@_; }
   }
   croak("wrong number of arguments")
       unless (defined($list) and
       (@$list == 0 or @$list == 1 or @$list == 3 or @$list == 4 or @$list == 6 or @$list == 7));
   eval
   {
       if (@$list == 1 or @$list == 4 or @$list == 7)
       {
           $self->[0][0] = (shift(@$list) ? 1 : 0);
       }
       if (@$list == 3 or @$list == 6)
       {
           splice( @{$self}, 1, scalar(@$list), @$list );
       }
   };
   if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   croak("invalid date/time") unless ($self->is_valid());
   return (@{$self}[1..3]);
}

sub time
{
   my($self,$list);

   if (@_)
   {
       $self = shift;
       if (@_ == 1 and ref($_[0]) eq 'ARRAY') { $list = $_[0]; } else { $list = \@_; }
   }
   croak("wrong number of arguments")
       unless (defined($list) and
       (@$list == 0 or @$list == 1 or @$list == 3 or @$list == 4));
   eval
   {
       if (@$list == 1 or @$list == 4)
       {
           $self->[0][0] = (shift(@$list) ? 1 : 0);
       }
       if (@$list == 3)
       {
           splice( @{$self}, 4, 3, @$list );
       }
   };
   if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   croak("invalid date/time") unless ($self->is_valid());
   if (@{$self} == 7) { return (@{$self}[4..6]); }
   else               { return (); }
}

sub datetime
{
   my($self,$list);

   if (@_)
   {
       $self = shift;
       if (@_ == 1 and ref($_[0]) eq 'ARRAY') { $list = $_[0]; } else { $list = \@_; }
   }
   croak("wrong number of arguments")
       unless (defined($list) and
       (@$list == 0 or @$list == 1 or @$list == 3 or @$list == 4 or @$list == 6 or @$list == 7));
   eval
   {
       if (@$list == 1 or @$list == 4 or @$list == 7)
       {
           $self->[0][0] = (shift(@$list) ? 1 : 0);
       }
       if (@$list == 3)
       {
           splice( @{$self}, 1, 6, @$list, 0,0,0 );
       }
       elsif (@$list == 6)
       {
           splice( @{$self}, 1, 6, @$list );
       }
   };
   if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   croak("invalid date/time") unless ($self->is_valid());
   if (@{$self} == 7) { return (@{$self}[1..6]); }
   else               { return (@{$self}[1..3],0,0,0); }
}

sub today
{
   my($self) = shift;
   my($gmt)  = shift || 0;

   if (ref $self) # object method
   {
       $self->date( 0, Today($gmt) );
       return $self;
   }
   else           # class method
   {
       $self ||= 'Date::Calc';
       return $self->new( 0, Today($gmt) );
   }
}

sub now
{
   my($self) = shift;
   my($gmt)  = shift || 0;

   if (ref $self) # object method
   {
       $self->time( 0, Now($gmt) );
       return $self;
   }
   else           # class method
   {
       $self ||= 'Date::Calc';
       return $self->new( 0, Today_and_Now($gmt) );
   }
}

sub today_and_now
{
   my($self) = shift;
   my($gmt)  = shift || 0;

   if (ref $self) # object method
   {
       $self->date( 0, Today_and_Now($gmt) );
       return $self;
   }
   else           # class method
   {
       $self ||= 'Date::Calc';
       return $self->new( 0, Today_and_Now($gmt) );
   }
}

sub gmtime
{
   my($self) = shift;
   my(@date);

   eval
   {
       @date = (Gmtime(@_))[0..5];
   };
   if ($@)
   {
       $@ =~ s!^.*[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s*!!;
       $@ =~ s!\s+at\s+\S.*\s*$!!;
       croak($@);
   }
   if (ref $self) # object method
   {
       $self->date( 0, @date );
       return $self;
   }
   else           # class method
   {
       $self ||= 'Date::Calc';
       return $self->new( 0, @date );
   }
}

sub localtime
{
   my($self) = shift;
   my(@date);

   eval
   {
       @date = (Localtime(@_))[0..5];
   };
   if ($@)
   {
       $@ =~ s!^.*[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s*!!;
       $@ =~ s!\s+at\s+\S.*\s*$!!;
       croak($@);
   }
   if (ref $self) # object method
   {
       $self->date( 0, @date );
       return $self;
   }
   else           # class method
   {
       $self ||= 'Date::Calc';
       return $self->new( 0, @date );
   }
}

sub mktime
{
   my($self) = @_;
   my($time);

   if (ref $self) # object method
   {
       croak("invalid date/time")            unless ($self->is_valid());
       croak("can't mktime from a delta vector") if ($self->is_delta()); # add [1970,1,1,0,0,0] first!
       eval
       {
           $time = Mktime( $self->datetime() );
       };
       if ($@)
       {
           $@ =~ s!^.*[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s*!!;
           $@ =~ s!\s+at\s+\S.*\s*$!!;
           croak($@);
       }
       return $time;
   }
   else           # class method
   {
       return CORE::time();
   }
}

sub tzoffset
{
   my($self) = shift;
   my(@diff);

   eval
   {
       @diff = (Timezone(@_))[0..5];
   };
   if ($@)
   {
       $@ =~ s!^.*[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s*!!;
       $@ =~ s!\s+at\s+\S.*\s*$!!;
       croak($@);
   }
   if (ref $self) # object method
   {
       $self->date( 1, @diff );
       return $self;
   }
   else           # class method
   {
       $self ||= 'Date::Calc';
       return $self->new( 1, @diff );
   }
}

sub date2time
{
   my($self) = @_;
   my($time);

   if (ref $self) # object method
   {
       croak("invalid date/time")               unless ($self->is_valid());
       croak("can't make time from a delta vector") if ($self->is_delta()); # add [1970,1,1,0,0,0] first!
       eval
       {
           $time = Date_to_Time( $self->datetime() );
       };
       if ($@)
       {
           $@ =~ s!^.*[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s*!!;
           $@ =~ s!\s+at\s+\S.*\s*$!!;
           croak($@);
       }
       return $time;
   }
   else           # class method
   {
       return CORE::time();
   }
}

sub time2date
{
   my($self) = shift;
   my(@date);

   eval
   {
       @date = Time_to_Date(@_);
   };
   if ($@)
   {
       $@ =~ s!^.*[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s*!!;
       $@ =~ s!\s+at\s+\S.*\s*$!!;
       croak($@);
   }
   if (ref $self) # object method
   {
       $self->date( 0, @date );
       return $self;
   }
   else           # class method
   {
       $self ||= 'Date::Calc';
       return $self->new( 0, @date );
   }
}

sub year
{
   my($self) = shift;

   if (@_ > 0)
   {
       eval { $self->[1] = $_[0] || 0; };
       if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   }
   croak("invalid date/time") unless ($self->is_valid());
   return $self->[1];
}

sub month
{
   my($self) = shift;

   if (@_ > 0)
   {
       eval { $self->[2] = $_[0] || 0; };
       if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   }
   croak("invalid date/time") unless ($self->is_valid());
   return $self->[2];
}

sub day
{
   my($self) = shift;

   if (@_ > 0)
   {
       eval { $self->[3] = $_[0] || 0; };
       if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   }
   croak("invalid date/time") unless ($self->is_valid());
   return $self->[3];
}

sub hours
{
   my($self) = shift;

   if (@_ > 0)
   {
       eval
       {
           if (@{$self} == 4)
           {
               $self->[4] = 0;
               $self->[5] = 0;
               $self->[6] = 0;
           }
           if (@{$self} == 7)
           {
               $self->[4] = $_[0] || 0;
           }
       };
       if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   }
   croak("invalid date/time") unless ($self->is_valid());
   if (@{$self} == 7) { return $self->[4]; }
   else               { return undef; }
}

sub minutes
{
   my($self) = shift;

   if (@_ > 0)
   {
       eval
       {
           if (@{$self} == 4)
           {
               $self->[4] = 0;
               $self->[5] = 0;
               $self->[6] = 0;
           }
           if (@{$self} == 7)
           {
               $self->[5] = $_[0] || 0;
           }
       };
       if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   }
   croak("invalid date/time") unless ($self->is_valid());
   if (@{$self} == 7) { return $self->[5]; }
   else               { return undef; }
}

sub seconds
{
   my($self) = shift;

   if (@_ > 0)
   {
       eval
       {
           if (@{$self} == 4)
           {
               $self->[4] = 0;
               $self->[5] = 0;
               $self->[6] = 0;
           }
           if (@{$self} == 7)
           {
               $self->[6] = $_[0] || 0;
           }
       };
       if ($@) { $@ =~ s!\s+at\s+\S.*\s*$!!; croak($@); }
   }
   croak("invalid date/time") unless ($self->is_valid());
   if (@{$self} == 7) { return $self->[6]; }
   else               { return undef; }
}

###############################
##                           ##
##    Selector constants     ##
##    for formatting         ##
##    callback functions:    ##
##                           ##
###############################
##                           ##
##    IS_SHORT   =  0x00;    ##
##    IS_LONG    =  0x01;    ##
##    IS_DATE    =  0x00;    ##
##    IS_DELTA   =  0x02;    ##
##    TO_NUMBER  =  0x00;    ##
##    TO_STRING  =  0x04;    ##
##                           ##
###############################

sub number
{
   my($self,$format) = @_;
   my($number,$sign,@temp);

   if ($self->is_valid())
   {
       eval
       {
           $format = $NUMBER_FORMAT unless (defined $format); # because of overloading!
           if ($self->[0][0]) # is_delta
           {
#               carp("returning a fictitious number of days for delta vector")
#                   if ((($self->[1] != 0) or ($self->[2] != 0)) and $^W);
               if (@{$self} == 4) # is_short
               {
                   if (ref($format) eq 'CODE')
                   {
                       $number = &{$format}( $self, 0x02 ); # = TO_NUMBER | IS_DELTA | IS_SHORT
                   }
                   else
                   {
                       $number = ($self->[1]*12+$self->[2])*31+$self->[3];
                   }
               }
               else # is_long
               {
                   if (ref($format) eq 'CODE')
                   {
                       $number = &{$format}( $self, 0x03 ); # = TO_NUMBER | IS_DELTA | IS_LONG
                   }
                   elsif ($format == 2)
                   {
                       $number = ($self->[1]*12+$self->[2])*31+$self->[3] +
                           ((($self->[4]*60+$self->[5])*60+$self->[6])/86400);
                   }
                   else
                   {
                       local($_);
                       $sign = 0;
                       @temp = @{$self}[3..6];
                       $temp[0] += ($self->[1] * 12 + $self->[2]) * 31;
                       @temp = map( $_ < 0 ? $sign = -$_ : $_, Normalize_DHMS(@temp) );
                       $number = sprintf( "%s%d.%02d%02d%02d", $sign ? '-' : '', @temp );
                   }
               }
           }
           else # is_date
           {
               if (@{$self} == 4) # is_short
               {
                   if (ref($format) eq 'CODE')
                   {
                       $number = &{$format}( $self, 0x00 ); # = TO_NUMBER | IS_DATE | IS_SHORT
                   }
                   elsif ($format == 2 or $format == 1)
                   {
                       $number = Date_to_Days( @{$self}[1..3] );
                   }
                   else
                   {
                       $number = sprintf( "%04d%02d%02d",
                           @{$self}[1..3] );
                   }
               }
               else # is_long
               {
                   if (ref($format) eq 'CODE')
                   {
                       $number = &{$format}( $self, 0x01 ); # = TO_NUMBER | IS_DATE | IS_LONG
                   }
                   elsif ($format == 2)
                   {
                       $number = Date_to_Days( @{$self}[1..3] ) +
                           ((($self->[4]*60+$self->[5])*60+$self->[6])/86400);
                   }
                   elsif ($format == 1)
                   {
                       $number = Date_to_Days( @{$self}[1..3] ) .
                           sprintf( ".%02d%02d%02d", @{$self}[4..6] );
                   }
                   else
                   {
                       $number = sprintf( "%04d%02d%02d.%02d%02d%02d",
                           @{$self}[1..6] );
                   }
               }
           }
       };
       if ($@)
       {
           $@ =~ s!^.*[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s*!!;
           $@ =~ s!\s+at\s+\S.*\s*$!!;
           croak($@);
       }
       return $number;
   }
   return undef;
}

sub string
{
   my($self,$format,$language) = @_;
   my($restore,$string);

   if ($self->is_valid())
   {
       eval
       {
           if (defined($language) and $language ne '') # because of overloading!
           {
               if ($language =~ /^\d+$/)  { $restore = Language($language); }
               else                       { $restore = Language(Decode_Language($language)); }
           }
           else
           {
               if (defined $self->[0][3]) { $restore = Language($self->[0][3]); }
               else                       { $restore = undef; }
           }
       };
       if ($@)
       {
           $@ =~ s!^.*[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s*!!;
           $@ =~ s!\s+at\s+\S.*\s*$!!;
           croak($@);
       }
       eval
       {
           if ($self->[0][0]) # is_delta
           {
               $format = defined($self->[0][1]) ? $self->[0][1] : $DELTA_FORMAT
                   unless (defined $format); # because of overloading!
               if (@{$self} == 4) # is_short
               {
                   if (ref($format) eq 'CODE')
                   {
                       $string = &{$format}( $self, 0x06 ); # = TO_STRING | IS_DELTA | IS_SHORT
                   }
                   elsif ($format == 3)
                   {
                       $string = sprintf( "%+d Y %+d M %+d D",
                           @{$self}[1..3] );
                   }
                   elsif ($format == 2)
                   {
                       $string = sprintf( "%+dY %+dM %+dD",
                           @{$self}[1..3] );
                   }
                   elsif ($format == 1)
                   {
                       $string = sprintf( "%+d %+d %+d",
                           @{$self}[1..3] );
                   }
                   else
                   {
                       $string = sprintf( "%+d%+d%+d",
                           @{$self}[1..3] );
                   }
               }
               else # is_long
               {
                   if (ref($format) eq 'CODE')
                   {
                       $string = &{$format}( $self, 0x07 ); # = TO_STRING | IS_DELTA | IS_LONG
                   }
                   elsif ($format == 3)
                   {
                       $string = sprintf( "%+d Y %+d M %+d D %+d h %+d m %+d s",
                           @{$self}[1..6] );
                   }
                   elsif ($format == 2)
                   {
                       $string = sprintf( "%+dY %+dM %+dD %+dh %+dm %+ds",
                           @{$self}[1..6] );
                   }
                   elsif ($format == 1)
                   {
                       $string = sprintf( "%+d %+d %+d %+d %+d %+d",
                           @{$self}[1..6] );
                   }
                   else
                   {
                       $string = sprintf( "%+d%+d%+d%+d%+d%+d",
                           @{$self}[1..6] );
                   }
               }
           }
           else # is_date
           {
               $format = defined($self->[0][2]) ? $self->[0][2] : $DATE_FORMAT
                   unless (defined $format); # because of overloading!
               if (@{$self} == 4) # is_short
               {
                   if (ref($format) eq 'CODE')
                   {
                       $string = &{$format}( $self, 0x04 ); # = TO_STRING | IS_DATE | IS_SHORT
                   }
                   elsif ($format == 3)
                   {
                       $string = Date_to_Text_Long( @{$self}[1..3] );
                   }
                   elsif ($format == 2)
                   {
                       $string = Date_to_Text( @{$self}[1..3] );
                   }
                   elsif ($format == 1)
                   {
                       $string = sprintf( "%02d-%.3s-%04d",
                           $self->[3],
                           Month_to_Text($self->[2]),
                           $self->[1] );
                   }
                   else
                   {
                       $string = sprintf( "%04d%02d%02d",
                           @{$self}[1..3] );
                   }
               }
               else # is_long
               {
                   if (ref($format) eq 'CODE')
                   {
                       $string = &{$format}( $self, 0x05 ); # = TO_STRING | IS_DATE | IS_LONG
                   }
                   elsif ($format == 3)
                   {
                       $string = Date_to_Text_Long( @{$self}[1..3] ) .
                           sprintf( " %02d:%02d:%02d", @{$self}[4..6] );
                   }
                   elsif ($format == 2)
                   {
                       $string = Date_to_Text( @{$self}[1..3] ) .
                           sprintf( " %02d:%02d:%02d", @{$self}[4..6] );
                   }
                   elsif ($format == 1)
                   {
                       $string = sprintf( "%02d-%.3s-%04d %02d:%02d:%02d",
                           $self->[3],
                           Month_to_Text($self->[2]),
                           $self->[1],
                           @{$self}[4..6] );
                   }
                   else
                   {
                       $string = sprintf( "%04d%02d%02d%02d%02d%02d",
                           @{$self}[1..6] );
                   }
               }
           }
       };
       Language($restore) if (defined $restore);
       if ($@)
       {
           $@ =~ s!^.*[A-Za-z0-9_]+(?:::[A-Za-z0-9_]+)*\(\):\s*!!;
           $@ =~ s!\s+at\s+\S.*\s*$!!;
           croak($@);
       }
       return $string;
   }
   return undef;
}

sub _process_
{
   my($self,$this,$flag,$code) = @_;
   my($result,$val1,$val2,$len1,$len2,$last,$item);

   croak("invalid date/time") unless ($self->is_valid());
   if ($code == 0)
   {
       croak("can't apply unary minus to a date")
           unless ($self->is_delta());
       $result = $self->new();
       $result->[0][0] = $self->[0][0];
       for ( $item = 1; $item < @{$self}; $item++ )
       {
           $result->[$item] = -$self->[$item];
       }
       return $result;
   }
   if (defined $this and ref($this) =~ /[^:]::[^:]/)
   {
       croak("invalid date/time") unless ($this->is_valid());
   }
   elsif (defined $this and ref($this) eq 'ARRAY')
   {
       if (@{$this} == 3 or @{$this} == 6)
       {
           if ($code == 6)
           {
               $this = $self->new(0,@{$this});
           }
           elsif ($code == 5)
           {
               $this = $self->new($self->is_date(),@{$this});
           }
           else
           {
               $this = $self->new($self->is_delta(),@{$this});
           }
       }
       else
       {
           $this = $self->new(@{$this});
       }
       croak("invalid date/time") unless ($this->is_valid());
   }
   elsif (defined $this and not ref($this))
   {
       $this = $self->new(1,0,0,$this || 0);
       croak("invalid date/time") unless ($this->is_valid());
   }
   else { croak("illegal operand type"); }
   $val1 = $self->is_date();
   $val2 = $this->is_date();
   if ($code == 6 or $code == 5)
   {
       if ($code == 6)
       {
           croak("can't subtract a date from a delta vector")
               if ((not $val1 and $val2 and not $flag) or
                   ($val1 and not $val2 and $flag));
       }
       else
       {
           croak("can't add two dates")
               if ($val1 and $val2);
       }
       $len1 = $self->is_long();
       $len2 = $this->is_long();
       if ($len1 or $len2) { $last = 7; }
       else                { $last = 4; }
       if (defined $flag) { $result = $self->new((0) x $last); }
       else               { $result = $self; }
       if (not $val1 and not $val2)
       {
           $result->[0][0] = 1;
           for ( $item = 1; $item < $last; $item++ )
           {
               if ($code == 6)
               {
                   if ($flag)
                   {
                       $result->[$item] =
                           ($this->[$item] || 0) -
                           ($self->[$item] || 0);
                   }
                   else
                   {
                       $result->[$item] =
                           ($self->[$item] || 0) -
                           ($this->[$item] || 0);
                   }
               }
               else
               {
                   $result->[$item] =
                       ($self->[$item] || 0) +
                       ($this->[$item] || 0);
               }
           }
       }
       return ($result,$this,$val1,$val2,$len1,$len2);
   }
   elsif ($code <= 4 and $code >= 1)
   {
       croak("can't compare a date and a delta vector")
           if ($val1 xor $val2);
       if ($code >= 3)
       {
           if ($code == 4) { $last = 7; }
           else            { $last = 4; }
           $result = 1;
           ITEM:
           for ( $item = 1; $item < $last; $item++ )
           {
               if (($self->[$item] || 0) !=
                   ($this->[$item] || 0))
               { $result = 0; last ITEM; }
           }
           return $result;
       }
       else # ($code <= 2)
       {
#           croak("can't compare two delta vectors")
#               if (not $val1 and not $val2);
           if ($code == 2)
           {
               $len1 = $self->number();
               $len2 = $this->number();
           }
           else
           {
               $len1 = int($self->number());
               $len2 = int($this->number());
           }
           if ($flag) { return $len2 <=> $len1; }
           else       { return $len1 <=> $len2; }
       }
   }
   else { croak("unexpected internal error; please contact author"); }
}

sub _unary_minus_
{
   my($self,$this,$flag) = @_;

   return $self->_process_($this,$flag,0);
}

sub _compare_date_
{
   my($self,$this,$flag) = @_;

   return $self->_process_($this,$flag,1);
}

sub _compare_date_time_
{
   my($self,$this,$flag) = @_;

   return $self->_process_($this,$flag,2);
}

sub _equal_date_
{
   my($self,$this,$flag) = @_;

   return $self->_process_($this,$flag,3);
}

sub _not_equal_date_
{
   my($self,$this,$flag) = @_;

   return $self->_process_($this,$flag,3) ^ 1;
}

sub _equal_date_time_
{
   my($self,$this,$flag) = @_;

   return $self->_process_($this,$flag,4);
}

sub _not_equal_date_time_
{
   my($self,$this,$flag) = @_;

   return $self->_process_($this,$flag,4) ^ 1;
}

sub _date_time_
{
   my($self) = @_;

   if (@{$self} == 7) { return (@{$self}[1..6]); }
   else               { return (@{$self}[1..3],0,0,0); }
}

sub _add_
{
   my($result,$self,$this,$flag,$val1,$val2,$len1,$len2) = @_;

   if ($val1) # date + delta => date
   {
       if ($len1 or $len2)
       {
           splice( @{$result}, 1, 6,
               Add_Delta_YMDHMS( $self->_date_time_(),
                                 $this->_date_time_() ) );
       }
       else # short
       {
           splice( @{$result}, 1, 3,
               Add_Delta_YMD( @{$self}[1..3], @{$this}[1..3] ) );
       }
   }
   else # delta + date => date
   {
       if ($len1 or $len2)
       {
           splice( @{$result}, 1, 6,
               Add_Delta_YMDHMS( $this->_date_time_(),
                                 $self->_date_time_() ) );
       }
       else # short
       {
           splice( @{$result}, 1, 3,
               Add_Delta_YMD( @{$this}[1..3], @{$self}[1..3] ) );
       }
       carp("implicitly changed object type from delta vector to date")
           if (not defined $flag and $^W);
   }
   $result->[0][0] = 0;
}

sub _plus_
{
   my($self,$this,$flag) = @_;
   my($result,$val1,$val2,$len1,$len2);

   ($result,$this,$val1,$val2,$len1,$len2) = $self->_process_($this,$flag,5);
   if ($val1 or $val2)
   {
       $result->_add_($self,$this,$flag,$val1,$val2,$len1,$len2);
   }
   return $result;
}

sub _minus_
{
   my($self,$this,$flag) = @_;
   my($result,$val1,$val2,$len1,$len2,$temp,$item);

   ($result,$this,$val1,$val2,$len1,$len2) = $self->_process_($this,$flag,6);
   if ($val1 or $val2)
   {
       if ($val1 and $val2) # date - date => delta
       {
           if ($len1 or $len2)
           {
               if ($ACCURATE_MODE)
               {
                   if ($flag)
                   {
                       splice( @{$result}, 1, 6, 0, 0,
                           Delta_DHMS( $self->_date_time_(),
                                       $this->_date_time_() ) );
                   }
                   else
                   {
                       splice( @{$result}, 1, 6, 0, 0,
                           Delta_DHMS( $this->_date_time_(),
                                       $self->_date_time_() ) );
                   }
               }
               else # YMD_MODE
               {
                   if ($flag)
                   {
                       splice( @{$result}, 1, 6,
                           Delta_YMDHMS( $self->_date_time_(),
                                         $this->_date_time_() ) );
                   }
                   else
                   {
                       splice( @{$result}, 1, 6,
                           Delta_YMDHMS( $this->_date_time_(),
                                         $self->_date_time_() ) );
                   }
               }
           }
           else # short
           {
               if ($ACCURATE_MODE)
               {
                   if ($flag)
                   {
                       splice( @{$result}, 1, 3, 0, 0,
                           Delta_Days( @{$self}[1..3], @{$this}[1..3] ) );
                   }
                   else
                   {
                       splice( @{$result}, 1, 3, 0, 0,
                           Delta_Days( @{$this}[1..3], @{$self}[1..3] ) );
                   }
               }
               else # YMD_MODE
               {
                   if ($flag)
                   {
                       splice( @{$result}, 1, 3,
                           Delta_YMD( @{$self}[1..3], @{$this}[1..3] ) );
                   }
                   else
                   {
                       splice( @{$result}, 1, 3,
                           Delta_YMD( @{$this}[1..3], @{$self}[1..3] ) );
                   }
               }
           }
           carp("implicitly changed object type from date to delta vector")
               if (not defined $flag and $^W);
           $result->[0][0] = 1;
       }
       else # date - delta => date
       {
           if ($val1)
           {
               $temp = $this->new();
               $temp->[0][0] = $this->[0][0];
               for ( $item = 1; $item < @{$this}; $item++ )
               {
                   $temp->[$item] = -$this->[$item];
               }
               $result->_add_($self,$temp,$flag,$val1,$val2,$len1,$len2);
           }
           else
           {
               $temp = $self->new();
               $temp->[0][0] = $self->[0][0];
               for ( $item = 1; $item < @{$self}; $item++ )
               {
                   $temp->[$item] = -$self->[$item];
               }
               $result->_add_($temp,$this,$flag,$val1,$val2,$len1,$len2);
           }
       }
   }
   return $result;
}

sub _plus_equal_
{
   my($self,$this) = @_;

   return $self->_plus_($this,undef);
}

sub _minus_equal_
{
   my($self,$this) = @_;

   return $self->_minus_($this,undef);
}

sub _increment_
{
   my($self) = @_;

   return $self->_plus_(1,undef);
}

sub _decrement_
{
   my($self) = @_;

   return $self->_minus_(1,undef);
}

1;

__END__