# $Id: Timeslot.pm,v 1.11 2004/02/04 00:34:43 gwolf Exp $
######################################
# Comas - Conference Management System
######################################
# Copyright 2003 CONSOL
# Congreso Nacional de Software Libre (http://www.consol.org.mx/)
#   Gunnar Wolf <gwolf@gwolf.cx>
#   Manuel Rabade <mig@mig-29.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
######################################

######################################
# Module: Comas::Schedule::Timeslot
# Represents a given timeslot in a Comas schedule
######################################
# Depends on:
#
# Date::Parse - Parse date strings into time values
# Date::Calc - Gregorian calendar date calculations

package Comas::Schedule::Timeslot;

use strict;
use warnings;
use Carp;
use Date::Parse qw(strptime);
use Date::Calc qw(Add_Delta_DHMS);

=head1 NAME
    
Comas::Schedule::Timeslot - Represents a given timeslot in a Comas schedule

=head1 SYNOPSIS

=head2 OBJECT CONSTRUCTOR/REFRESHER

  $tslot = Comas::Schedule::Timeslot->new(-id=>$id, -db=>$db);

  $tslot = Comas::Schedule::Timeslot->new(-day=>$day, -start_hr=>$start_hr,
                                          -room_id=>$room, -db=>$db);

$id is the ID for the timeslot we are creating, $db is an existing Comas::DB
object, $day is a valid date string (i.e. '2004-02-13'), $start_hr is a valid
time string (i.e. '10:00'), $room_id is the ID for a room.

  $ok = $tslot->refresh;

Queries the database and updates its in-memory representation. Every time a
Comas::Schedule::Timeslot method that modifies something in the database is
called, it will call refresh before doing so in order to ensure no changes
happened since the object was last refreshed.

=head2 ATTRIBUTE ACCESSORS AND STATUS QUERYING

  @types = $tslot->get_prop_types;

Returns an array with the different proposal types accepted by this timeslot

  $id = $tslot->get_id;

Returns this timeslot's ID

  $room = $tslot->get_room;

Returns the ID of the room to which this timeslot belongs

  $day = $tslot->get_day;

Returns the date on which this timeslot begins (as handed by the database,
typically as a 'yyyy-mm-dd' string)

  $start_hr = $tslot->get_start_hr;

Returns the hour at which this timeslot starts (as a 'hh:mm' string)

  %types = $tslot->get_end_hr;

Returns the possible hours at which this timeslot can end. The return format
is a hash, where the keys are the proposal types this timeslot can hold and the
values are the hours (as a 'hh:mm' string) such proposal would end. If the 
proposal would end past midnight (i.e., it starts at 20:00 and its duration is
8 hours), instead of 'hh:mm' it returns '1:hh:mm'. Anyway, for your 
attendance's sake, we strongly advise you not to schedule proposals after 
midnight ;-)

    $max_hr = $tslot->get_max_hr;

Returns the latest possible hour at which this proposal will end. As explained
in C<$tslot->get_end_hr>, if the proposal ends past midnight, it will return
'1:hh:mm' instead of 'hh:mm'.

  ($id, $type) = $tslot->get_proposal;

Returns the proposal ID and type for the proposal scheduled on this timeslot,
or undef if no proposal has been scheduled here

  $ok = $tslot->is_free;

Returns a true value (1) if this timeslot is free (this means, it has no 
scheduled proposals attached to it), a false value (0) if it has a scheduled
proposal. If an error occurs while looking up the information, it returns 
undef.

  $ok = $tslot->is_available
  $ok = $tslot->is_available($type[, $type2[, $type3[, ...]]])

Returns a true value (1) if this timeslot is available for hosting a proposal
of each of the specified types (this means, it can host a proposal of the 
requested type, has no scheduled proposals attached to it and is not concurrent
with any other timeslot in this same room which is not free for the length of 
time needed to host a proposal of the requested type), a false value (0) if it 
is not available. If an error occurs while looking up the information, it 
returns undef.

If no proposal type is specified, it will return true (1) if this timeslot is
available for any of its possible proposal types.

What is the difference between is_free and is_available? An example will
illistrate this better. We might have the following timeslots defined for a
given room and day:

  ID   start_hr
  1    10:00
  2    11:00
  3    12:00
  4    13:00

and the following proposal types:

  ID Duration Description
  1  1 hour   Presentation
  2  2 hours  Tutorial
  3  4 hours  Workshop

