package WebGUI::Asset::Wobject::Survey::ResponseJSON;

=head1 LEGAL

-------------------------------------------------------------------
WebGUI is Copyright 2001-2008 Plain Black Corporation.
-------------------------------------------------------------------
Please read the legal notices (docs/legal.txt) and the license
(docs/license.txt) that came with this distribution before using
this software.
-------------------------------------------------------------------
http://www.plainblack.com                     info@plainblack.com
-------------------------------------------------------------------

=head1 NAME

Package WebGUI::Asset::Wobject::Survey::ResponseJSON

=head1 DESCRIPTION

Helper class for WebGUI::Asset::Wobject::Survey.  It manages data
from the user, sets the order of questions and answers in the survey,
based on forks, and gotos, and also handles expiring the survey
due to time limits.

This package is not intended to be used by any other Asset in WebGUI.

=cut


use strict;
use JSON;
use Data::Dumper;

=head2 new ( $json, $log, $survey )

Object constructor.

=head3 $json

Pass in some JSON to be serialized into a data structure.  Useful JSON would
contain a hash with "startTime", "surveyOrder", "responses", "lastReponse"
and "questionsAnswered" keys, with appropriate values.

=head3 $log

The session logger, from $session->log.  The class needs nothing else from the
session object.

=head3 $survey

A WebGUI::Asset::Wobject::Survey::SurveyJSON object that represents the current
survey.

=cut

sub new {
    my $class  = shift;
    my $json   = shift;
    my $log    = shift;
    my $survey = shift;
    my $temp = from_json($json) if defined $json;
    my $self   = defined $temp ? $temp : {};
    $self->{survey} = $survey;
    $self->{log}    = $log;
    $self->{responses}         = defined $temp->{responses}         ? $temp->{responses}         : {};
    $self->{lastResponse}      = defined $temp->{lastResponse}      ? $temp->{lastResponse}      : -1;
    $self->{questionsAnswered} = defined $temp->{questionsAnswered} ? $temp->{questionsAnswered} : 0;
    $self->{startTime}         = defined $temp->{startTime}         ? $temp->{startTime}         : time();
    #an array of question addresses, with the third member being an array of answers
    $self->{surveyOrder}       = defined $temp->{surveyOrder}       ? $temp->{surveyOrder}       : [];
    bless( $self, $class );
    return $self;
} ## end sub new

#----------------------------------------------------------------------------

=head2 createSurveyOrder ( SurveyJSON, [address,address] )

This creates the order for the survey which will change after every fork.  The survey
order is to precreate random questions and answers, which also leaves a record or what
the user was presented with.  Forks are passed in to show where to branch the new order.

If questions and/or answers were set to be randomized, it is handled in here.

=cut

