#!/usr/bin/perl
# -*- Perl -*-

# $Id: make-peereval-surveys 250 2018-10-30 16:49:47Z jrv $

# This script creates course peer evaluation surveys that can be imported
# into Qualtrics. The survey is defined in a qsf file which is Qualtrics
# file format for exporting/importing the full information about a survey.
#
# The script also requires a team file that specifies the team that each
# student is on. Optionally, a file that specifies a long form name for one or
# more of the teams can be provided. There are also options for specifying
# the base filenames for the generated file, and a title for the survey.
#

use strict;
use warnings;

use Data::Dumper;
use File::Basename;

use constant FALSE => 0;
use constant TRUE => (!FALSE);

# For getopts processing of the command line
use Getopt::Std;
$Getopt::Std::STANDARD_HELP_VERSION = TRUE;

my %cmdOptions;
my $cmdOptionKeys = 'hvb:n:st:';
use constant SHOW_USAGE => 'h';
use constant VERBOSE => 'v';
use constant BASEFILENAME => 'b';
use constant TEAMNAMES => 'n';
use constant SEPARATE_OPT => 's';
use constant TITLE_OPT => 't';

# This is the default base filename if the -b options is not provided.
my $surveyTitle = "Peer Evaluations";
my $baseFilename = 'Peer Evaluations';
my $inputLongTeamnames = FALSE;
my $teamnamesFilename;
my $separateFiles = FALSE;
my $verbose = FALSE;

# Global associations that holds the information about students in a team.
my %teams;
my @teamsOrdered;

# These are indices into the array storing information for each team.
use constant TEAMID => 0;
use constant TEAMNAME => 1;
use constant MEMBERS => 2;
use constant TEAMUSED => 3;

# These are indices into the array of information about each student on
# a team
use constant FULLNAME => 0;
use constant LASTNAME => 1;
use constant FIRSTNAME => 2;
use constant LOGINID => 3;
use constant MEMBERUSED => 4;

# The survey template is read from a filename given on the command line or
# from STDIN. It is stored here for use multiple times generating separate
# survey files for each team.
my $surveyTemplate;

# These variables will help to flag a use of last name and first name in the
# template when it was not identified in all member names.
my $lastOrFirstNameUsed = FALSE;
my $lastAndFirstNameIdentified = TRUE;

#-----------------------------------------------------------------------
#
#  Definition of subroutines
#
#-----------------------------------------------------------------------

# Print version and help information in the form needed by getopts
my $VERSION = '$Id: make-peereval-surveys 250 2018-10-30 16:49:47Z jrv $';
my $scriptName = fileparse($0);
sub VERSION_MESSAGE() {
    print "$scriptName version: $VERSION\n";
    return;
}

