# Copyright 2002-2008 Josh Clark and Global Moxie, LLC. This code cannot be 
# redistributed without permission from globalmoxie.com.  For more
# information, consult your Big Medium license.
#
# $Id: Time.pm 3043 2008-03-31 14:00:38Z josh $

package BigMed::Time;
use strict;
use utf8;
use Carp;
use base qw(Exporter);
use Time::Local;


my $ZERO_OFFSET = '+00:00';
my @MONTH_ABBR  = qw (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my @MONTH_FULL  = qw (January February March April May June July
  August September October November December);
my @WDAY_ABBR = qw (Sun Mon Tue Wed Thu Fri Sat);
my @WDAY_FULL = qw (Sunday Monday Tuesday Wednesday Thursday Friday Saturday);

my $MINUTE_SECONDS = 60;
my $HOUR_SECONDS   = 3600;
my $DAY_SECONDS    = 3600 * 24;

my $MAX_MONTHS = 12;
my $MIN_MONTHS = 1;

my %UNIT_MAP = (
    'y' => 'year',
    'm' => 'month',
    'd' => 'day',
    'H' => 'hour',
    'M' => 'minute',
    'S' => 'second'
);
my %DEFAULT = (
    'year'   => (gmtime)[5] + 1900,
    'month'  => 1,
    'day'    => 1,
    'hour'   => 0,
    'minute' => 0,
    'second' => 0,
    'offset' => $ZERO_OFFSET,
);

sub new {
    my $time = bless {}, shift;
    $time->initialize(@_);
}

sub initialize {
    my $time    = shift;
    my %options = @_;
    $options{offset} = _check_offset( $options{offset} );

    if ( $options{bigmed_time} ) {
        my ( $date, $clock ) = split( / /, $options{bigmed_time} );
        @$time{qw(year month day)}     = split( /\-/, $date );
        @$time{qw(hour minute second)} = split( /:/,  $clock );
        @$time{qw(bigmed_time offset)} = @options{qw(bigmed_time offset)};
        $time->_apply_offset if $time->{offset};
    }
    elsif ( defined $options{year} ) {
        $time->set_datetime(%options);
    }
    else {
        @$time{qw(second minute hour day month year)} = (gmtime)[0 .. 5];
        $time->{year}  += 1900;
        $time->{month} += 1;
        if ( $options{offset} ) {
            $time->{offset} = $options{offset};
            $time->_apply_offset;
        }
        else {
            $time->{offset} = $DEFAULT{offset};
        }
    }
    $time;
}

sub set_datetime {
    my $time    = shift;
    my %options = @_;
    foreach my $unit qw(year month day hour minute second) {
        if ( defined $options{$unit} ) {
            $time->{$unit} = int( $options{$unit} );
        }
        elsif ( !defined $time->{$unit} ) {
            $time->{$unit} = $DEFAULT{$unit};
        }
    }
    $options{offset} = _check_offset( $options{offset} );
    $time->{offset} = $options{offset} || $time->{offset} || $DEFAULT{offset};
    croak "Time or date value out of range"
      if $time->{hour} > 23
      || $time->{minute} > 59
      || $time->{second} > 59
      || $time->{month} > 12
      || $time->{day} > 31
      || $time->{hour} < 0
      || $time->{minute} < 0
      || $time->{second} < 0
      || $time->{month} < 1
      || $time->{day} < 1
      || $time->{year} < 1;

    $time->_set_date_from_julian;
}

sub year       { $_[0]->{year} }
sub month      { $_[0]->{month} + 0 }
sub month_full { $MONTH_FULL[$_[0]->{month} - 1] }
sub month_abbr { $MONTH_ABBR[$_[0]->{month} - 1] }
sub day        { $_[0]->{day} }
sub hour       { $_[0]->{hour} }
sub minute     { sprintf( '%02d', $_[0]->{minute} ) }
sub second     { sprintf( '%02d', $_[0]->{second} ) }
sub wkday {    # 0=sun, 6=sat
    $_[0]->_set_date_from_julian if !$_[0]->{wkday};
    $_[0]->{wkday};
}
sub wkday_full { $WDAY_FULL[$_[0]->wkday] }
sub wkday_abbr { $WDAY_ABBR[$_[0]->wkday] }
sub offset     { $_[0]->{offset} || $ZERO_OFFSET }

sub time_ampm {
    my $self = shift;
    my $hour = $self->{hour} > 12 ? $self->{hour} - 12
             : $self->{hour} == 0 ? 12
             :                      $self->{hour};
    my $ampm = $self->{hour} >= 12 ? 'pm' : 'am';
    return $hour . ':' . sprintf( '%02d', $self->{minute} ) . $ampm;
}

sub time_24 {
    sprintf( '%02d', $_[0]->{hour} ) . ':'
      . sprintf( '%02d', $_[0]->{minute} );
}

sub bigmed_time {

    # accepts a hash set of time values and returns a
    # bigmed-formatted (MySQL) timestamp string:
    # 2005-01-09 15:34:12

    my $self = shift;
    my $time;
    if ( $_[0] && ref $_[0] && $_[0]->isa('BigMed::Time') ) {
        $time = $_[0];
    }
    elsif (@_) {
        $time = $self->new(@_);
    }
    elsif ( ref $self && $self->isa('BigMed::Time') ) {
        $time = $self;
    }
    else {
        return undef;
    }

    ##If there's an offset, need to convert to UTC time; if so,
    ##use a clone so that the current time is not disturbed.
    my $utc_time;
    if ( $time->{offset} && $time->{offset} ne $ZERO_OFFSET ) {
        $utc_time = $time->clone;
        $utc_time->make_utc;
    }
    else {
        $utc_time = $time;
    }
    return sprintf( "%04d-%02d-%02d %02d:%02d:%02d",
        @$utc_time{qw(year month day hour minute second)} );
}

sub julian_day {
    my $time = shift;
    my ( $m, $d, $y ) = @$time{qw(month day year)};
    my ( $ya, $c );
    $y = ( localtime(time) )[5] + 1900 if ( $y eq '' );
    if ( $m > 2 ) {
        $m -= 3;
    }
    else {
        $m += 9;
        --$y;
    }
    $c = int( $y / 100 );
    $ya = $y - ( 100 * $c );
    return
      int( ( 146097 * $c ) / 4 ) + int( ( 1461 * $ya ) / 4 ) +
      int( ( 153 * $m + 2 ) / 5 ) + $d + 1721119;
}

sub make_utc {
    $_[0]->_apply_offset('utc');
    $_[0]->{offset} = $ZERO_OFFSET;
}

sub clone {
    my $class = ref $_[0];
    $class->new( %{ $_[0] } );
}

sub shift_time {
    my $time       = shift;
    my @increments = @_;
    my %math;

    #collect the increments
    foreach my $offset (@increments) {
        my ( $sign, $num, $unit );
        if ( $offset =~ m{^([\+\-])(\d+)([ymdHMS])$} ) {
            ( $sign, $num, $unit ) = ( $1, $2, $3 );
            my $plusminus = $sign eq '+' ? 1 : -1;
            $math{$unit} ||= 0;
            $math{$unit} += $num * $plusminus;
        }
        else {
            croak "Usage: \$time->shift_time(qw(+1d -2H))";
        }
    }
    return $time unless %math;

    #do the year and month, then get the julian day and do day adustment.
    $time->{year}  += $math{'y'} if $math{'y'};
    $time->{month} += $math{'m'} if $math{'m'};
    while ( $time->{month} > $MAX_MONTHS ) {
        $time->{year}++;
        $time->{month} -= $MAX_MONTHS;
    }
    while ( $time->{month} < $MIN_MONTHS ) {
        $time->{year}--;
        $time->{month} += $MAX_MONTHS;
    }
    my $julian = $time->julian_day;
    $julian += $math{'d'} if $math{'d'};

    #calculate the number of seconds to shift, and add in the number
    #of seconds in the current day; result is amount of time to shift
    #from 00:00:00 of current day.
    my $seconds = 0;
    $seconds += $math{'S'}                   if $math{'S'};
    $seconds += $math{'M'} * $MINUTE_SECONDS if $math{'M'};
    $seconds += $math{'H'} * $HOUR_SECONDS   if $math{'H'};
    $seconds += $time->{second};
    $seconds += $time->{minute} * $MINUTE_SECONDS;
    $seconds += $time->{hour} * $HOUR_SECONDS;
    $julian  += int( $seconds / $DAY_SECONDS );

    #get the leftover seconds to change the time
    my $seconds_from_midnight;
    if ( $seconds < 0 ) {    #crossing over midnight into previous day
        $julian--;
        $seconds *= -1;
        #get the seconds *back* from midnight:
        $seconds_from_midnight = $seconds % $DAY_SECONDS;
        #seconds forward from midnight of true day:
        $seconds_from_midnight = $DAY_SECONDS - $seconds_from_midnight;
    }
    else {
        $seconds_from_midnight = $seconds % $DAY_SECONDS;
    }
    $time->{hour} = int( $seconds_from_midnight / $HOUR_SECONDS );
    my $seconds_from_hour = $seconds_from_midnight % $HOUR_SECONDS;
    $time->{minute} = int( $seconds_from_hour / $MINUTE_SECONDS );
    $time->{second} = $seconds_from_hour % $MINUTE_SECONDS;

    #reset the date using our calculated julian date.
    $time->_set_date_from_julian($julian);
    $time;
}

sub _check_offset {
    my $offset = $_[0] || return $_[0];
    if ( $offset =~ /^[\+\-](\d\d?)?:(\d\d)(?::(\d\d))?$/ ) {
        if ( ( $1 && $1 > 23 ) || ( $2 && $2 > 59 ) || ( $3 && $3 > 59 ) ) {
            croak "Bad offset format. Must be: hours<= 23, min and sec <= 59";
        }
    }
    else {
        croak "Bad offset format: Should be +HH:MM or +HH:MM:SS";
    }
    $offset;
}

sub _apply_offset {

    #adjusts the current time settings by the offset value
    my $time    = shift;
    my $reverse = $_[0] && $_[0] eq 'utc' ? 1 : 0;
    my $offset  = $time->offset;
    return $time if $offset eq $ZERO_OFFSET;
    my ( $plusminus, $hour, $minute, $second );
    if ( $offset =~ m{^([\+\-])(\d\d?):(\d\d)(?::(\d\d))?$} ) {
        ( $plusminus, $hour, $minute, $second ) = ( $1, $2, $3, $4 );
        if ($reverse) {
            $plusminus = $plusminus eq '+' ? '-' : '+';
        }
        if ( $hour > 23 || $minute > 59 ) {
            croak "Bad offset: Hours must be <= 23 , minutes <= 59";
        }
    }
    else {
        return undef;
    }
    my @increments;
    push @increments, $plusminus . $hour . 'H'   if $hour;
    push @increments, $plusminus . $minute . 'M' if $minute;
    push @increments, $plusminus . $second . 'S' if $second;
    $time->shift_time(@increments);
}

sub _set_date_from_julian {

    #reset the month/day/year/wkday by getting the jday and recalculating;
    #basically need to do this anytime that the month/day/year is reset
    my $time = shift;
    my $jd   = shift || $time->julian_day;
    my ($jdate_tmp);
    my ( $m, $d, $y, $wkday );
    $wkday     = ( $jd + 1 ) % 7;    # calculate weekday (0=Sun,6=Sat)
    $jdate_tmp = $jd - 1721119;
    $y         = int( ( 4 * $jdate_tmp - 1 ) / 146097 );
    $jdate_tmp = 4 * $jdate_tmp - 1 - 146097 * $y;
    $d         = int( $jdate_tmp / 4 );
    $jdate_tmp = int( ( 4 * $d + 3 ) / 1461 );
    $d         = 4 * $d + 3 - 1461 * $jdate_tmp;
    $d         = int( ( $d + 4 ) / 4 );
    $m         = int( ( 5 * $d - 3 ) / 153 );
    $d         = 5 * $d - 3 - 153 * $m;
    $d         = int( ( $d + 5 ) / 5 );
    $y         = 100 * $y + $jdate_tmp;

    if ( $m < 10 ) {
        $m += 3;
    }
    else {
        $m -= 9;
        ++$y;
    }
    @$time{qw(month day year wkday)} = ( $m, $d, $y, $wkday );
    $time;
}

1;

__END__


=head1 NAME

BigMed::Time - Big Medium date/time object

=head1 DESCRIPTION

BigMed::Time provides a fairly basic set of tools to get the current time,
add and subtract time, and generate time values to/from Big Medium-formatted
time strings.

BigMed::Time does not provide the depth, breadth and flexibility of the
DateTime project, but it's light, reasonably fast and, since it's pure
Perl, it doesn't need to be compiled. Although it's pure Perl, BigMed::Time
does not depend on the limitations of the Perl epoch and so is not limited to
the 1902-2037 years that limit some time systems.

=head1 SYNOPSIS

    #get the current time in the UTC/GMT time zone.
    my $time     = BigMed::Time->new();
    my $utc_hour = $time->hour;                 # Hour in UTC time: 00 to 23

    #get the current time in Paris, two hours ahead of UTC
    my $paris = BigMed::Time->new( offset => '+02:00' );
    my $paris_hour = $time->hour;               # Hour in local Paris time

    # Big Medium always uses UTC time for internal timestamps;
    # so retrieving a "bigmed_time" always returns the time in the
    # UTC time zone, converting from the local time. In the examples
    # above, both time objects were created at the same time, so both
    # will have the same bigmed_time, even though they show different
    # *local* times.
    my $bigmed_time   = $time->bigmed_time;     # 2005-10-25 14:56:32
    my $paris_bm_time = $paris->bigmed_time;    # same
    
    # Create a time object from a Big Medium datetime string
    # in eastern standard time zone (New York)
    my $this_time =
      BigMed::Time->new( '1984-12-25 06:32:15', offset => '-04:00' );

    # Get time information from the object
    my $second      = $time->second;            # 00 to 59
    my $minute      = $time->minute;            # 00 to 59
    my $hour        = $time->hour;              # 00 to 23
    my $wkday       = $time->wkday;             # 0 to 6 (0=Sun, 6=Sat)
    my $wkday_abbr  = $time->wkday_abbr;        # Sun, Mon, Tue, Wed etc
    my $wkday_full  = $time->wkday_full;        # Sunday, Monday, Tuesday etc
    my $day         = $time->day;               # 1 to 31
    my $month       = $time->month;             # 1 to 12
    my $month_abbr  = $time->month_abbr;        # Jan, Feb, Mar etc
    my $month_full  = $time->month_full;        # January, February, March etc
    my $year        = $time->year;              # 2005, 1972, 876, 3050
    my $julian_day = $time->julian_day;       # days since Jan 1, 4713 BC
    my $offset = $time->offset;   # offset from UTC: -07:00, +01:30, +01:00:32

    #change the time to 1:30pm
    my $time = $time->set_datetime( hour => 13, minute => 30 );
    
    #jump ahead two days and 45 minutes
    my $time = $time->shift_time( qw(+2d +45M) );

=head1 USAGE

=head2 About local times and UTC times

Big Medium uses coordinated universal time (UTC) time, which for our purposes
here is basically the same as Greenwich Mean Time. UTC time is used for
internal time stamps on all saved data, for example. These timestamps are
represented by strings that look like this:

    1995-03-23 23:52:17  # March 23, 1995, at 11:52:17 pm UTC

By default, BigMed::Time objects return datetimes in the UTC time zone.
However, you can have a BigMed::Time object represent a local time by
specifying a time zone offset: the number of hours and minutes (and, optionally
seconds) to offset from UTC.

When working with a BigMed::Time object with a local time zone, any time or
date attributes that you request from the object will then be returned in
local time, with one important exception. The Big Medium time (retrieved
via the C<bigmed_time> method) will be in UTC time.

This means that you can create objects from local time information submitted
by a user, display local time information to him or her, but Big Medium
will still save the data in UTC time. When you retrieve that UTC time later,
you can indicate you would like that time in a local time zone, and the
local time information will be displayed.

=head2 Constructor Method

=head3 C<< BigMed::Time->new(%options) >>

Returns a BigMed::Time object. To get the current time in the UTC
time zone, make the call without any arguments:

    my $time = BigMed::Time->new(); #current UTC time

To get the current time in a local time zone, specify the offset:

    #local time zone is two hours ahead of UTC time
    my $time = BigMed::Time->new( offset => '+02:00' );

To get an object based on a Big Medium datetime string:

    #get a date object for the UTC time zone
    my $utc = BigMed::Time->new(
        bigmed_time => '1988-11-30 14:06:32'
    );

    #or get a local time by specifying the offset
    my $local = BigMed::Time->new(
        bigmed_time => '1988-11-30 14:06:32',
        offset => '-07:00',
    );

Note that in the example above, both times are for the exact same UTC
time (they refer to the same instant in history), but will return
different display times because they're in different time zones.
So they'll both return the same Big Medium time:

    print "true" if $utc->bigmed_time eq $local->bigmed_time; #TRUE!

To create an object for a custom datetime, you can specify specific
date and time information.  All of these attributes are optional
except for the year. If the year is omitted, the current date and time
will be returned (in the UTC time zone, unless you specify an offset).

    my $time = BigMed::Time->new(
        year   => 2003,
        month  => 1,           # 1-12
        day    => 16,          # 1-31
        hour   => 14,          # 0-23
        minute => 6,           # 0-59
        second => 37,          # 0-59
        offset => '-05:00',    # +/- followed by HH:MM or HH:MM:SS
      )

If you specify a time zone offset, as above, then the time information
that you submitted will be treated as the local time information, not
the UTC time.  This is a subtle but important difference from the
method used above to create an object from a Big Medium datetime string.
In that case, we were providing a UTC time and asking for an object
in the local time zone. In this case, we're also asking for an object
in the local time zone but we're doing so by providing the local
time information, not the UTC time.

The C<new> method will throw exceptions if you ask for date or time
parameters that are out of range of possible values. It will not
throw an exception, however, for dates that do not exist. Instead,
it will silently correct the date. For example, September 31 becomes
October 1. February 29 in non-leap years become March 1, February 31
becomes March 3, etc.

BigMed::Time can handle any positive year.  Sorry, BC/BCE dates
are out of our range.

=head2 Accessors

=over 4

=item * C<< $time->bigmed_time >>

Returns the Big Medium system string for the object's datetime.
The format is the same as the MySQL datetime:

    1998-01-30 14:23:02

=item * C<< $time->year >>

Returns the four-digit year.

=item * C<< $time->month >>

Returns the number of the month, 1 to 12.

=item * C<< $time->month_abbr >>

Returns the three-letter abbreviated name of the month in English:
Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec

=item * C<< $time->month_full >>

Returns the full month name in English: January February March April May
June July August September October November December

=item * C<< $time->day >>

Returns the number of the day of the month, 1 to 31.

=item * C<< $time->hour >>

Returns the hour of the day as a two-digit string, 00 to 23.

=item * C<< $time->minute >>

Returns the minute of the hour as a two-digit string, 00 to 59.

=item * C<< $time->second >>

Returns the second of the minute as a two-digit string, 00 to 59.

=item * C<< $time->time_ampm >>

Returns the 12-hour AM/PM format for the hour/minute portion of the date.
For example: 2:38pm

=item * C<< $time->time_24 >>

Returns the 24-hour format for the hour/minute portion of the date.
For example: 14:38

=item * C<< $time->julian_day >>

Returns the Julian day, the number of days that have elapsed since 12 noon
UTC on Monday, January 1, 4713 BC in the proleptic Julian calendar (how's
that for a mouthful).

=back

=head2 Changing the Time

=head3 C<< $time->shift_time(@increments) >>

Changes the object's date or time based on the unit-specific increments you
specify and returns the time object.

    # one day later
    $time->shift_time('+1d');
    
    #three days and two hours later
    $time->shift_time('+3d', '+2H');
    
    #3 months, 23 minutes and 48 seconds earlier
    $time->shift_time('-3m', '-23M', '-48S');

Each increment in the array should be a string starting with '+' or '-'
followed by a number and a unit letter. These unit letters are case
sensitive:

    y   year
    d   day
    m   month
    H   hour
    M   minute
    S   second

You can also mix and match + and - values:

    #1 year ago but three hours later in the day
    $time->shift_time('-1y', '+3H');

All of this can be useful, for example, when you want to do a Big Medium
search in a relative date range. For example, to find user objects
modified in the last day:

    my $time = BigMed::Time->new();
    $time->shift_time('-1d');
    my $bmtime    = $time->bigmed_time;
    my $selection = BigMed::User->select(
      {
        mod_time => { from => $bmtime }
      }
   );

=head3 C<< $time->set_datetime(%options) >>

Changes the object's date and time values. Accepts the same options as
the C<new> constructor, except for the bigmed_time parameter. The changes
are applied to whatever time zone in which the object is located.

=head3 Changing an Object's Time Zone Offset

In general, it's best to avoid changing a time object's time zone
offset after you've created it.  It can get... confusing....
But if you need to change the time zone of an object after it's been
created, you can do it with a little extra work.

First things first, this is probably not going to do what you want:

    $time->set_datetime( offset => '+02:00' ) #not quite what you want

This tells it to consider its current datetime
attributes to be in a local time zone but does not actually update those
datetime attributes.

So if you have an object that says it's 11:00am UTC time and then you tell
it that its offset is now +03:00, it will still tell you that it's 11:00am.
Only that's 11:00am in eastern Europe, not Greenwich England as it originally
was. While the display time is staying the same, in other words, the object's
universal time has changed. It's no longer referring to the same moment
in history. So when you ask for the Big Medium time, you'll get a timestamp
for 8:00am.

This means that if you want to take an existing object and change its
time zone offset without changing its universal time, you need to change
the time yourself using C<shift_time>. For example

    my $time = BigMed::Time->new(); #current UTC time.
    print $time->bigmed_time; # 2005-01-01 09:00:01
    print $time->hour; # 9

    my $atlanta = BigMed::Time->new();
    print $atlanta->bigmed_time; # 2005-01-01 09:00:01, same UTC time
    $atlanta->set_datetime( offset => '-04:00'); #change time zone
    print $atlanta->hour; # still 9, but 9 in Atlanta
    print $atlanta->bigmed_time; #2004-01-01 13:00:01, 1pm UTC!
    $time->shift_time('-4H'); #shift time to make it 9am UTC, 5am Atlanta

    #blech! there's an easier way...
    #much simpler to give correct offset when creating the object
    my $easier = BigMed::Time->new(offset => '-04:00');
    print $easier->bigmed_time; # 2005-01-01 09:00:01, correct UTC time
    print $easier->hour; # 5, 5:00am local Atlanta time

The exception to all of this is the C<make_utc> object which makes
the object's values local to the UTC time zone without changing its
actual universal time.

=head2 Utility Methods

=head3 C<< $time->clone() >>

Returns a clone of the time object.

=head3 C<< $time->make_utc >>

Converts the object to the UTC time zone if it has a time zone offset
(otherwise, not much happens). Internally, it will still
use the same universal time, but its accessors will now report the local
time for the UTC time zone.

=head1 AUTHOR & COPYRIGHTS

This module and all Big Medium modules are copyright Josh Clark
and Global Moxie. All rights reserved.

Use of this module and the Big Medium content
management system are governed by Global Moxie's software licenses
and may not be used outside of the terms and conditions outlined
there.

For more information, visit the Global Moxie website at
L<http://globalmoxie.com/>.

Big Medium and Global Moxie are service marks of Global Moxie
and Josh Clark. All rights reserved.

=cut