# POD ==>
=pod

=head1 NAME

ConstraintChecker - Verification of scheduler constraints based on output dumped
from the scheduler. 

=head1 REQUIREMENTS

=over

=item - Perl v. 5.10 (or higher)

=item - An understanding of how data is dumped, as implemented and documented
TODO: here.

=back

=head1 SYNOPSIS

 use Test::More;
 use ConstraintChecker ("check");

 ok(check("./scheduleOutput"), "Constraint verification");

 done_testing();

=head1 DESCRIPTION

Provides an easy way to verify the constraints imposed on an arbitrary schedule
generated by the Scheduler Project. In particular, these are:

=over

=item - B<Double-Booking>    : Instructors and Locations cannot be double 
booked. The L<verifyGoodBookings> function handles this 
verification. 

=item - B<Preference respect>: Instructors cannot be given times/courses for
which they specified a preference of 0. The L<verifyPreferenceRespect> function 
handles this verification. 

=back

In order to verify the above constraints, a file must exist which contains
data that L<gatherData> can parse into legitimate data. In particular, this data
is represented by the L<SchedulerMimics::Instructor> and 
L<SchedulerMimics::ScheduleItem>.

B<NOTE>: The POD documentation provided here is to bring you up to speed on 
what functions you can easily call to get work done. However, not all the 
functions are documented: only the ones whose functionality is most important.
If you want to know more, there's plenty of in-line documentation for 
non-POD-documented functions.

=cut
#<==
package ConstraintChecker;
use strict;
use warnings;
use 5.010;
use base qw(Exporter);

#################################
# IMPORTS
#################################
use Data::Dumper;
use SchedulerMimics::Instructor;
use SchedulerMimics::ScheduleItem;
use TestUtils qw(:parsers);
use Test::More; # See 'perldoc Test::More'

#################################
# EXPORTS
#################################
# POD ==>
=pod

=head1 EXPORTS

Nothing, by default. "check" by request. 

=cut

#<==
our @EXPORT = ();
our @EXPORT_OK = (qw(check));

#################################
# CONSTANTS
#################################
# POD ==>
=pod

=head1 CONSTANTS (not exported)

The following hash is defined globally to represent the days of the work week:

 my %days = 
 (
    'Mon' => 1,
    'Tue' => 2,
    'Wed' => 3,
    'Thu' => 4,
    'Fri' => 5,
 );

=cut
#<==
my %days = 
(
   'Mon' => 1,
   'Tue' => 2,
   'Wed' => 3,
   'Thu' => 4,
   'Fri' => 5,
);

###################################################################
#                            CODE                                 #
###################################################################

# POD ==>
=pod

=head1 FUNCTIONS

=head2 check

 if (check("./scheduleOutput"))
 {
    # Celebrate...
 }
 else
 {
    # Back to the drawing board
 }

=head3 Takes

A filename to open for parsing, where it will find data it can parse to 
create L<SchedulerMimics::Instructor> & L<SchedulerMimics::ScheduleItem> 
objects. See L<gatherData> for details on what this data must look like. 

=head3 Description

Calls the following functions, &'ing their returns together for a final return
value of success or failure. 

=over

=item - L<verifyGoodBookings>

=item - L<verifyPreferenceRespect>

=back

=head3 Returns

True if all tests pass. False otherwise. Useful debugging messages will
be output during these tests. If you use this module within a testing harness
(some child of TAP::Harness), twidling the verbosity settings can curtail how
much output is produced. 

B<Note to future dev's>: You can easily add your own function calls to these, 
&'ing I<their> results to the final return. Or, you can simply call "check", 
and then call your own testing functions elsewhere. 

=cut
#<==
# check ==>
sub check
{
   my ($fn) = @_;
   my $r = 1;

   die "Need filename\n" unless $fn;
   my ($is, $s) = &gatherData($fn);

   $r &= &verifyGoodBookings($s);
   $r &= &verifyPreferenceRespect($s, $is);

   return $r;
}#<==

# POD ==>
=pod

=head2 verifyPreferenceRespect

 my $alright = verifyPreferenceRespect($scheduleItems, $instructors);

=head3 Takes

Two hashrefs: L<SchedulerMimics::ScheduleItem>'s, keyed by their ID's; 
L<SchedulerMimics::Instructor>'s, keyed by their ID's. 

=head3 Description

Verifies that every instructor isn't teaching during times which they
specified a preference of 0 for, nor teaching courses which they specified a
preference of 0 for. 

This will only consider instructors who are both in the generated schedule 
B<and> present in the IDB. Thus, the added-on-the-fly STAFF instructor will not 
be checked for preference respect, as STAFF is never present in the IDB. This is
how it should be, as the STAFF instructor can be abused to no end. 

=head3 Returns 

True if tests pass. False otherwise. 

=cut
#<==
# verifyPreferenceRespect ==>
sub verifyPreferenceRespect
{
   my ($s, $is) = @_;
   my $r = 1;

   # 
   # Consider every SI
   #
   for my $si (values %{$s})
   {
      #
      # Consider every Instructor's preferences
      #
      for my $i (values %{$is})
      {
         #
         # Of course, we should only check the preference if this instructor is 
         # the one actually teaching the SI
         #
         if ($si->getInstructor() eq $i->getId())
         {
            my ($c, $ds, $s, $e) = ($si->getCourse(), 
                                    $si->getDays(), 
                                    $si->getS(), 
                                    $si->getE());
            #
            # Take advantage of the generic "checkOverDays" function. It will 
            # pass this closure two arguments:
            #
            # $_[0] = Day (number)
            # $_[1] = Time (object)
            # 
            # The closure will use these two things to lookup the Instructors 
            # preference for teaching on that day/time. As long as that 
            # preference is not 0, truth is returned. 
            #
            my $tp_test = sub 
            {
               my ($d, $t) = @_;
               $i->getTPref($d, $t->getId()) > 0; 
            };

            #
            # "ok" cries foul if the value you provide isn't "true". It's a 
            # function exported from "Test::More", which is "use"'d at the top 
            # of this file.
            # 
            $r &= ok(&checkOverDays($tp_test, $ds, $s, $e), 
               "Acceptable preference for '".$i->getId()."' to teach on ".
               "@{$ds} from ".$s->getId()." to ".$e->getId());
            #
            # Cheking course prefs won't require a closure, as I can make a 
            # quick call to the Instructor to verify that his preference for a 
            # given course isn't 0.
            #
            $r &= isnt($i->getCPref($si->getCourse()), 0, "Acceptable ".
               "preference for '".$i->getId()."' to teach '".$c."'");
         }
      }
   }
   $r;
}#<==

# POD ==>
=pod

=head2 verifyGoodBookings

 my $alright = verifyGoodBookings($scheduleItems);

=head3 Takes

A hashref of L<SchedulerMimics::ScheduleItem> objects, keyed by their ID's.

=head3 Description

Makes sure that no locations/instructors have been double-booked. Hashes are 
used to keep track of times booked: if a given slot's usage counter ever 
exceeds 1, you know it's double booked. 

Read the in-line comments for details on exactly how this is achieved. 

=head3 Returns

True if no ScheduleItem double-booked an instructor/location.

=cut
#<==
# verifyGoodBookings ==>
sub verifyGoodBookings
{
   my ($s) = @_;
   my $r = 1;

   #
   # Will keep track of when locations/instructors are booked. Each time "slot"
   # will be incremented each time it is checked. If any slot ever gets a count
   # greater than 1, we'll know more than one thing is trying to get at that 
   # time slot and can cry foul.
   #
   my %iBookings;
   my %lBookings;

   #
   # "If you're reading this, you have no idea what's going on."
   #
   #                                -Bruce Harvey
   #
   # A code ref which returns a code ref. Since checking instructor and 
   # location bookings involves similar lookups in a hash, it seemed
   # appropriate to let them use the same mechanism. 
   #
   # $_[0] = Hash ref to the bookings you'll be using/remembering
   # $_[1] = Key to lookup the bookings for a particular thing
   #
   # Returns a function which will expect two parameters: a day (number), and
   # a Time (object). Read further for what this'll do.
   #
   my $commonTest = sub 
   {
      my ($hRef, $key) = @_;
      #
      # If you don't love code refs now, I'm sorry.
      #
      # $_[0] = Day (a number)
      # $_[1] = Time (object)
      #
      # Will use these two parameters to access keys within the hash keyed
      # by the "key" in the "hRef". The time represented by these keys will be
      # incremented to show it as "in use". If a time's "in use" count exceeds
      # 1, we've reached a physical impossibility, and the function will return
      # false.
      #
      return sub
      {
         my ($d, $t) = @_;
         $hRef->{$key}{$d}{$t->getId()} ++;
         $hRef->{$key}{$d}{$t->getId()} == 1;
      }
   };

   #
   # Consider every SI for possible double-bookings
   #
   for my $si (values %{$s})
   {
      my ($i, $l, $ds, $s, $e) = ($si->getInstructor(),
                                  $si->getLocation(), 
                                  $si->getDays(), 
                                  $si->getS(), 
                                  $si->getE());

      #
      # Create custom test-closures by providing a specific hash and specific
      # key to use on them. For the locations, I'll use "%lBookings", and use
      # "l" as the key. We'll get back a function which will lookup the day(s)
      # time(s) for that particular location. For the instructors, I'll use 
      # "%iBookings", and use "i" as the key, achieving effects similar to those
      # of the location lookup. 
      #
      my $l_test = &{$commonTest}(\%lBookings, $l);
      my $i_test = &{$commonTest}(\%iBookings, $i);

      #
      # "ok" cries foul if the value you provide isn't "true". It's a function
      # exported from "Test::More", which is "use"'d at the top of this file.
      # 
      $r &= ok(&checkOverDays($l_test, $ds, $s, $e),
         "Booking '$l' on '@{$ds}' from ".$s->getId()." to ".$e->getId());
      $r &= ok(&checkOverDays($i_test, $ds, $s, $e),
         "Booking '$i' on '@{$ds}' from ".$s->getId()." to ".$e->getId());
   }
   $r;
}#<==