sub HELP_MESSAGE()
{
    print << "HELP MESSAGE";
Usage: $scriptName [-hsv] [-b basename] [-n teamname-file]
                             [-t survey-title]
                             tabbed-team-info-file [survey-template-file]

  -b provide filename prefix for all generated surveys
  -h output this message
  -n provide long form names for teams
  -s separate survey file for each team
  -t specify a title for the survey [[SURVEYTITLE]]
  -v generate verbose output

The tabbed-team-info-file is a tab separated file with one line per student
holding team-id<tab>student-name<tab>rit-login-id. The team-id is a unique
id for each team, typically, the letter designating the team. Teams are
ordered by team-id. The student-name is the full name for the student. Team
members are ordered by full name. If a comma exists in the full name, it is
assumed to divide the full name into last-name, first-name which would be
available individually in substitutions. The script generates a message if it
finds that the template file uses last-name or first-name, and some names were
not provided using the comma notation. Blanks would be output for those
students instead of their names. The student-name can be enclosed in quotes
which are stripped off. The rit-login-id is just the id part, i.e. it does not
include \@rit.edu.

The tabbed-team-info-file is required. The survey-template-file can be
given on the command line or read from standard input.

The teamname-file is a tab separated file with one line per team
holding team-id<tab>long-form-team-name.

The survey template file is gotten by exporting a Qualtrics survey that
defines the template in their QSF format and then pretty printing it to
a file. https://jsoneditoronline.org is a good website to use for this.

The script will copy the survey template to the output file substituting
for the keywords found in the template. The output filename for a multi-team
survey is filename-prefix.qsf. For single team surveys, the survey for each
team is placed in a file named filename-prefix-id.qsf where id is the team-id
for the team represented by the file. The default filename-prefix is
"Peer Evaluations" which can be changed using the -b option on the command
line.

The script will substitute the appropriate team and member specific values
for the following keywords.

[[SURVEYTITLE]] - a title for the survey set with the -t command line option
  or using the default "Peer Evaluations".
[[TEAMNAME t]] - the name for team t where t is the team's numeric index in
  the list of teams. If a long form name was given for the team that is used.
  Otherwise, the team-id is substituted.
[[TEAMID t]] - the team-id for team t where t is the team's numeric index in
  the list of teams.
[[TEAM t format]] - information about team t where t is the team's numeric
  index in the list of teams. The format string can be any normal characters.
  HTML constructs should be preserved. Within the format string substituions
  are made for the following keywords TEAMNAME, TEAMID, and MEMBERS. The
  MEMBERS keyword will generate a comma-separated list of all the members of
  the specified team. MEMBERS can have an additional format specified in
  parentheses, ie. MEMBERS(format). The format string can include the
  keywords FULLNAME, LASTNAME, FIRSTNAME, and LOGINID. This represents the
  format for outputting each team member's information.
[[MEMBERS t format]] - a comma-separated list of the members of team t where
  t is the team's numeric index in the list of teams. Format specifies how to
  output each team member's name and can include the keywords FULLNAME,
  LASTNAME, FIRSTNAME, and LOGINID.
[[MEMBER t m format]] - information about team member m on team t where m is
  the member's index in the list of members on the team, and t is the team's
  numeric index in the list of teams. The format string can include the
  keywords FULLNAME, LASTNAME, FIRSTNAME, and LOGINID.
HELP MESSAGE
	
    exit 0;
    
}

# Gather information about the students
sub getStudents($)
{
    my($teamInfoFilename) = ($_[0]);

    if($verbose) {
 	print "Reading team information from $teamInfoFilename\n";
    }

    if(!open(TEAMINFO, $teamInfoFilename)) {
 	print STDERR "Can not open team info file $teamInfoFilename: $!\n";
 	exit 2;
    }

    while(<TEAMINFO>) {
 	# remove line terminators and any trailing whitespace
 	s/\r*$//;
 	s/\s+$//;

	# Ignore blank lines in the tabbed team file, and then make sure it
	# is well-formed as id<tab>name<tab>RIT id/email
	if(/\S/) {
	    if(/^\S[\S ]*\t\S[\S ]+\t[0-9a-zA-Z@\.]+$/) {
		# Parse and store the student name and e-mail address. Strip
		# any quotes around the name.
		my ($teamId, $name, $email) = split('\t');
		($name) = $name =~ /"*([^"]+)"*/;
		
		# first time that this team is seen
		if(!defined($teams{$teamId})) {
		    $teams{$teamId} = [$teamId, $teamId, [], FALSE];
		}

		# If the full-name has an embedded comma this is considered
		# to be what separates the last name and first name.
		my $lastName = '';
		my $firstName = '';

		if($name =~ /([^,]+), *(.*)/) {
		    $lastName = $1;
		    $firstName = $2;
		}
		else {
		    $lastAndFirstNameIdentified = FALSE;
		}

		# There are constants above that define indices into
		# this array of student information. For each student
		# the information is stored in the order full-name,
		# last-name, first-name, email.
		push(@{$teams{$teamId}[MEMBERS]},
		     [$name, $lastName, $firstName, $email, FALSE]);
	    }
	    else {
		print STDERR
		  "Team info file line $. does not appear to be well-formed.\n";
	    }
	}
    }
    close TEAMINFO;

    if(keys(%teams) <= 0) {
 	print STDERR "No team information found.\n";
 	exit 3;
    }

    # sort the list of members on each team by the full name
    foreach my $teamId (keys %teams) {
	my @sortedMembers =
	    (sort {@{$a}[FULLNAME] cmp @{$b}[FULLNAME]}
	     @{$teams{$teamId}[MEMBERS]});
	@{$teams{$teamId}[MEMBERS]} = @sortedMembers;
    }

    # Create an array of teams ordered by the team id.
    my $index = 0;
    foreach my $teamId (sort(keys %teams)) {
	$teamsOrdered[$index] = $teams{$teamId};
	$index++;
    }
    return;
}