with the following proposal types available for each:

  Timeslot Type Start  End
  1        1    10:00  11:00
  1        2    10:00  12:00
  1        3    10:00  14:00
  2        1    11:00  12:00
  3        1    12:00  13:00
  3        2    12:00  14:00
  4        1    13:00  14:00

This means that if timeslot 1 was assigned to a workshop (proposal type 3), 
timeslots 2, 3 and 4 would be free, but not available, as the room would be
taken until 14:00.

=head2 LOOKING FOR SIMULTANEOUS TIMESLOTS

  @tslot_id = $tslot->simultaneous_timeslots;

Returns the list of the timeslots that overlap with this one (regardless of in
which room they are). Note that a timeslot may host different proposal types,
each of which can have different durations - this method will include 
B<every> possible overlap. If a timeslot has not been related to a proposal
type, it will return undef - As nothing can be scheduled to it, no timeslot
can be simultaneous with it.

  @tslot_id = $tslot->simultaneous_free_timeslots;

Returns the list of free (empty) timeslots that overlap with this one. The 
notes on C<simultaneous_timeslots> applies here as well.

  @tslot_id = $tslot->simultaneous_used_timeslots;

Returns the list of timeslots that overlap with this one and have a proposal 
assigned to it. The notes on C<simultaneous_timeslots> applies here as well.

=head2 SCHEDULING PROPOSALS

  $ok = $tslot->schedule($prop_id);

Schedules the given proposal ID to be held in this timeslot. If the timeslot
had already a scheduled proposal, that proposal will be unscheduled before the
new one gets scheduled.. 

  $ok = $tslot->unschedule;

Removes the proposal scheduled for this timeslot and frees the timeslot (making
it, of course, available). 

=head1 REQUIRES

    Date::Parse - Parse date strings into time values
    Date::Calc - Gregorian calendar date calculations

=head1 SEE ALSO

    L<Comas::Schedule|Comas::Schedule>

=head1 AUTHOR

Gunnar Wolf, gwolf@gwolf.cx

Manuel Rabade, mig@mig-29.net

Comas has been developed for CONSOL, Congreso Nacional de Software Libre,
http://www.consol.org.mx/

=head1 COPYRIGHT

Copyright 2003 Gunnar Wolf and Manuel Rabade

This library is free software, you can redistribute it and/or modify it
under the terms of the GPL version 2 or later.

=cut

