root/trunk/antimatter/tim/Modules/SFLC/TimeTracker/Question.pm

# Copyright (C) 2005   Software Freedom Law Center, Inc.
#  Author: Bradley M. Kuhn <bkuhn@softwarefreedom.org>
#
#  This software gives you freedom; it is licensed to you under version
#  3 of the GNU Affero General Public License.
#
#  This software is distributed WITHOUT ANY WARRANTY, without even the
#  implied warranties of MERCHANTABILITY and FITNESS FOR A PARTICULAR
#  PURPOSE.  See the GNU Affero General Public License for further
#  details.
#
# You should have received a copy of the GNU Affero General Public
# License, version 3 along with this software.  If not, see
# <http://www.gnu.org/licenses/>.
package SFLC::TimeTracker::Question;

use strict;
use warnings;


require Exporter;
#use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

our @EXPORT_OK = ();

our @EXPORT = qw( );

our $VERSION = '0.01';

our $FREE_FORM_STRING = "__FREEFORM__";
our $REJECT_STRING = "__REJECT__";
our $EXISTING_STRING = "__EXISTING__";

my %CHARS = ($FREE_FORM_STRING => 'i', 
             $EXISTING_STRING => 'f', 
             $REJECT_STRING => 'x');

our $DATABASE;

use Date::Manip;

use Carp;

###############################################################################
sub Initialize ($) {
  $DATABASE = shift;
}
sub new {
  my($class, %args) = @_;

  my $self = {};  bless $self, $class;

  if (defined $args{entryList} and ref $args{entryList} eq "ARRAY") {
    $self->{entryList} = $args{entryList};
  } else {
    $self->{entryList} = [];
  }
  croak "answers must be an array reference"
    unless defined $args{answers} and ref $args{answers} eq "ARRAY";
  my $ii = 0;
  $self->{numberRegex} = '[\d';
  foreach my $ans (@{$args{answers}}) {
    my $special =0;
    foreach my $k (keys %CHARS) {
      if ($ans eq $k) {
        $self->{answers}{$CHARS{$k}} = $ans;
        $special = 1;
        $self->{numberRegex} .= $CHARS{$k};
        last;
      }
    }
    $self->{answers}{$ii++} = $ans unless $special;
  }
  $self->{numberRegex} .= ']';

  foreach my $arg (qw/question userHandle/) {
    croak "cannot instantiate without $arg" unless defined $args{$arg};
    $self->{$arg} = $args{$arg};
  }
  # optional fields
  foreach my $arg (qw/inputString timeStamp/) {
    $self->{$arg} = $args{$arg};
  }
  $self->{lastAsked} = undef;
  return $self;
}
###############################################################################
sub validateAnswer ($$) {
  my($self, $answer) = @_;

  my $n = $self->{numberRegex};
  return undef if not defined $self->{answers};
  if ($answer =~ /^\s*($n+)\s*$/ and (defined $self->{answers}{$1})) {
    return $answer;
  } elsif  ( ($answer =~ /^\s*($n+)\s+.+\s*$/)  and
             (defined $self->{answers}{$1}
              and ($self->{answers}{$1} eq  $FREE_FORM_STRING or
                   $self->{answers}{$1} eq  $EXISTING_STRING))) {
    print "$1 validated\n";
    return $1;
  } elsif (defined $self->{answers}{$answer}) {
    return $answer;
  } else {
    $answer =~ s/^\s+//; $answer =~ s/\s+$//;

    foreach my $ans (keys %{$self->{answers}}) {
      return $ans if ($self->{answers}{$ans} eq $answer);
    }
    return undef;
  }
}
###############################################################################
sub _formatTime ($) {
  my($self) = @_;

  my $string = "";

  # Only give the time if we have a timestamp and it's been more than five
  #  minutes since the first time we asked.

  if (defined $self->{timeStamp} and
      Delta_Format(DateCalc($self->{timeStamp}, 'now'), 1, '%mt') > 5) {
    my $today = UnixDate("now", '%b %E');
    my $time = UnixDate($self->{timeStamp}, '%i:%M%p');   $time =~ s/^\s+//;
    my $day = UnixDate($self->{timeStamp}, '%b %E');
    $time = "$time (on $day)" if ($day ne $today);
    $string .= "At $time, ";
  }
  return $string;
}
###############################################################################
sub formatQuestion ($) {
  my($self) = @_;

  my $string = $self->_formatTime();

  my $isQues = $self->{question} =~ /\?\s*$/;
  if (defined $self->{inputString}) {
    $string .= (($string eq "") ? "Y" : "y" ) .
      "ou said, \"$self->{inputString}\"";
  } else {
    $string .= "you attempted to make a time entry";

  }
  $string .= $isQues ? ", which led me to ask: " : ".  However, ";

  $string .= "$self->{question}  " .
    "Choose an option:  ";
  foreach my $ans (sort { return ($a cmp $b) if $a =~ /^[a-z]+$/ and $b =~ /^[a-z]+$/;
                          return ($a <=> $b)if $a =~ /^\d+$/ and $b =~ /^\d+$/;
                          return 1 if $a =~ /^[a-z]+$/ and $b =~ /^\d+$/;
                          return -1 if $b =~ /^[a-z]+$/ and $a =~ /^\d+$/;
                          return 0 } keys %{$self->{answers}}) {
    if ($self->{answers}{$ans} eq $FREE_FORM_STRING) {
      $string .= "(${ans}) " . $self->freeFormReplacement($ans) . ", ";
    } elsif ($self->{answers}{$ans} eq $REJECT_STRING) {
      $string .= "(${ans}) " . $self->rejectReplacement($ans) . ", ";
    } elsif ($self->{answers}{$ans} eq $EXISTING_STRING) {
      $string .= "(${ans}) " . $self->existingReplacement($ans) . ", ";
    } else {
      $string .= "(${ans}) $self->{answers}{$ans}, ";
    }
  }
  $string =~ s/,\s*$//;

  return $string;
}
###############################################################################
sub freeFormReplacement {
  my($self, $ans) = @_;

  return "Enter your own freeform text by typing \"$ans <STRING>\"";
}
###############################################################################
sub resolve ($$) {
  my($self, $answer) = @_;

  $self->validateAnswer($answer);
  croak "INVALID CALL OF BASCLASS METHOD";

}
###############################################################################
sub formatResolveString ($$) {
  my($self, $answer) = @_;

  if (not defined $answer) {
    $answer = $self->{lastAnswer};
  }
  if (not defined $answer) {
    $answer = "";
    carp "Got an undefined answer for question $self->{id}";
  }
  return "I am sorry, but I am totally confused." if not defined $answer;
  return "Your response was invalid." if $answer =~ /^INVALID/;
  return "Thank you." if $answer eq "RESOLVED";
  return undef;
}


sub getDatabase {
  return $DATABASE;
}
1;
__END__

#
# Local variables:
# compile-command: "perl -I ../../../Modules -c Question.pm"
# End: