#! /usr/bin/perl -w
# File: surveyor.pl
# Version: 0.6
# Description: a script that enables people to complete surveys and view the results
# Last Modified: 2001-07-03
# Author: Peter Saint-Andre (stpeter@jabber.org)
# Copyright: this program is free software; you can redistribute it and/or modify it under the same terms as Perl itself

#use strict;
use Net::Jabber;
use XML::Parser;
use XML::Simple;
use XML::Writer;
use IO;
use File::Copy;
use Data::Dumper;

# declare constants
#
use constant SERVER    => 'localhost';  # Jabber server to connect to
#use constant SERVER    => 'jabber.org';  # Jabber server to connect to
#use constant SERVER    => 'jabber.to';  # Jabber server to connect to
use constant PORT      => '5222';       # Port to connect to
use constant USER      => 'surveyor';   # user this script connects as
use constant PASSWORD  => 'master';   # password associated with USER
#use constant PASSWORD  => 'surveyor';   # password associated with USER
use constant RESOURCE  => 'surveyor';

# declare global variables
# 
my $me = USER . "@" . SERVER;
my %action;
my %question;
my %tocomplete;
my %chosensurvey;

# set up an array for the answers
my %answers = ( [], [], [], [], [], [], [], [], [], [] );

log3("Creating Jabber client");
my $connection = Net::Jabber::Client->new();

log3("Making connection to Jabber server");
$connection->Connect( "hostname" => SERVER,
                      "port"     => PORT )
   or die "Cannot connect ($!)\n";

log3("Authenticating with the server");
my @result = $connection->AuthSend( "username" => USER,
                                    "password" => PASSWORD,
                                    "resource" => RESOURCE );
if ($result[0] ne "ok") {
  die "Ident/Auth with server failed: $result[0] - $result[1]\n";
}

log3("Setting presence handler");
$connection->SetCallBacks( "presence" => \&handle_presence );

log3("Setting message handler");
$connection->SetCallBacks( "message" => \&handle_message );

log3("Requesting roster");
$connection->RosterGet();

log3("Sending presence");
$connection->PresenceSend();

log3("Entering main loop");
while(defined($connection->Process())) { }

### DEFINE SUBROUTINES ###

sub handle_presence 
{
  my $presence = new Net::Jabber::Presence(@_);
  my $jid  = $presence->GetFrom();
  my $show = $presence->GetShow();
  my $type = $presence->GetType();

  $jid =~ s!\/.*$!!; # remove any resource suffix from JID

  log3("Presence from $jid:\n".$presence->GetXML());
 
  # Subscription request:
  # Accept, and request subscription to them.
  if ($type eq "subscribe") {
    log3("$jid requests subscription");
    $connection->Send($presence->Reply(type => 'subscribed'));
    $connection->Send($presence->Reply(type => 'subscribe'));
  }

  # Request to unsubscribe:
  # Acknowledge, and request unsubscription from them.
  # Don't forget to remove them from the present list, too.
  if ($type eq "unsubscribe") {
    log3("$jid requests unsubscription");
    $connection->Send($presence->Reply(type => 'unsubscribed'));
    $connection->Send($presence->Reply(type => 'unsubscribe'));
    delete $present{$jid};
    delete $action{$jid};
  }

  # User has disconnected
  if ($type eq "unavailable") {
    log3("$jid unavailable");
    delete $present{$jid};
    delete $action{$jid};
  }

  # Default presence information (type is blank)
  if ($type eq "") 
  {
    # We'll count normal, chat and away as valid 
    # present stati for sending headlines to
    if ($show =~ /^(chat|away|xa|dnd|)$/i) {
      log3("$jid available (".($show || "online").")");
      $present{$jid} = 1;
      $action{$jid} = "subscribed";
      log3("action is now $action{$jid}");
    }
    else {
      log3("$jid not available");
      delete $present{$jid};
      delete $action{$jid};
    }
  }
}