sub createSurveyOrder {
    my $self = shift;
    my $order;
    my $qstarting = 0;
    for ( my $s = 0; $s <= $#{ $self->survey->sections() }; $s++ ) {

        #create question order for section
        my @qorder;
        if ( $self->survey->section( [$s] )->{randomizeQuestions} ) {
            @qorder = shuffle( ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) );
        }
        else {
            @qorder = ( ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) );
        }

        #if this is an empty section, make sure it is still on the list to be seen
        if ( @qorder == 0 ) {
            push( @$order, [$s] );
        }
        $qstarting = 0;

        #create answer order for question
        for (@qorder) {
            my @aorder;
            if ( $self->survey->question( [ $s, $_ ] )->{randomizeAnswers} ) {
                @aorder = shuffle( ( $qstarting .. $#{ $self->survey->question( [ $s, $_ ] )->{answers} } ) );
            }
            else {
                @aorder = ( ( $qstarting .. $#{ $self->survey->question( [ $s, $_ ] )->{answers} } ) );
            }
            push( @$order, [ $s, $_, \@aorder ] );
        }
    } ## end for ( my $s = 0; $s <= ...
    $self->{surveyOrder} = $order;
} ## end sub createSurveyOrder

=head2 shuffle ( @array )

Returns the contents of @array in a random order.

=cut

sub shuffle {
    my @a = splice @_;
    for my $i ( 0 .. $#a ) {
        my $j = int rand @a;
        @a[ $i, $j ] = @a[ $j, $i ];
    }
    return @a;
}

=head2 freeze

Serializes the object to JSON, after deleting the log and survey objects stored in it.

=cut

sub freeze {
    my $self = shift;
    my %temp = %{$self};
    delete $temp{log};
    delete $temp{survey};
    return to_json( \%temp );
}

#Has the survey timed out?

=head2 hasTimedOut ( $limit )

Checks to see whether this survey has timed out, based on the internally stored starting
time, and $limit.

=head3 $limit

How long the user has to take the survey, in minutes.

=cut

sub hasTimedOut{
    my $self=shift;
    my $limit = shift;
    return 1 if($self->startTime() + ($limit * 60) < time() and $limit > 0);
    return 0;
}

#the index of the last surveyOrder entry shown

=head2 lastResponse ([ $responseIndex ])

Mutator for the index of the last surveyOrder entry shown.  With no arguments,
returns the lastResponse index.

=head3 $responseIndex

If defined, sets the lastResponse to $responseIndex.

=cut

sub lastResponse {
    my $self = shift;
    my $res  = shift;
    if ( defined $res ) {
        $self->{lastResponse} = $res;
    }
    else {
        return $self->{lastResponse};
    }
}

=head2 startTime ([ $newStartTime ])

Mutator for the time the user began the survey.  With no arguments,
returns the startTime.

=head3 $newStarttime

If defined, sets the starting time to $newStartTime.

=cut

sub startTime {
    my $self     = shift;
    my $newTime  = shift;
    if ( defined $newTime ) {
        $self->{startTime} = $newTime;
    }
    else {
        return $self->{startTime};
    }
}

#array of addresses in which the survey should be presented

=head2 surveyOrder

Accessor for the survey order data structure.  It is a deep set of arrays, similar in
structure to a WebGUI::Asset::Wobject::Survey::SurveyJSON address.

    [ $sectionIndex, $questionIndex, [ $answerIndex1, $answerIndex2, ....]

There is one array element for every section and address in the survey.

If there are no questions, or no addresses, those array elements will not be present.

=cut

sub surveyOrder {
    my $self = shift;
    return $self->{surveyOrder};
}

=head2 nextSectionId

Relative to the surveyOrder and the lastResponse index, get the index of the
next section.  Note, based on the number of questions in an section, this can
be the same as the current section index.

=cut

sub nextSectionId {
    my $self = shift;
    return $self->surveyOrder->[ $self->lastResponse + 1 ]->[0];
}

=head2 nextSection

Relative to the surveyOrder and the lastResponse index, gets the next section.
Note, based on the number of questions in a section, this can be the same as
the current section.

=cut

sub nextSection {
    my $self = shift;
    return $self->survey->section( [ $self->surveyOrder->[ $self->lastResponse + 1 ]->[0] ] );
}

=head2 currentSection

Relative to the surveyOrder and the lastResponse index, get the current section.

=cut

sub currentSection {
    my $self = shift;
    return $self->survey->section( [ $self->surveyOrder->[ $self->lastResponse ]->[0] ] );
}

sub recordResponses {
    my $self      = shift;
    my $session   = shift;
    my $responses = shift;
    
    my %mcTypes = (
        'Agree/Disagree', 1, 'Certainty',       1, 'Concern',        1, 'Confidence', 1, 'Education',  1,
        'Effectiveness',  1, 'Gender',          1, 'Ideology',       1, 'Importance', 1, 'Likelihood', 1,
        'Party',          1, 'Multiple Choice', 1, 'Oppose/Support', 1, 'Race',       1, 'Risk',       1,
        'Satisfaction',   1, 'Scale',           1, 'Security',       1, 'Threat',     1, 'True/False', 1,
        'Yes/No',         1
    );
    my %sliderTypes = ( 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1, 'Slider', 1 );
    my %textTypes   = ( 'Currency',    'Email', 1, 'Phone Number', 1, 'Text', 1, 'Text Date', 1 );
    my %fileTypes   = ( 'File Upload', 1 );
    my %dateTypes   = ( 'Date',        'Date Range', 1 );
    my %hiddenTypes = ( 'Hidden',      1 );

    #These were just submitted from the user, so we need to see what and how they were (un)answered.
    my $questions = $self->nextQuestions();
    my $qAnswered = 1;
    my $sterminal  = 0;
    my $terminal  = 0;
    my $terminalUrl;
    my $goto;

    my $section = $self->nextSection();#which gets the current section for the just submitted questions.  IE, current response pointer has not moved forward for these questions

    if ( $section->{terminal} ) {
        $sterminal    = 1;
        $terminalUrl = $section->{terminalUrl};
    }

    #There were no questions in the section just displayed, so increment the lastResponse by one
    if ( ref $questions ne 'ARRAY' ) {
        $self->lastResponse( $self->lastResponse + 1 );
        return [ $terminal, $terminalUrl ];
    }

    for my $question (@$questions) {
        my $aAnswered = 0;
        if ( $question->{terminal} ) {
            $terminal    = 1;
            $terminalUrl = $question->{terminalUrl};
        }
        $self->responses->{ $question->{id} }->{comment} = $responses->{ $question->{id} . "comment" };
        for my $answer ( @{ $question->{answers} } ) {

            if ( defined( $responses->{ $answer->{id} } )
                and $responses->{ $answer->{id} } =~ /\S/ )
            {

                $aAnswered = 1;
                if ( $mcTypes{ $question->{questionType} } ) {
                    $self->responses->{ $answer->{id} }->{value} = $answer->{recordedAnswer};
                }
                else {
                    $self->responses->{ $answer->{id} }->{value} = $responses->{ $answer->{id} };
                }
                $self->responses->{ $answer->{id} }->{'time'} = time();
                $self->responses->{ $answer->{id} }->{comment} = $responses->{ $answer->{id} . "comment" };

                if ( $answer->{terminal} ) {
                    $terminal    = 1;
                    $terminalUrl = $answer->{terminalUrl};
                }
                elsif ( $answer->{goto} =~ /\w/ ) {
                    $goto = $answer->{goto};
                }
            } ## end if ( defined( $responses...
        } ## end for my $answer ( @{ $question...
        $qAnswered = 0 if ( !$aAnswered and $question->{required} );
        $self->{questionsAnswered}++ if($aAnswered);
    } ## end for my $question (@$questions)

    #if all responses completed, move the lastResponse index to the last question shown
    if ($qAnswered) {
        $self->lastResponse( $self->lastResponse + @$questions );
        $self->goto($goto) if ( defined $goto );
    }
    else {
        $terminal = 0;
    }
    
    if($sterminal and $self->nextSection != $self->currentSection){
        $terminal = 1;
    }     

    return [ $terminal, $terminalUrl ];
} ## end sub recordResponses

sub goto {
    my $self = shift;
    my $goto = shift;
    for ( my $i = 0; $i <= $#{ $self->surveyOrder() }; $i++ ) {
        my $section  = $self->survey->section( $self->surveyOrder()->[$i] );
        my $question = $self->survey->question( $self->surveyOrder()->[$i] );
        if ( ref $section eq 'HASH' and $section->{variable} eq $goto ) {
            $self->lastResponse( $i - 1 );
            last;
        }
        if ( ref $question eq 'HASH' and $question->{variable} eq $goto ) {
            $self->lastResponse( $i - 1 );
            last;
        }
    }
} ## end sub goto

sub getPreviousAnswer {
    my $self          = shift;
    my $questionParam = shift;
    for my $q ( @{ $self->surveyOrder } ) {
        my $question = $self->survey->question( [ $$q[0], $$q[1] ] );
        if ( $question->{variable} eq $questionParam ) {
            for ( 0 .. @{ $self->survey->answers( [ $$q[0], $$q[1] ] ) } ) {
                if ( exists $self->responses->{ $$q[0] . "-" . $$q[1] . "-" . $_ } ) {
                    return $self->responses->{ $$q[0] . "-" . $$q[1] . "-" . $_ }->{value};
                }
            }
        }
    }
}

sub nextQuestions {
    my $self = shift;

    return [] if $self->surveyEnd;

    my $nextSectionId = $self->nextSectionId;

    my $qPerPage = $self->survey->section( [ $self->nextSectionId ] )->{questionsPerPage};

    #load Previous answer text
    my $section = $self->nextSection();
    $section->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg;

    my $questions;
    for ( my $i = 1; $i <= $qPerPage; $i++ ) {
        my $qAddy = $self->surveyOrder->[ $self->lastResponse + $i ];
        next
            if ( !exists $$qAddy[1] );    #skip this if it doesn't have a question (for sections with no questions)

        if ( $$qAddy[0] != $nextSectionId ) {
            last;
        }
        my %question = %{ $self->survey->question( [ $$qAddy[0], $$qAddy[1] ] ) };
        $question{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg;
        delete $question{answers};
        $question{id}  = "$$qAddy[0]-$$qAddy[1]";
        $question{sid} = "$$qAddy[0]";
        for ( @{ $$qAddy[2] } ) {
            my $ans = $self->survey->answer( [ $$qAddy[0], $$qAddy[1], $_ ] );
            $ans->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg;
            $ans->{id} = "$$qAddy[0]-$$qAddy[1]-$_";
            push( @{ $question{answers} }, $ans );
        }
        push( @$questions, \%question );
    } ## end for ( my $i = 1; $i <= ...
    return $questions;
} ## end sub nextQuestions

=head2 surveyEnd

Returns true if the current index stored in lastResponse is greater than or
equal to the number of sections in the survey order.

=cut

sub surveyEnd {
    my $self = shift;
    return 1 if ( $self->lastResponse >= $#{ $self->surveyOrder } );
    return 0;
}

sub returnResponseForReporting {
    my $self      = shift;
    my @responses = ();
    for my $entry ( @{ $self->surveyOrder } ) {
        if ( @$entry == 1 ) {
            next;
        }
        my @answers;
        for ( @{ $$entry[2] } ) {
            if ( defined $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) {
                $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{id} = $_;
                if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )->{isCorrect} ) {
                    my $value;
                    if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )->{value} =~ /\w/ ) {
                        $value = $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )->{value};
                    }
                    else {
                        $value = $self->survey->question( [ $$entry[0], $$entry[1] ] )->{value};
                    }
                    $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{value}     = $value;
                    $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{isCorrect} = 1;
                }
                else {
                    $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{isCorrect} = 0;
                }
                push( @answers, ( $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) );
            } ## end if ( defined $self->responses...
        } ## end for ( @{ $$entry[2] } )
        push(
            @responses, ( {
                    'section',         $$entry[0],
                    'question',        $$entry[1],
                    'sectionName',     $self->survey->section( [ $$entry[0] ] )->{variable},
                    'questionName',    $self->survey->question( [ $$entry[0], $$entry[1] ] )->{variable},
                    'questionComment', $self->responses->{"$$entry[0]-$$entry[1]"}->{comment},
                    'answers',         \@answers
                }
            )
        );
    } ## end for my $entry ( @{ $self...
    return \@responses;
} ## end sub returnResponseForReporting

#the actual responses to the survey.  A response is for a question and is accessed by the exact same address as a survey member.
#Questions only contain the comment and an array of answer Responses.
#Answers only contain, entered text, entered verbatim, their index in the Survey Question Answer array, and the assetId to the uploaded file.

=head2 responses

Returns a reference to the actual responses to the survey.  A response is for a question and
is accessed by the exact same address as a survey member.  Questions only contain the comment
and an array of answer Responses.  Answers only contain, entered text, entered verbatim,
their index in the Survey Question Answer array, and the assetId to the uploaded file.

Note, this is an unsafe reference.

=cut

sub responses {
    my $self = shift;
    return $self->{responses};
}

=head2 responses

Returns a referece to the SurveyJSON object that this object was created with.

Note, this is an unsafe reference.

=cut

sub survey {
    my $self = shift;
    return $self->{survey};
}

=head2 log

Logs an error to the webgui log file, using the session logger.

=cut

sub log {
    my ( $self, $message ) = @_;
    if ( defined $self->{log} ) {
        $self->{log}->error($message);
    }
}
1;