# This routine will read a file of long team names and store them with the
# other team information.
sub getLongTeamnames($)
{
    my($teamNameFilename) = ($_[0]);

    if($verbose) {
 	print "Reading long team names from $teamNameFilename\n";
    }

    if(!open(TEAMNAMEFILE, $teamNameFilename)) {
 	print STDERR "Can not open team name file $teamNameFilename: $!\n";
 	exit 2;
    }

    while(<TEAMNAMEFILE>) {
 	# remove line terminators and any trailing whitespace
 	s/\r*$//;
 	s/\s+$//;

	# Ignore blank lines and then make sure it is well-formed as
	# id<tab>long name
	if(/\S/) {
	    if(/^\S[\S ]*\t\S[\S ]+$/) {
		my($teamId, $longName) = split('\t');
		if(defined($teams{$teamId})) {
		    $teams{$teamId}[TEAMNAME] = $longName;
		}
		else {
		    print STDERR
	      "No students in team $teamId that has a long name in line $..\n";
		}
	    }
	    else {
		print STDERR
	      "Team long name in line $. does not appear to be well-formed.\n";
	    }
	}
    }
    close TEAMNAMEFILE;
    return;
}

# This routine reads the survey template text file. Typically, the filename
# is given as the last command line parameter, but the text can also come in
# through standard input.
sub readSurveyTemplate
{
    while(<>) {
 	# remove line terminators and any trailing whitespace
 	s/\r*$//;
 	s/\s+$//;

	if(!$lastOrFirstNameUsed && (/LASTNAME/ || /FIRSTNAME/)) {
	    $lastOrFirstNameUsed = TRUE;
	}
	
	$surveyTemplate .= $_ . "\n";
    }
    return;
}

# This routine will create a comma separated list of all the members on a
# team. It returns this as a string. If the format string is blank, it will
# use the fullname field for the member name.
sub makeMembersString
{
    my @teamMembers = @{$_[0]};
    my $format = $_[1];
    
    my $csMembers = '';
 
    foreach my $member (@teamMembers) {
	@{$member}[MEMBERUSED] = TRUE;
	if($csMembers ne "") {
	    $csMembers .= ', ';
	}
	
	my $memberString;
	if($format ne '') {
	    $memberString = $format;
	    $memberString =~ s/FULLNAME/@{$member}[FULLNAME]/;
	    $memberString =~ s/LASTNAME/@{$member}[LASTNAME]/;
	    $memberString =~ s/FIRSTNAME/@{$member}[FIRSTNAME]/;
	    $memberString =~ s/LOGINID/@{$member}[LOGINID]/;
	}
	else {
	    $memberString = @{$member}[FULLNAME];
	}

	$csMembers .= $memberString;
    }
    return $csMembers;
}