# the handle_message sub is huge
# needs to be split up into several smaller subs?
# at the least, we need a separate sub for survey completion
#
sub handle_message
{
  my $message = Net::Jabber::Message->new(@_);
  my $from = $message->GetFrom();
  my $jid = $from;
  $jid =~ s!\/.*$!!; # remove any resource suffix from JID
  my $resource = $message->GetResource();
  my $subject = $message->GetSubject();
  my $body = $message->GetBody();
  my $type = $message->GetType();
  log3("Message: $type");
  log3("From: $from");
  log3("JID: $jid");
  log3("Subject: $subject");
  log3("Body: $body");
  log3("Type: $type");
  log3($message->GetXML(),"\n");
  my $sendbody = ""; # our reply, to be built as we go along

  # create a reply unless message is from us for some reason
  if ($jid ne $me)
  {
   # check for a few global messages we can receive from the user
   if ($body =~ /Reset\b/i) # user requests that session be reset
   {
     log3("user asks to reset session");
     $action{$jid} = "subscribed";
     $sendbody = "Your session has been reset, please proceed.";
   }
   elsif ($body =~ /Help\b/i) # user asks for help
   {
     log3("user asks for help");
     $sendbody = "Sorry, the help feature has not been implemented yet. To begin completing a survey, or to get survey results, type the word 'hello'. To clear your session and restart, type 'reset'.";
   }
   else # non-global messages, we need to process these
   {
    #
    # now we make use of the action hash...
    # the following conditions match the major
    # action types for a user:
    #   1. subscribed -- the base state
    #   2. hello -- the user has asked to begin a session
    #
    if ($action{$jid} eq "subscribed")
    {
      if ($body =~ /Hello\b/i) # user initiates a conversation
      {
        log3("user says hello");
        $sendbody = "To begin any of the following tasks, please type the appropriate number:\n1. Choose a survey to complete.\n2. View survey results.\n3. Create a survey.";
        $action{$jid} = "hello";
        log3("action is now $action{$jid}");
      }
      else # user says something unintelligible, prompt for correct messages
      {
        log3("user says something unintelligible");
        $sendbody = "To begin, type the word 'hello'. For help, type the word 'help'.";
      }
    }
    #
    # begin handling of "hello" state
    #
    elsif ($action{$jid} eq "hello")
    {
      log3("action is hello");
      if ($body eq "1") # user chooses to complete a survey
      {
        log3("user chooses to complete a survey");
        ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
        $year += 1900;
        $mon += 1;
        if ($mon < 10) { $mon = "0" . $mon;}
        $mday += 1;
        if ($mday < 10) { $mday = "0" . $mday;}
        my $currdate = "" . $year . $mon . $mday;
        log3("current date is $currdate");

        # look on the filesystem and see what survey.xml files exist
        @surveys_in = glob("surveys/*.xml");

        # parse through the existing files and create a list of the surveys 
        # also pull some data out of the survey files
        my $avail_survey_counter = 0;
        foreach $surveyfile (@surveys_in)
        {
          log3("$surveyfile is a survey");
          my $xs = XML::Simple->new();
          my $survey = $xs->XMLin($surveyfile,forcearray => 1);
          print Dumper($survey); # for debugging
          my $startdate = $survey->{meta_info}->[0]->{start_date}->[0];
          log3("start date is $startdate");
          my @start = split(/-/,$startdate);
          $startdate = "" . $start[0] . $start[1] . $start[2];
          my $enddate = $survey->{meta_info}->[0]->{end_date}->[0];
          my @end = split(/-/,$enddate);
          $enddate = "" . $end[0] . $end[1] . $end[2];
          log3("start date is $startdate");
          log3("end date is $enddate");
          # figure out which surveys are currently available (i.e., 
          # today's date is between start date and end date of survey)
          # date format: yyyymmdd
          # if current, add to the hash
          if (($startdate <= $currdate) && ($currdate <= $enddate))
          {
            $tocomplete{$avail_survey_counter} = $surveyfile;
          }
          $avail_survey_counter += 1;
        }
        # our hash of available surveys is built
        # now present these surveys to the user
        my $avail_survey_counter_two = 0;
        if (keys (%tocomplete))
        {
          log3("we do have available surveys");
          # ask the user which survey they would like to complete
          $sendbody = "The following surveys are currently available. Type in the appropriate number to complete the survey of your choice.";
          while (($avail_survey_counter_two,$surveyfile) = each(%tocomplete))
          {
            log3("getting data from $surveyfile");
            my $xs = XML::Simple->new();
            my $survey = $xs->XMLin($surveyfile,forcearray => 1);
            log3("avail survey counter is $avail_survey_counter_two");
            log3("file is $surveyfile");
            my $title = $survey->{meta_info}->[0]->{title}->[0];
            log3("title is $title");
            my $description = $survey->{meta_info}->[0]->{description}->[0];
            log3("description is $description");
            my $author = $survey->{meta_info}->[0]->{author}->[0];
            log3("author is $author");
            #
            # we also want to include the number of questions
            #
            my $question_counter = 0;
            log3("start counting the number of questions");
            # surveys are limited to 20 questions each
            QUESTION: for (my $i = 0; $i < 20; $i++)
            {
              last QUESTION if (($survey->{questions}->[0]->{question}->{$i}->{text}->[0]) eq '');
              log3("got another question");
              $question_counter += 1;
              log3("question counter is now $question_counter");
            }
            my $shownumquestions = $avail_survey_counter_two + 1;
            my $addtext = "\n" . $shownumquestions . ". " . $title . " -- " . $description . " (" . $question_counter . " questions, published by " . $author . ")";
            $sendbody = $sendbody . $addtext;
            # increment the counter and get the next file
            $avail_survey_counter_two += 1;
          }
          # change action type to "complete"
          $action{$jid} = "complete";
          log3("action is now $action{$jid}");
        }
        else 
        {
        # there are no surveys currently available, so inform the user of that fact and send back to "hello" state 
          $sendbody = "Sorry, there are no surveys to complete at this time. To begin a different task, type the appropriate number:\n2. View survey results.";
          $action{$jid} = "hello";
          log3("action is now $action{$jid}");
        }
      }
      elsif ($body eq "2") # user chooses to view survey results
      {
        log3("user chooses to view survey results");
###
#
# not implemented yet...
#
### NEXT STEPS ###
#
# 1. look on the filesystem and see what survey.xml files exist containing more than one respondent
# 2. parse through the existing files and create a list of the survey results that are currently available (curr date is less than 2 weeks after end date of survey)
# 3. query the user as to which survey results they would like to view or, if no survey results currently available, inform the user of that fact (NOTE: also provide cancel option)
# 4. change action type to "view"
#
###
        $sendbody = "Sorry, there are no survey results yet.";
      }
      else
      {
        log3("user says something unintelligible");
        $sendbody = "Please type 1 or 2.";
      }
    }
    #
    # end handling of "hello" state
    #
    #
    # begin handling of request to complete a survey
    #
    elsif ($action{$jid} eq "complete")
    {
      log3("action is complete");
      $body = $body - 1;
      $chosensurvey{$jid} = $body;
      log3("choice is $body");
      if (defined $tocomplete{$body})
      {
        my $surveyfile = $tocomplete{$body};
        log3("this survey file is $surveyfile");
        my $xs = XML::Simple->new();
        my $survey = $xs->XMLin($surveyfile,forcearray => 1);
        #my $survey = $xs->XMLin($surveyfile);
        #print Dumper($survey); # for debugging
        my $title = $survey->{meta_info}->[0]->{title}->[0];
        $sendbody = "You have selected the " . $title . " survey.";
        # check the results to determine if this user has already completed this survey!
        my %respondentlist;
        my $respondent_counter = 0;
        my $already_responded = 0;
        # we don't know how many respondents we might have
        # but we'll test for the first 200
        RESPONDENT: for (my $i = 0; $i < 200; $i++)
        {
          last RESPONDENT if (($survey->{respondents}->[0]->{respondent}->{$i}->{jid}->[0]) eq '');
          $respondentlist{$respondent_counter} = $survey->{respondents}->[0]->{respondent}->{$respondent_counter}->{jid}->[0];
          log3("jid is $jid");
          log3("respondent number $respondent_counter is $respondentlist{$respondent_counter}");
          log3("respondent counter is $respondent_counter");
          if ($jid eq $respondentlist{$respondent_counter})
          {
           log3("$jid already responded");
           $already_responded = 1;
           log3("already responded is now $already_responded");
          }
          $respondent_counter += 1;
        }
        if ($already_responded == 1)
        {
        $sendbody = $sendbody . " You have already completed this survey, please select another.";
        }
        else
        {
          # set action to "completing" and question to "0"
          $action{$jid} = "completing";
          log3("action is now $action{$jid}");
          $question{$jid} = 0;
          my $questionkey = $question{$jid} . "";
          log3("question number is $questionkey");
          my $questiontext = $survey->{questions}->[0]->{question}->{$questionkey}->{text}->[0];
          log3("question is $questiontext");
          $sendbody = $sendbody . " The first question is: \"" . $questiontext . "\" ";
          my $questiontype = $survey->{questions}->[0]->{question}->{$questionkey}->{type}->[0];
          log3("question type is $questiontype");
          if ($questiontype eq "yesno")
          {
            $sendbody = $sendbody . "Type 1 for yes or 2 for no.";
          }
        }
      }
      else
      {
        $sendbody = "Sorry, there is no survey corresponding to your input value, please try again.";
      }
    }
    #
    # end handling of "complete" state
    #
    elsif ($action{$jid} eq "completing")
    {
      log3("action is completing");
      my $surveyfile = $tocomplete{$chosensurvey{$jid}};
      log3("this survey file is $surveyfile");
      my $xs = XML::Simple->new();
      my $survey = $xs->XMLin($surveyfile,forcearray => 1);
      # count number of questions so we can tell if this is an answers to the last question
      my $question_counter = 0;
      log3("start counting the number of questions");
      # surveys are limited to 20 questions each
      QUESTION: for (my $i = 0; $i < 20; $i++)
      {
        last QUESTION if (($survey->{questions}->[0]->{question}->{$i}->{text}->[0]) eq '');
        log3("got another question");
        $question_counter += 1;
        log3("question counter is now $question_counter");
      }
      # ok, we've finished counting the questions
      my $questionkey = $question{$jid};
      log3("question number is $questionkey");
      log3("question counter is $question_counter");
      #
      # we need to handle things differently if this is the last question
      #
      if ($questionkey == ($question_counter - 1))
      {
        # first log the answer
        $thisanswer = $body;
        # add the answer to the answer hash
        $answers{$jid}->[$questionkey] = $thisanswer;
        log3("this answer is $answers{$jid}->[$questionkey]");
#
# 1. open the survey file and get the complete contents
#
        my $surveyfile = $tocomplete{$chosensurvey{$jid}};
        log3("surveyfile is $surveyfile");
        my $xs = XML::Simple->new();
        my $survey = $xs->XMLin($surveyfile,forcearray => 1);
        my $title = $survey->{meta_info}->[0]->{title}->[0];
        log3("title is $title");
        my $description = $survey->{meta_info}->[0]->{description}->[0];
        log3("description is $description");
        my $author = $survey->{meta_info}->[0]->{author}->[0];
        log3("author is $author");
        my $start_date = $survey->{meta_info}->[0]->{start_date}->[0];
        log3("start_date is $start_date");
        my $end_date = $survey->{meta_info}->[0]->{end_date}->[0];
        log3("end_date is $end_date");
        my %questionhash = ( [], [], [], [], [] );
        for (my $i = 0; $i < $question_counter; $i++)
        {
          $questionhash{$i}->[0] = $i;
          $questionhash{$i}->[1] = $survey->{questions}->[0]->{question}->{$i}->{type}->[0];
          $questionhash{$i}->[2] = $survey->{questions}->[0]->{question}->{$i}->{text}->[0];
          $questionhash{$i}->[3] = $survey->{questions}->[0]->{question}->{$i}->{answers}->[0]->{yes}->[0];
          $questionhash{$i}->[4] = $survey->{questions}->[0]->{question}->{$i}->{answers}->[0]->{no}->[0];
          log3("id for $i is $questionhash{$i}->[0]");
          log3("type for $i is $questionhash{$i}->[1]");
          log3("text for $i is $questionhash{$i}->[2]");
          log3("yes for $i is $questionhash{$i}->[3]");
          log3("no for $i is $questionhash{$i}->[4]");
        }
        my %respondents;
        my $respondent_counter2 = 0;
        # we don't know how many respondents we might have
        # but we'll test for the first 200
        RESPONDENT: for (my $j = 0; $j < 200; $j++)
        {
          last RESPONDENT if (($survey->{respondents}->[0]->{respondent}->{$respondent_counter2}->{jid}->[0]) eq '');
          $respondents{$respondent_counter2} = $survey->{respondents}->[0]->{respondent}->{$respondent_counter2}->{jid}->[0];
          log3("respondent number $respondent_counter2 is $respondents{$respondent_counter2}");
          $respondent_counter2 += 1;
          log3("respondent counter is now $respondent_counter2");
        }
#
# 2. add this respondent to list of respondents
#
        $respondents{$respondent_counter2} = $jid; 
        log3("new respondent! respondent number $respondent_counter2 is $respondents{$respondent_counter2}");
# 
# 3. add new answers to existing results
#
        for (my $k = 0; $k < $question_counter; $k++)
        {
          if ($answers{$jid}->[$k] == 1)
          {
            log3("adding yes to results for question $k");
            $questionhash{$k}->[3] += 1;
            log3("yes for question $k is now is $questionhash{$k}->[3]");
          }
          elsif ($answers{$jid}->[$k] == 2)
          {
            log3("adding no to results for question $k");
            $questionhash{$k}->[4] += 1;
            log3("no for question $k is now $questionhash{$k}->[4]");
          }
        }
#
# 4. overwrite the existing survey file
#
        # copy the survey file then delete it
        my $surveybak = $surveyfile . ".bak";
        log3("surveybak is $surveybak");
        copy($surveyfile,$surveybak);
        # create a new filehandler for writing
        my $surveynew = $surveyfile . ".new";
        log3("surveynew is $surveynew");
        my $completehandler = new IO::File(">$surveynew");
        log3("completehandler is $completehandler");
        my $completewriter = new XML::Writer(OUTPUT => $completehandler, NEWLINES => 1);
        log3("completewriter is $completewriter");
        # write out the file including the updated results
        $completewriter->xmlDecl();
        $completewriter->startTag("survey"); 
        # first we write out the meta data
        $completewriter->startTag("meta_info"); 
          $completewriter->startTag("title"); 
            $completewriter->characters($title);
          $completewriter->endTag("title"); 
          $completewriter->startTag("description"); 
            $completewriter->characters($description);
          $completewriter->endTag("description"); 
          $completewriter->startTag("author"); 
            $completewriter->characters($author);
          $completewriter->endTag("author"); 
          $completewriter->startTag("start_date"); 
            $completewriter->characters($start_date);
          $completewriter->endTag("start_date"); 
          $completewriter->startTag("end_date"); 
            $completewriter->characters($end_date);
          $completewriter->endTag("end_date"); 
        $completewriter->endTag("meta_info"); 
        $completewriter->startTag("questions"); 
        # write out the questions and the updated responses
        for (my $x = 0; $x < $question_counter; $x++)
        {
          $completewriter->startTag("question", "id" => $x); 
            $completewriter->startTag("type"); 
              $completewriter->characters($questionhash{$x}->[1]);
            $completewriter->endTag("type"); 
            $completewriter->startTag("text"); 
              $completewriter->characters($questionhash{$x}->[2]);
            $completewriter->endTag("text"); 
            $completewriter->startTag("answers"); 
              $completewriter->startTag("yes"); 
                $completewriter->characters($questionhash{$x}->[3]);
              $completewriter->endTag("yes"); 
              $completewriter->startTag("no"); 
                $completewriter->characters($questionhash{$x}->[4]);
              $completewriter->endTag("no"); 
            $completewriter->endTag("answers"); 
          $completewriter->endTag("question"); 
        }
        $completewriter->endTag("questions");
        # write out the respondents
        $completewriter->startTag("respondents");
        for (my $y = 0; $y < ($respondent_counter2 + 1); $y++)
        {
          $completewriter->startTag("respondent", "id" => $y);
            $completewriter->startTag("jid");
              $completewriter->characters($respondents{$y});
            $completewriter->endTag("jid");
          $completewriter->endTag("respondent");
        }
        $completewriter->endTag("respondents");
        $completewriter->endTag("survey");
        $completewriter->end();
        $completehandler->close();
        #
        # destroy the original survey file
        unlink $surveyfile;
        # copy the new file so it replaces the original
        copy($surveynew,$surveyfile);
        #
#
# 5. reset the user's session
#
        $action{$jid} = "subscribed";
#
# 6. send the user a thank-you message
#
        $sendbody = "Thanks for completing this survey! To complete another survey or request results, type 'hello'.";
      }
#
# end of handling the last question
#
      else
      {
      #
      # now we'll capture the answers using the %answers hash
      #
      #
      # now we need to handle answers for various question types
      #
      my $questiontype = $survey->{questions}->[0]->{question}->{$questionkey}->{type}->[0];
      log3("question type is $questiontype");
      if ($questiontype eq "yesno")
      {
        if (($body == 1) || ($body == 2)) # user answers appropriately
        {
          $thisanswer = $body;
          # add the answer to the answer hash
          $answers{$jid}->[$questionkey] = $thisanswer;
          log3("this answer is is $answers{$jid}->[$questionkey]");
          # get next question
          $questionkey += 1;
          my $nextquestion = $survey->{questions}->[0]->{question}->{$questionkey}->{text}->[0];
          $sendbody = "The next question is \"" . $nextquestion . "\" ";
          my $questiontype = $survey->{questions}->[0]->{question}->{$questionkey}->{type}->[0];
          log3("question type is $questiontype");
          if ($questiontype eq "yesno")
          {
          $sendbody = $sendbody . "Type 1 for yes or 2 for no.";
          }
          my $surveykey = $question{$jid} + 1;
          $question{$jid} += 1;
        }
        else
        {
          $sendbody = "Please reply with 1 for yes or 2 for no.";
        }
      }
      else
      {
        #
        # we need to handle other question types here!!!
        #
      }
      }
    }
    #
    # end handling of "completing" state
    #
    else
    {
      $sendbody = "To use this bot, please send a subscription request to " . $me;
    }
   }
   $msg = Net::Jabber::Message->new();
   $msg->SetMessage( "to"      => $from,
                     "type"    => "chat", 
                     "body"    => $sendbody );
   SendMessage($msg);
  }
}

sub SendMessage
{
# this method sends a message
$connection->Send($msg);
}

sub log1 {
  # WARN
  my $logmsg = shift;
#  return unless VERBOSE >= 1;
  print STDERR "WARN: $logmsg\n";
}

sub log2 {
  # INFO
  my $logmsg = shift;
#  return unless VERBOSE >= 2;
  print STDERR "INFO: $logmsg\n";
}

sub log3 {
  # DBUG
  my $logmsg = shift;
#  return unless VERBOSE >= 3;
  print STDERR "DBUG: $logmsg\n";
}