sub new {
    my ($class, $tslot);
    $class = shift;
    $tslot = {@_};
    bless ($tslot, $class);

    if (defined $tslot->{-id} and defined $tslot->{-db} and
	scalar(keys %$tslot) == 2) {
	$tslot->refresh or return undef;

	return $tslot;
    } elsif (defined $tslot->{-room_id} and defined $tslot->{-start_hr} and
	     defined $tslot->{-day} and defined $tslot->{-db} and
	     scalar(keys %$tslot) == 4) {
	my ($sth, $rv, $id);
	unless ($sth = $tslot->{-db}->prepare('SELECT id FROM timeslot WHERE
                start_hr = ? AND day = ? AND room_id = ?') and 
		$rv = $sth->execute($tslot->{-start_hr}, $tslot->{-day}, 
				    $tslot->{-room_id})) {
	    carp 'Error searching for specified timeslot';
	    return undef;
	}

	($id) = $sth->fetchrow_array;

	return Comas::Schedule::Timeslot->new(-id=>$id, -db=>$tslot->{-db});	
    } else {
	carp 'Invocation error';
	return undef;
    }

}

sub refresh {
    my ($tslot, $sth);
    $tslot = shift;

    # First, we build the timeslot's basic attributes - start_hr, and room.
    unless ($sth = $tslot->{-db}->prepare('SELECT start_hr, day, room_id FROM
            timeslot WHERE id = ?') and $sth->execute($tslot->{-id})) {
	carp "Unable to query for the timeslot's information";
	return undef;
    }
    unless ( ($tslot->{-start_hr}, $tslot->{-day}, 
	      $tslot->{-room}) = $sth->fetchrow_array) {
	carp 'Specified timeslot does not exist';
	return undef;
    }

    $tslot->{-start_hr} = $tslot->_parse_hr($tslot->{-start_hr});

    # And now, for the tricky part... We want to build the prop_types attribute.
    # It is a hash, where the prop_type IDs are the keys and the value is an
    # array reference with the hour at which this timeslot would end if it 
    # hosted a proposal of that type_id
    unless ($sth = $tslot->{-db}->prepare('SELECT p.id, p.duration FROM 
            prop_type p, timeslot_prop_type pt WHERE p.id=pt.type AND 
            pt.timeslot = ?') and $sth->execute($tslot->{-id})) {
	carp "Unable to query for the timeslot's valid proposal types";
	return undef;
    }
    $tslot->{-prop_types} = {map {$_->[0] => $tslot->_add_duration($_->[1])}
			     @{$sth->fetchall_arrayref}};

    # Is there a proposal already assigned to this timeslot?
    # Only one proposal might exist per timeslot - We do a simple fetchrow_array
    unless ($sth = $tslot->{-db}->prepare('SELECT id, prop_type_id FROM proposal
            WHERE timeslot_id = ?') and $sth->execute($tslot->{-id})) {
	carp 'Unable to query for a proposal in this timeslot';
	return undef;
    }
    $tslot->{-proposal} = [$sth->fetchrow_array];

    return 1;
}

sub get_prop_types {
    my $tslot = shift;
    return (sort {$a<=>$b} keys %{$tslot->{-prop_types}});
}

sub get_id { my $tslot = shift; return $tslot->{-id}; }
sub get_room { my $tslot = shift; return $tslot->{-room}; }
sub get_day { my $tslot = shift; return $tslot->{-day}; }

sub get_start_hr {
    my $tslot = shift;
    return join(':',$tslot->{-start_hr}[0], $tslot->{-start_hr}[1]);
}

sub get_end_hr {
    my $tslot = shift;
    my %ret = ();
    for my $type (keys %{$tslot->{-prop_types}}) {
	$ret{$type} = defined $tslot->{-prop_types}{$type}[2] ?
	    join(':', 1, map {sprintf '%02d', $_}
		 @{$tslot->{-prop_types}{$type}}) : 
	    join(':', map {sprintf '%02d', $_}
		 @{$tslot->{-prop_types}{$type}});
    }

    return %ret;
}

sub get_max_hr {
    my ($tslot, %end_hr, $max_hr);
    $tslot = shift;
    $max_hr = 0;

    # If this timeslot has not been related to any prop_type, we will get an
    # empty hash - We return undef.
    return undef unless %end_hr = $tslot->get_end_hr;
    for my $type (keys %end_hr) {
	# get_end_hr usually gets a hh:mm format, but can sometimes give a
	# d:hh:mm - Make them uniform and easy to work with (hhmm).
	my @end_hr = split(/:/, $end_hr{$type});
	if (scalar @end_hr == 2) {
	    $end_hr{$type} = sprintf('%02d%02d', $end_hr[0], $end_hr[1]);
	} else {
	    $end_hr{$type} = sprintf('%02d%02d', $end_hr[0]*24 + $end_hr[1],
				     $end_hr[2]);
	}

	$max_hr = $end_hr{$type} if $end_hr{$type} > $max_hr;
    }

    if ($max_hr >= 2400) {
	my $hr = $max_hr % 2400;
	my $day = ($max_hr-$hr) / 2400;

	$hr = sprintf('%04d',$hr);
	$hr =~ s/^(\d\d)(\d\d)$/$1:$2/;

	return "$day:$hr";
    }
    $max_hr =~ s/^(\d\d)(\d\d)$/$1:$2/;
    return $max_hr;
}

sub get_proposal {
    my $tslot = shift;
    return undef if (!ref $tslot->{-proposal} or 
		     scalar @{$tslot->{-proposal}} == 0);

    return @{$tslot->{-proposal}};
}

sub is_free {
    my ($tslot);
    $tslot = shift;

    $tslot->refresh or
	carp "Unable to refresh timeslot's information" && return undef;

    # If this timeslot has a scheduled proposal, @{$tslot->{-proposal}} will
    # have two elements. If it is free, it will have zero elements. This should
    # not happen, but it is better to be prepared in case $tslot->{-proposal}
    # does not hold an array reference.
    if (!ref $tslot->{-proposal} or scalar(@{$tslot->{-proposal}}) == 0) {
	return 1;
    }
    return 0;
}

sub is_available {
    my ($tslot, @types, %end_hrs, $sth, $ok);
    $tslot = shift;
    @types = @_;
    %end_hrs = $tslot->get_end_hr;
    $ok = 1;

    $tslot->refresh or
	carp "Unable to refresh timeslot's information" && return undef;
    if (@types) {
	unless ($sth = $tslot->{-db}->prepare('SELECT timeslot_id FROM
        timeslots_available WHERE timeslot_id=? AND prop_type_id=?')) {
	    carp 'Could not verify if timeslot is available';
	    return undef;
	}

	for my $type (@types) {
	    $ok = 0 if ($sth->execute($tslot->{-id}, $type) eq '0E0');
	    # Once we found a prop_type for which the timeslot is not 
	    # available, we can exit the loop
	    last unless $ok;
	}
    } else {
	unless ($sth = $tslot->{-db}->prepare('SELECT timeslot_id FROM
                timeslots_available WHERE timeslot_id=?')) {
	    carp 'Could not verify if timeslot is available';
	    return undef;
	}
	$ok = 0 if ($sth->execute($tslot->{-id}) eq '0E0');
    }
    return $ok;
}

sub simultaneous_timeslots {
    my ($tslot, $sth, $day, $start_hr, $end_hr, @res);
    $tslot = shift;
    $day = $tslot->get_day;
    $start_hr = $tslot->get_start_hr;
    $end_hr = $tslot->get_max_hr;

    # If we did not get an end_hr, this means this timeslot has not been
    # related to any prop_type, and cannot be scheduled. Yes, it has a 
    # start_hr, but we cannot way it is simultaneous with any other timeslot.
    return undef unless $end_hr;

    # handle the timeslot spilling over to the next day. Fortunately spillovers
    # are limited to a single day - durations are limited to 24hr by the 
    # database
    if (scalar (my @end_hr = split(/:/, $end_hr)) == 2) {
	# Great, contained in a single day. What does this query say?
	# Easy: Give me the timeslot ID for every timeslot that is scheduled
	# on this same day, starts strictly before this one ends and finishes 
	# strictly after this one starts. Also, for every timeslot that is 
	# scheduled on the previous day, if it finishes strictly after this one
	# starts (remember that timeslots might last up to 24 hours). We cast
	# times to intervals whenever they take part of an operation in order
	# to ease handling simultaneous timeslots that spill over midnight.
	# Only once each ID, if you please.
	unless ($sth = $tslot->{-db}->prepare('SELECT t.id FROM timeslot t, 
                timeslot_prop_type tp, prop_type p WHERE t.id=tp.timeslot AND
                p.id=tp.type AND t.id != ? AND (t.day = ?  AND t.start_hr < ? 
                AND t.start_hr::interval+p.duration > ?) OR (t.day+1 = ? AND 
                t.start_hr::interval+p.duration > ?) GROUP BY t.id') and 
		$sth->execute($tslot->get_id, $day, $end_hr, $start_hr,
			      $day, $start_hr)) {
	    carp 'Unable to query for simultaneous free timeslots';
	    return undef;
	}
    } else {
 	# Yup, spilled over. What is this query about?
	# Give me the timeslot ID for every timeslot that is scheduled on this
	# same day and ends strictly after this one starts, or that is 
	# scheduled on the next day and starts strictly before this one 
	# finishes. We cast times to intervals whenever they take part of an 
	# operation in order to ease handling simultaneous timeslots that spill
	# over midnight.
	# Only once each ID, if you please.
	$end_hr = "$end_hr[0]:$end_hr[1]";
	unless ($sth = $tslot->{-db}->prepare('SELECT t.id FROM timeslot t, 
                timeslot_prop_type tp, prop_type p WHERE t.id=tp.timeslot AND
                p.id=tp.type AND t.id != ? AND (t.day = ? AND 
                t.start_hr::interval+duration > ?) OR (t.day-1 = ? AND 
                t.start_hr < ?) GROUP BY t.id') and
		$sth->execute($tslot->get_id, $day, $start_hr,$day,$end_hr)) {
	    carp 'Unable to query for simultaneous free timeslots';
	    return undef;
	}
    }
    while (my @row = $sth->fetchrow_array) {
	push(@res,@row)
    }

    return @res;
}

sub simultaneous_free_timeslots {
    my ($tslot, %res, $sth);
    $tslot = shift;
    %res = map {$_ => 1} $tslot->simultaneous_timeslots;

    unless ($sth=$tslot->{-db}->prepare('SELECT id FROM proposal WHERE 
            timeslot_id = ?')) {
	carp 'Unable to query whether timeslot is already used';
	return undef;
    }
    for my $ts (keys %res) {
	my $ok = $sth->execute($ts);
	delete $res{$ts} if $ok ne '0E0';
    }

    return sort {$a <=> $b} keys %res;
}

sub simultaneous_used_timeslots {
    my ($tslot, %res, $sth);
    $tslot = shift;
    %res = map {$_ => 1} $tslot->simultaneous_timeslots;

    unless ($sth=$tslot->{-db}->prepare('SELECT id FROM proposal WHERE 
            timeslot_id = ?')) {
	carp 'Unable to query whether timeslot is already used';
	return undef;
    }
    for my $ts (keys %res) {
	my $ok = $sth->execute($ts);
	delete $res{$ts} if $ok eq '0E0';
    }
    return sort {$a<=>$b} keys %res;
}

sub schedule {
    my ($tslot, $prop_id, $sth);
    $tslot = shift;
    $prop_id = shift;

    # First of all, refresh $tslot - we don't want to modify the DB based on
    # old cruft
    $tslot->refresh;

    $tslot->{-db}->begin_work;

    unless ($sth = $tslot->{-db}->prepare('UPDATE proposal SET timeslot_id = 
            NULL WHERE timeslot_id = ?') and $sth->execute($tslot->get_id)) {
	carp 'Could not clear specified timeslot';
	$tslot->{-db}->rollback;
	return undef;
    }

    # We do no have to jump through hoops to ensure that no other proposal is
    # scheduled on this same timeslot or that the proposal has the right
    # type - The triggers in the database will take care of that.
    unless ($sth = $tslot->{-db}->prepare('UPDATE proposal SET timeslot_id = ?
            WHERE id = ?') and $sth->execute($tslot->get_id, $prop_id)) {
	carp 'Could not set this timeslot for requested proposal';
	$tslot->{-db}->rollback;
	return undef;
    }

    $tslot->{-db}->commit;
    return 1;
}

sub unschedule {
    my ($tslot, $sth);
    $tslot = shift;
    $tslot->refresh;

    # We do not really care if there was something scheduled here or not - we
    # just unschedule whatever we might have had
    unless ($sth = $tslot->{-db}->prepare('UPDATE proposal SET timeslot_id =
            NULL WHERE timeslot_id = ?') and $sth->execute($tslot->get_id)) {
	carp 'Could not unschedule from this timeslot';
	return undef;
    }
    return 1;
}

################################################################################
# Private methods - Not for human consumption

sub _parse_hr {
    # The start_hr is more useful if instead of a string ('hh:mm') we have an
    # array reference ([hh, mm]) - We use Date::Parse::strptime to do so. It
    # hands us the time in the wrong order ([ss, mm, hh]), thus the reverse.
    # strptime returns us some additional values (the seconds, which are not
    # relevant for us, and the day/month/year/timezone, all of them undefined), 
    # so when reversing @tmp, we take only @tmp[1,2].
    my ($tslot, $hr, @tmp);
    $tslot = shift;
    $hr = shift;
    @tmp = strptime($hr);

    return [ reverse @tmp[1,2] ];
}

sub _add_duration {
    my ($tslot, $duration, @tmp);
    $tslot = shift;
    $duration = $tslot->_parse_hr(shift);

    # We do not need to parse the day here. However, Date::Calc needs a valid
    # date - We provide a stub date (01-01-1980). We add 0 days and $duration
    # {days, minutes} to $tslot->{-start_hr}. We return only the resulting
    # [hh,mm]. If adding the duration to the date crosses 23:59, we add a 1 as
    # the third element to the array. The database guarantees us  that duration
    # will be between 00:00 and 23:59 - We just need to check if $tmp[2] is 1
    # or 2.
    @tmp = Add_Delta_DHMS(1980,1,1, # dummy date
			  @{$tslot->{-start_hr}},0, #hours, minutes and seconds
			  0, @$duration,0 #days, hours, minutes and seconds
			  );
    return $tmp[2] == 1 ? [ @tmp[3,4] ] : [ @tmp[3,4], 1 ];
}

1;

# $Log: Timeslot.pm,v $
# Revision 1.11  2004/02/04 00:34:43  gwolf
# Permito especificar un día/hora para agendar.
# (¿Por qué no lo comiteé antes? Chale yo...)
#
# Revision 1.10  2003/12/20 04:14:51  mig
# - Agrego tags Id y Log que expanda el CVS
#