# This subroutine will write one survey file. It will do the expansion
# of keywords anywhere that they are found in the survey template which
# was read in previously.
sub outputSurveyFile
{
    my ($fh, $teamArrayRef, $name) = @_;
    my @teamInfo = @{$teamArrayRef};
    
    my $templateLine = 0;
    
    for (split /^/, $surveyTemplate) {
	$templateLine++;
	
	# Check for all of the valid substitution keywords
	# TEAMNAME t
	# TEAMID t
	# TEAM t -- TEAMNAME, TEAMID, MEMBERS
	# MEMBERS t -- FULLNAME, LASTNAME, FIRSTNAME, LOGINID
	# MEMBER t m -- FULLNAME, LASTNAME, FIRSTNAME, LOGINID

	my $keyword;
	my $format;
	my $teamIndex;
	my $memberIndex;
	my $outputText;
	
	# [[TEAM t format]] format keywords: TEAMNAME, TEAMID, MEMBERS
	if(/\[\[TEAM\s+(\d+)\s*(.*)\]\]/) {
	    if($1 > @teamInfo) {
		print STDERR "Team $1 not available for line $templateLine\n";
		$outputText = "[[TEAM $1 DELETE ME]]";
	    }
	    else {
		# ToDo - make this a reference use rather than a copy
		# See TEAMNAME|TEAMID|MEMBERS
		my @team = @{$teamInfo[$1 - 1]};
		$format = $2;
		$teamInfo[$1 - 1][TEAMUSED] = TRUE;

		# Output information about the team in the format provided,
		# if any.
		if ($format ne '') {
		    $outputText = $format;
		    $outputText =~ s/TEAMID/$team[TEAMID]/g;
		    $outputText =~ s/TEAMNAME/$team[TEAMNAME]/g;

		    # The MEMBERS format key can be followed by its own format
		    # string enclosed in parentheses. The format keywords are
		    # the same as for the MEMBERS substitution keyword.
		    if($outputText =~ /MEMBERS(\((.*)\))*/) {
			my $membersOutput =
			  makeMembersString($team[MEMBERS],$2);
			$outputText =~ s/MEMBERS(\(.*\))*/$membersOutput/g;
		    }
		}
		# With no format provided, output team name
		else
		{
		    $outputText = $team[TEAMNAME];
		}
	    }
	    $outputText =~ s/"/\\"/g;
	    s/\[\[TEAM[^\]]+\]\]/$outputText/;
	}

	# [[MEMBER t m format]]
	# format keywords: FULLNAME, LASTNAME, FIRSTNAME, LOGINID
	if(/\[\[MEMBER\s+(\d+)\s+(\d+)\s*(.*)\]\]/) {
	    if(($1 > @teamInfo) || ($2 > @{$teamInfo[$1 - 1][MEMBERS]})) {
		print STDERR
		    "Member $1 $2 not available for line $templateLine\n";
		$outputText = "[[MEMBER $1 $2 DELETE ME]]";
	    }
	    else {
		# ToDo - make this a reference rather than making a copy
		my @member = @{$teamInfo[$1 - 1][MEMBERS][$2 - 1]};
		$format = $3;
		$member[MEMBERUSED] = TRUE;
		$teamInfo[$1 - 1][TEAMUSED] = TRUE;
		
		# Output the information for one member using the format
		# provided, if any.
		if ($format ne '') {
		    if((($format =~ /LASTNAME/) && ($member[LASTNAME] eq '')) ||
		    (($format =~ /FIRSTNAME/) && ($member[FIRSTNAME] eq ''))) {
			print STDERR
 "LASTNAME or FIRSTNAME used in line $templateLine but not known in $member[FULLNAME]\n";
		    }
		    $outputText = $format;
		    $outputText =~ s/FULLNAME/$member[FULLNAME]/g;
		    $outputText =~ s/LASTNAME/$member[LASTNAME]/g;
		    $outputText =~ s/FIRSTNAME/$member[FIRSTNAME]/g;
		    $outputText =~ s/LOGINID/$member[LOGINID]/g;
		}
		else
		{
		    $outputText = $member[FULLNAME];
		}
	    }
	    $outputText =~ s/"/\\"/g;
	    s/\[\[MEMBER[^\]]+\]\]/$outputText/;
	}

	# These substitution keywords take a team number
	if(/\[\[(TEAMNAME|TEAMID|MEMBERS)\s+(\d+)\s*(.*)\]\]/) {
	    my $keyword = $1;

	    if($2 > @teamInfo) {
		print STDERR
		    "Team $2 not available for $1 in line $templateLine\n";
		$outputText = "[[$1 $2 DELETE ME]]";
	    }
	    else {
		my $team = \@{$teamInfo[$2 - 1]};
		my $format = $3;
		@{$team}[TEAMUSED] = TRUE;
		
		if($keyword eq 'TEAMNAME') {
		    $outputText = @{$team}[TEAMNAME];
		}
		elsif($keyword eq 'TEAMID') {
		    $outputText = @{$team}[TEAMID];
		}
		else {
		    $outputText = makeMembersString(@{$team}[MEMBERS],$format);
		}
	    }

	    my $regex = qr/\[\[$keyword[^\]]+\]\]/;
	    $outputText =~ s/"/\\"/g;
	    s/${regex}/$outputText/;
	}

	# Substitute the survey title and also use it as the project name
	if(/\[\[SURVEYTITLE\]\]/) {
	    s/\[\[SURVEYTITLE\]\]/$surveyTitle/;
	}

	if(/"SurveyName":/) {
	    s/"SurveyName": "[^"]+"/"SurveyName": "$name"/;
	}

	print $fh $_;
    }
    return;
}