#
# Administers a given test over a given list of days over a given time 
# range. Of course, that sounds pretty generic: that's exactly what this 
# function is. 
#
# The parameter details may shed some light on the purpose of this function
#
# $_[0] = Code ref! This is the "test" you wish to apply across the given days
#         and times you supply. Eventually, this code ref will be called with 
#         two arguments: the day being tested (a number), and the time of that
#         day to test. Your provided closure can do whatever it likes with these
#         provides arguments, but it must return a truth value of "0" or "1",
#         as the return will be AND'ed with other truth values to see if the 
#         test worked across all days/times
#
# $_[1] = Array ref of days (strings) to check. Valid days are:
#
#           - "Mon", "Tue", "Wed", "Thu", "Fri"
#
#         If you're interested in what these mean, take a look at the global
#         "%days" hash. (Note that they're case sensitive).
#
# $_[2] = Range's start Time object
#
# $_[3] = Range's end Time object
#
# Returns true if your provided closure returns true for all time slots in the
# supplied range on all days in the supplied list of days. Of course, your 
# closure could utterly ignore these and return true based on some god-awful
# condition. But, if you're doing that, why even call this function at all?
#
# checkOverDays ==>
sub checkOverDays
{
   my ($test, $days, $s, $e) = @_;
   my $r = 1;
   
   #
   # Each day (string) is aliased to "$_"
   #
   for (@{$days})
   {
      when (/Mon|Tue|Wed|Thu|Fri/) 
      {
         $r &= &checkOverTimeRange($test, $days{$_}, $s, $e);
      }
      default
      {
         die "Invalid day '$_'";
      }
   }

   $r;
}#<==

#
# Generic function to allow callers to administer a given test on a given day 
# over a given range of time. 
#
# Returns true if the supplied test returns true across the given time range
# on the given day. Note that times are in half-hour chunks. (So, if you were
# to check the range 9a-10a, it would check two slots: 9a-9:30a, and 
# 9:30a-10a).
#
# $_[0] = Code ref! All you need to know here is that it will be passed the 
#         day (a number), and the time to check (a Time object). You can do 
#         whatever you like with those in the closure you provide here.
# $_[1] = Day to check (a number). (See the global "%days" hash).
# $_[2] = Range start time
# $_[3] = Range end time
#
# checkOverTimeRange ==>
sub checkOverTimeRange
{
   my ($test, $d, $s, $e) = @_;
   my $r = 1;

   #
   # I alter the original start time as we go through the time range. So, before
   # tainting it, I save the original values to restore once testing is
   # complete
   #
   my ($oldH, $oldM) = ($s->getH(), $s->getM());

   until ($s->equals($e))
   {
      $r &= &{$test}($d, $s);
      $s->addHalf();
   }

   $s->setH($oldH);
   $s->setM($oldM);

   $r;
}#<==

# POD ==>
=pod

=head2 gatherData

 my ($instructors, $schedule) = gatherData("./scheduleOutput");

=head3 Takes

Name of a file to open for parsing.

=head3 Description

Parses data into a given file, using it to instantiate objects for Instructor
and ScheduleItem data. The formatting of this file is very important: it must be
parsable by Perl, in order to easily create objects.

Take a look at TODO: LINK for details on how this data ends up in the file in
the first place.

Take a look at TODO: LINK for details on the syntax the data in the file must
abide by.

=head3 Returns

A list containing:

=over

=item - Hashref of instructors, keyed by their ID's

=item - Hashref of ScheduleItems, keyed by their ID's

=back

=cut
#<==
# gatherData ==>
sub gatherData
{
   my ($fn) = @_;
   open (my $fh, $fn) or die "$!: '$fn'";
   my $data = join("", <$fh>);

   my $is = &createInstructors(($data =~ /--LOCAL\ IDB\ BEGIN--
                                         (.*)
                                         --LOCAL\ IDB\ END/sx));
   my $s = &createScheduleItems(($data =~ /--SCHEDULE\ BEGIN--
                                           (.*)
                                           --SCHEDULE\ END/sx));
   ($is, $s);
}#<==

1;