# This subroutine will look through all the teams and members to make sure
# that everyone has been used at some point.
sub checkUsage {
    foreach my $team (@teamsOrdered) {
	foreach my $member (@{@{$team}[MEMBERS]}) {
	    if(!@{$member}[MEMBERUSED]) {
		print STDERR "Member @{$member}[FULLNAME] was never output\n";
	    }
	}
	
	if(!@{$team}[TEAMUSED]) {
	    print STDERR "Team @{$team}[TEAMID] was never output\n";
	}
    }
}

#---------------------------------------------------------------------
#
# Start creation of peer evaluation survey files
#
#---------------------------------------------------------------------

# Process any command line options
if(!getopts($cmdOptionKeys, \%cmdOptions)) {
  HELP_MESSAGE(); # will die there
}

# The SHOW_USAGE option will print a usage message
if($cmdOptions{+SHOW_USAGE}) {
  HELP_MESSAGE(); # will die there
}

# The VERBOSE option will track progress through the processing of comments
if($cmdOptions{+VERBOSE}) {
  $verbose = TRUE;
  print "Verbose mode is on.\n";
}

# Change the base filename used for the output files created by this script.
if($cmdOptions{+BASEFILENAME}) {
  $baseFilename = $cmdOptions{+BASEFILENAME};

  if($verbose) {
      print "Base filename set to $baseFilename\n";
  }
}

# The separate option will create a separate survey file for each team. The
# team id will be appended to the survey filename.
if($cmdOptions{+TEAMNAMES}) {
  $inputLongTeamnames = TRUE;
  $teamnamesFilename = $cmdOptions{+TEAMNAMES};  

  if($verbose) {
    print "Inputting long teamnames from $teamnamesFilename\n";
  }
}

# The separate option will create a separate survey file for each team. The
# team id will be appended to the survey filename.
if($cmdOptions{+SEPARATE_OPT}) {
  $separateFiles = TRUE;

  if($verbose) {
    print "Outputting separate survey files for each team\n";
  }
}

# The title option allow you to define a new title for the survey which is
# inserted wherever [[SURVEYTITLE]] is found in the template.
if($cmdOptions{+TITLE_OPT}) {
  $surveyTitle = $cmdOptions{+TITLE_OPT};
  $surveyTitle =~ s/"/\\"/g;

  if($verbose) {
    print "Survey title set to $surveyTitle\n";
  }
}

# Now the main processing of the input data.
if($verbose) {
    print "Creating survey files.\n";
}

# There should be two command line arguments specifying the team info
# filename and the survey boilerplate file.
if(@ARGV >= 1) {
    getStudents($ARGV[0]);
    shift;
    
    if($inputLongTeamnames) {
	getLongTeamnames($teamnamesFilename);
    }

    if($verbose) {
	print "Completed reading team information\n";
	print Dumper(@teamsOrdered);
    }

    if(@ARGV > 1) {
	print STDERR "Only a single survey template file can be specified.\n";
	exit 2;
    }

    readSurveyTemplate();
    if($lastOrFirstNameUsed && !$lastAndFirstNameIdentified) {
	print
      "LASTNAME or FIRSTNAME used in template but not provided in all names.\n";
    }
    
    # For separate files, iterate through the teams making one file for each
    # team.
    if($separateFiles) {
	foreach my $teamId (sort(keys(%teams))) {
	    my $surveyFilename = $baseFilename . "-" . $teamId . ".qsf";

	    my $surveyFH;
	    if(!open($surveyFH, ">", $surveyFilename)) {
		print STDERR
		    "Can not open survey file $surveyFilename: $!\n";
		exit 3;
	    }
	    
	    my @thisTeam = ($teams{$teamId});
	    outputSurveyFile($surveyFH, \@thisTeam,
			     "$baseFilename - Team $teamId");
	    close $surveyFH;
	}
    }

    # For a single file, output the survey text blocks and for each team block
    # iterate through all the teams outputting the block once for each team
    else {
	my $surveyFilename = $baseFilename . ".qsf";
	
	my $surveyFH;
	if(!open($surveyFH, ">", $surveyFilename)) {
	    print STDERR "Can not open survey file $surveyFilename: $!\n";
	    exit 2;
	}
	outputSurveyFile($surveyFH, \@teamsOrdered, $baseFilename);	
	close $surveyFH;
    }

    # Output information about any teams or students who did not have
    # information output at least once.
    checkUsage();
}
else {
  print STDERR "Missing team info filename.\n";
  HELP_MESSAGE();
  exit 1;
}