#    This source code file is part of the "mod_survey" package.
#
#    Copyright (C) 2004 eveca GmbH, Regensburg (ilse@eveca.de)
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program (probably in a file named "LICENSE.txt" or the like);
#    if not, write to:
#
#    Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

#!/usr/bin/perl

package Survey::Template;

use strict;
use warnings;
use Data::Dumper;

# using numbers inside hashes should be faster, but nobody can understand the code than.
# so define the numbers as constans.
# When printing structures for debugging for example with Data::Dumper,
# use constants below which contains strings instead of numbers

use constant TYPE            => 10;
use constant VARIABLE        => 11;
use constant LOOPBEGIN       => 12;
use constant LOOPEND         => 13;
use constant TEXT            => 15;
use constant IF              => 16;
use constant ELSE            => 17;
use constant ENDIF           => 18;
use constant LEVEL           => 20;
use constant VALUE           => 30;
use constant CONTEXT         => 40;
use constant NAME            => 50;
use constant TEMPLATE        => 60;
use constant CURRENT_LEVEL   => 70;
use constant CURRENT_CONTEXT => 80;
use constant VARIABLES       => 90;
use constant SEARCH_OFFSET   => 100;
use constant LOOP_RUNS       => 110;
use constant RAN_LOOP        => 120;
use constant FIXED_LOOP_RUNS => 130;
use constant FIXED           => 140;

###############

# use this constants for debugging to easier understand what is inside datastructures
#use constant TYPE		=> 'type';
#use constant VARIABLE	=> 'variable';
#use constant LOOPBEGIN	=> 'loopBegin';
#use constant LOOPEND	=> 'loopEnd';
#use constant TEXT		=> 'text';
#use constant IF			=> 'if';
#use constant ELSE		=> 'else';
#use constant ENDIF		=> 'endif';
#use constant LEVEL		=> 'level';
#use constant VALUE		=> 'value';
#use constant CONTEXT	=> 'context';
#use constant NAME		=> 'name';
#use constant TEMPLATE	=> 'template';
#use constant CURRENT_LEVEL	=> 'currentLevel';
#use constant CURRENT_CONTEXT	=> 'currentContext';
#use constant VARIABLES	=> 'variables';
#use constant SEARCH_OFFSET	=> 'searchOffset';
#use constant LOOP_RUNS	=> 'loopRuns';
#use constant RAN_LOOP	=> 'ranLoops';
#use constant FIXED_LOOP_RUNS	=> 'fixedLoopRuns';
#use constant FIXED		=> 'fixed';

#####################################

use constant NUMBER_OF_RUNS => 0;
use constant RANDOMIZED     => 1;

sub new()
{
    my $Object = shift;
    my $File   = shift;

    my $this = {};

    bless($this, $Object);

    $this->{Survey::Template::TEMPLATE}        = [{}];          # contains the template as a datastructure
    $this->{Survey::Template::CURRENT_LEVEL}   = 0;             # current nesting level (loops)
    $this->{Survey::Template::CURRENT_CONTEXT} = ["global"];    # current context (loops)
    $this->{Survey::Template::VARIABLES}       = {};            # contains variables and its values
    $this->{Survey::Template::SEARCH_OFFSET}   = 0;             # required for sub _findNextByType()
    $this->{Survey::Template::LOOP_RUNS} =
      {};    # in here is saved, how often a loop is initialized with "enterLoop" and how often "nextLoop" is called
    $this->{Survey::Template::RAN_LOOP}        = {};    # saves what initialization of a loop is already run
    $this->{Survey::Template::FIXED_LOOP_RUNS} = {};

    if ($File) { $this->_readFile($File); }

    return $this;
}

#######################################################

sub _readFile()
{
    my $this = shift;
    my $File = shift;

    open(FIN, "<$File") or die $! . ": $File     ";

    # create character array out of the filecontent
    my @characterArray = split(//, join("", <FIN>));

    close(FIN);

    # parse the character array and create a datastructure of the template
    $this->{Survey::Template::TEMPLATE} = $this->_parseArray(\@characterArray);

    # initialize variables to avoid errors of "use strict" (can't use undefined value as arrayref etc.)
    $this->_initVariables();
}

#######################################################

sub _getNumberOfLoopInits()
{
    my $this     = shift;
    my $LoopName = shift;

    my $numberOfInits = 0;

    if ($LoopName ne "global")
    {
        $numberOfInits = scalar(@{ $this->{Survey::Template::LOOP_RUNS}->{$LoopName} }) - 1;
    }

    return $numberOfInits;
}

#######################################################

# set a variable to a value
sub setVar()
{
    my $this     = shift;
    my $VarName  = shift;
    my $VarValue = shift;

    # check if the variable is valid
    my $VariableExits = $this->_variableExits($VarName);
    if ($VariableExits < 0) { die "variable '$VarName' does not exist"; }

    # for easier usage
    my $vars = $this->{Survey::Template::VARIABLES};

    # get the name of current context (global, or name of current loop)
    my $currentContext =
      $this->{Survey::Template::CURRENT_CONTEXT}->[scalar(@{ $this->{Survey::Template::CURRENT_CONTEXT} }) - 1];

    my $numberOfInits = $this->_getNumberOfLoopInits($currentContext);

    if (!defined $vars->{$VarName}->{$currentContext})
    {
        $vars->{$VarName}->{$currentContext} = [];
    }

    my $loopRuns   = $this->{Survey::Template::LOOP_RUNS};
    my $valueIndex = $loopRuns->{$currentContext}->[$numberOfInits]->[Survey::Template::NUMBER_OF_RUNS];

    if (not defined $valueIndex) { $valueIndex = 0; }

    $vars->{$VarName}->{$currentContext}->[$numberOfInits]->[$valueIndex] = $VarValue;
}

#######################################################

# get the template as a string
sub get()
{
    my $this = shift;

    my $tmpl = $this->{Survey::Template::TEMPLATE};

    # clear: how often a loop was run to enable to call this method more than once
    $this->{Survey::Template::RAN_LOOP} = {};

    #print Dumper $this->{Survey::Template::VARIABLES};
    #exit;

    # insert variables into the template datastructure
    $this->_setValues($tmpl);

    # create a string out of the template datastructure
    my $str = "";

    for (my $i = 0 ; $i < scalar(@$tmpl) ; $i++)
    {
        $str .= $this->{Survey::Template::TEMPLATE}->[$i]->{Survey::Template::VALUE};
    }

    return $str;
}

#######################################################

sub enterLoop()
{
    my $this     = shift;
    my $LoopName = shift;
    my $Random   = shift;

    if (!defined $Random) { $Random = 0; }
    elsif ($Random eq "random") { $Random = 1; }
    else                        { $Random = 0; }

    # check if loop is existant
    my $loopIndex = $this->_loopExistsAtLevel($LoopName, $this->{Survey::Template::CURRENT_LEVEL});

    #	if ($loopIndex < 0)
    #	{die "loop '$LoopName' does not exist at level '$this->{Survey::Template::CURRENT_LEVEL}'";}

    # increase current nesting level
    $this->{Survey::Template::CURRENT_LEVEL}++;

    # add loopname as current context
    push(@{ $this->{Survey::Template::CURRENT_CONTEXT} }, $LoopName);

    if (!defined $this->{Survey::Template::LOOP_RUNS}->{$LoopName})
    {
        $this->{Survey::Template::LOOP_RUNS}->{$LoopName} = [];
    }

    push(@{ $this->{Survey::Template::LOOP_RUNS}->{$LoopName} }, [0, $Random]);
}

#######################################################

sub nextLoop()
{
    my $this = shift;

    my $loopName =
      $this->{Survey::Template::CURRENT_CONTEXT}->[scalar(@{ $this->{Survey::Template::CURRENT_CONTEXT} }) - 1];

    my $top = scalar(@{ $this->{Survey::Template::LOOP_RUNS}->{$loopName} }) - 1;

    # increase number of loop executions
    $this->{Survey::Template::LOOP_RUNS}->{$loopName}->[$top]->[Survey::Template::NUMBER_OF_RUNS]++;
}

#######################################################

sub exitLoop()
{
    my $this = shift;

    # decrement current nesting level
    $this->{Survey::Template::CURRENT_LEVEL}--;

    # delete loopname from context
    pop(@{ $this->{Survey::Template::CURRENT_CONTEXT} });
}

#######################################################

# keep elements at their position in random loops
sub fixLoopRun()
{
    my $this = shift;

    my $loopName =
      $this->{Survey::Template::CURRENT_CONTEXT}->[scalar(@{ $this->{Survey::Template::CURRENT_CONTEXT} }) - 1];
    my $numberOfInits = $this->_getNumberOfLoopInits($loopName);

    my $top          = scalar(@{ $this->{Survey::Template::LOOP_RUNS}->{$loopName} }) - 1;
    my $numberOfRuns = $this->{Survey::Template::LOOP_RUNS}->{$loopName}->[$top]->[Survey::Template::NUMBER_OF_RUNS];

    if (not defined $this->{Survey::Template::FIXED_LOOP_RUNS}->{$loopName})
    {
        $this->{Survey::Template::FIXED_LOOP_RUNS}->{$loopName} = [];
    }

    if (not defined $this->{Survey::Template::FIXED_LOOP_RUNS}->{$loopName}->[$numberOfInits])
    {
        $this->{Survey::Template::FIXED_LOOP_RUNS}->{$loopName}->[$numberOfInits] = {};
    }

    $this->{Survey::Template::FIXED_LOOP_RUNS}->{$loopName}->[$numberOfInits]->{$numberOfRuns} =
      Survey::Template::FIXED;
}

#######################################################

# parses the template (must be a character array)
# and creates the template datastructure
sub _parseArray()
{
    my $this = shift;
    my $Tmpl = shift;

    my @stack;

    my $tagFlag             = 0;
    my $exclamationMarkFlag = 0;
    my $hyphenFlag1         = 0;
    my $hyphenFlag2         = 0;

    # everything belongs to context "global"
    my @context = ("global");

    # nesting level is 0 at the beginning
    my $level = 0;

    my $text = "";

    # iterate over the whole template (character by character)
    for (my $i = 0 ; $i < scalar(@$Tmpl) ; $i++)
    {
        my $c = $Tmpl->[$i];

        my $asdfx = "test";

        # a tag starts
        if ($c eq '<') { $tagFlag = 1; }

        # last character was an opening tag-bracket
        elsif ($c eq '!' && $tagFlag) { $exclamationMarkFlag = 1; }

        # "<!" was already read
        elsif ($c eq '-' && $exclamationMarkFlag)
        {
            if   (!$hyphenFlag1) { $hyphenFlag1 = 1; }
            else                 { $hyphenFlag2 = 1; }

        }

        # a variable was found ("<!--" was read until now)
        elsif ($c eq '%' && $hyphenFlag2)
        {
            $i = $this->_parseVariable($Tmpl, $i, \@stack, \@context, \$level, \$text);

            $tagFlag             = 0;
            $exclamationMarkFlag = 0;
            $hyphenFlag1         = 0;
            $hyphenFlag2         = 0;
        }

        # a loop-begin or loop-end was found ("<!--" was read until now)
        elsif ($c eq '[' && $hyphenFlag2)
        {
            $i = $this->_parseLoop($Tmpl, $i, \@stack, \@context, \$level, \$text);

            $tagFlag             = 0;
            $exclamationMarkFlag = 0;
            $hyphenFlag1         = 0;
            $hyphenFlag2         = 0;
        }

        # a if, else or endif structure was found ("<!--" was read until now)
        elsif ($c eq '{' && $hyphenFlag2)
        {
            $i = $this->_parseIfElse($Tmpl, $i, \@stack, \@context, \$level, \$text);

            $tagFlag             = 0;
            $exclamationMarkFlag = 0;
            $hyphenFlag1         = 0;
            $hyphenFlag2         = 0;
        }

        # nothing special was detected, so handle the character as text
        # and reset all flags
        else
        {

            if ($tagFlag) { $text .= "<"; }

            $text .= $c;

            $tagFlag             = 0;
            $exclamationMarkFlag = 0;
            $hyphenFlag1         = 0;
            $hyphenFlag2         = 0;
        }

    }

    # if there is still text remaining
    if ($text)
    {
        my @c = @context;
        push(@stack,
             {  Survey::Template::TYPE    => Survey::Template::TEXT,
                Survey::Template::LEVEL   => $level,
                Survey::Template::VALUE   => $text,
                Survey::Template::NAME    => "",
                Survey::Template::CONTEXT => \@c });
    }

    return \@stack;
}

#######################################################

sub _parseVariable()
{
    my $this    = shift;
    my $Tmpl    = shift;
    my $I       = shift;
    my $Stack   = shift;
    my $Context = shift;
    my $Level   = shift;
    my $Text    = shift;

    my $varName;

    # read the variablename and set $i to end of the variable
    $I = $this->_getVariableName($Tmpl, $I, \$varName);

    # create a copy of the contextarray
    my @c = @$Context;

    # add the text before the variable to the datastructure
    push(@$Stack,
         {  Survey::Template::TYPE    => Survey::Template::TEXT,
            Survey::Template::LEVEL   => $$Level,
            Survey::Template::VALUE   => $$Text,
            Survey::Template::NAME    => "",
            Survey::Template::CONTEXT => \@c });
    $$Text = "";

    # add variable to datastructure
    push(@$Stack,
         {  Survey::Template::TYPE    => Survey::Template::VARIABLE,
            Survey::Template::LEVEL   => $$Level,
            Survey::Template::VALUE   => "",
            Survey::Template::NAME    => $varName,
            Survey::Template::CONTEXT => \@c });

    return $I;
}

#######################################################

sub _parseLoop()
{
    my $this    = shift;
    my $Tmpl    = shift;
    my $I       = shift;
    my $Stack   = shift;
    my $Context = shift;
    my $Level   = shift;
    my $Text    = shift;

    # there are no characters remaining
    # (ok in perl this doesn't matter, there can't be a bufferoverflow...)
    if ($I > scalar(@$Tmpl) - 1) { die 'out of range'; }

    # get next character to decide, if we are dealing with a loop begin or a loop end
    $I++;
    my $c = $Tmpl->[$I];

    my $loopName;
    my @c = @$Context;

    # add text to datastructure
    push(@$Stack,
         {  Survey::Template::TYPE    => Survey::Template::TEXT,
            Survey::Template::LEVEL   => $$Level,
            Survey::Template::VALUE   => $$Text,
            Survey::Template::NAME    => "",
            Survey::Template::CONTEXT => \@c });
    $$Text = "";

    # a loop-end was found
    if ($c eq '/')
    {

        # get loopname and set $i to end of loopmarker
        $I = $this->_getLoopName($Tmpl, $I, \$loopName);
        $$Level--;
        push(@$Stack,
             {  Survey::Template::TYPE    => Survey::Template::LOOPEND,
                Survey::Template::LEVEL   => $$Level,
                Survey::Template::VALUE   => "",
                Survey::Template::NAME    => $loopName,
                Survey::Template::CONTEXT => \@c });

        pop(@$Context);

    }

    # a loop-begin was found
    else
    {
        $loopName .= $c;

        # get loopname and set $i to end of loopmarker
        $I = $this->_getLoopName($Tmpl, $I, \$loopName);
        push(@$Stack,
             {  Survey::Template::TYPE    => Survey::Template::LOOPBEGIN,
                Survey::Template::LEVEL   => $$Level,
                Survey::Template::VALUE   => "",
                Survey::Template::NAME    => $loopName,
                Survey::Template::CONTEXT => \@c });

        push(@$Context, $loopName);
        $$Level++;
    }

    return $I;
}

#######################################################

sub _parseIfElse()
{
    my $this    = shift;
    my $Tmpl    = shift;
    my $I       = shift;
    my $Stack   = shift;
    my $Context = shift;
    my $Level   = shift;
    my $Text    = shift;

    # there are no characters remaining
    # (ok in perl this doesn't matter, there can't be a bufferoverflow...)
    if ($I > scalar(@$Tmpl) - 1) { return; }

    # get next character
    $I++;
    my $c = $Tmpl->[$I];

    # "<!--{i" was read
    if ($c eq 'i')
    {
        my $varName = "";
        $I = $this->_getIf($Tmpl, $I, \$varName);

        $$Level++;
        my @c = @$Context;

        # add text to datastructure
        push(@$Stack,
             {  Survey::Template::TYPE    => Survey::Template::TEXT,
                Survey::Template::LEVEL   => $$Level,
                Survey::Template::VALUE   => $$Text,
                Survey::Template::NAME    => "",
                Survey::Template::CONTEXT => \@c });
        $$Text = "";

        # add if to datastructure
        push(@$Stack,
             {  Survey::Template::TYPE    => Survey::Template::IF,
                Survey::Template::LEVEL   => $$Level,
                Survey::Template::VALUE   => "",
                Survey::Template::NAME    => $varName,
                Survey::Template::CONTEXT => \@c });
    }

    # "<!--{e" was read (=> could be 'else' or 'endif')
    elsif ($c eq 'e')
    {

        # there are no characters remaining
        # (ok in perl this doesn't matter, there can't be a bufferoverflow...)
        if ($I > scalar(@$Tmpl) - 1) { return; }

        # get next character
        $I++;
        $c = $Tmpl->[$I];

        # 'else' found
        if ($c eq 'l')
        {
            $I = $this->_getElseOrEndifEnd($Tmpl, $I);

            my @cont = @$Context;

            # add text to datastructure
            push(@$Stack,
                 {  Survey::Template::TYPE    => Survey::Template::TEXT,
                    Survey::Template::LEVEL   => $$Level,
                    Survey::Template::VALUE   => $$Text,
                    Survey::Template::NAME    => "",
                    Survey::Template::CONTEXT => \@cont });
            $$Text = "";

            push(@$Stack,
                 {  Survey::Template::TYPE    => Survey::Template::ELSE,
                    Survey::Template::LEVEL   => $$Level,
                    Survey::Template::VALUE   => "",
                    Survey::Template::NAME    => "",
                    Survey::Template::CONTEXT => \@cont });
        }

        # 'endif' found
        elsif ($c eq 'n')
        {
            $I = $this->_getElseOrEndifEnd($Tmpl, $I);
            my @cont = @$Context;

            # add text to datastructure
            push(@$Stack,
                 {  Survey::Template::TYPE    => Survey::Template::TEXT,
                    Survey::Template::LEVEL   => $$Level,
                    Survey::Template::VALUE   => $$Text,
                    Survey::Template::NAME    => "",
                    Survey::Template::CONTEXT => \@cont });
            $$Text = "";

            push(@$Stack,
                 {  Survey::Template::TYPE    => Survey::Template::ENDIF,
                    Survey::Template::LEVEL   => $$Level,
                    Survey::Template::VALUE   => "",
                    Survey::Template::NAME    => "",
                    Survey::Template::CONTEXT => \@cont });
            $$Level--;
        }
    }

    return $I;
}

#######################################################

# make sure, that array refs exist in $this->{Survey::Template::VARIABLES}, otherwise there will be
# problems with "use strict"  when trying to use an undefined value as an array
sub _initVariables()
{
    my $this = shift;

    my $vars = $this->{Survey::Template::VARIABLES};

    $this->_setSearchOffset(0);

    # add an array for every existing variable in every context
    while ((my $index = $this->_findNextByType(Survey::Template::VARIABLE)) >= 0)
    {
        my $varName  = $this->{Survey::Template::TEMPLATE}->[$index]->{Survey::Template::NAME};
        my $contexts = $this->{Survey::Template::TEMPLATE}->[$index]->{Survey::Template::CONTEXT};

        foreach my $context (@$contexts)
        {
            $vars->{$varName}->{$context} = [];
        }
    }

    $this->_setSearchOffset(0);
    while ((my $index = $this->_findNextByType(Survey::Template::IF)) >= 0)
    {
        my $varName  = $this->{Survey::Template::TEMPLATE}->[$index]->{Survey::Template::NAME};
        my $contexts = $this->{Survey::Template::TEMPLATE}->[$index]->{Survey::Template::CONTEXT};

        foreach my $context (@$contexts)
        {
            $vars->{$varName}->{$context} = [];
        }
    }

}

#######################################################

# reads the name of a variable out of the template character array
# returns end of variable marker
sub _getVariableName()
{
    my $this    = shift;
    my $Tmpl    = shift;
    my $I       = shift;
    my $VarName = shift;

    my $percentFlag = 0;
    my $hyphenFlag3 = 0;
    my $hyphenFlag4 = 0;

    # get variable name
    while (++$I < scalar(@$Tmpl))
    {
        my $c = $Tmpl->[$I];

        # end of loop?
        if ($c eq '%') { $percentFlag = 1; }

        elsif ($c eq '-' && $percentFlag)
        {
            if   (!$hyphenFlag3) { $hyphenFlag3 = 1; }
            else                 { $hyphenFlag4 = 1; }
        }

        # end of variable is reached
        elsif ($c eq '>' && $hyphenFlag4) { return $I; }

        else
        {
            $$VarName .= $c;

            $percentFlag = 0;
            $hyphenFlag3 = 0;
            $hyphenFlag4 = 0;
        }
    }
}

#######################################################

# reads the name of a loop out of the template character array
# returns end of variable marker
sub _getLoopName()
{
    my $this     = shift;
    my $Tmpl     = shift;
    my $I        = shift;
    my $LoopName = shift;

    my $squaredBracketFlag = 0;
    my $hyphenFlag1        = 0;
    my $hyphenFlag2        = 0;

    while (++$I < scalar(@$Tmpl))
    {
        my $c = $Tmpl->[$I];

        if ($c eq ']') { $squaredBracketFlag = 1; }

        elsif ($c eq '-' && $squaredBracketFlag)
        {
            if   (!$hyphenFlag1) { $hyphenFlag1 = 1; }
            else                 { $hyphenFlag2 = 1; }
        }

        elsif ($c eq '>' && $hyphenFlag2) { return $I; }

        else
        {
            $$LoopName .= $c;

            $squaredBracketFlag = 0;
            $hyphenFlag1        = 0;
            $hyphenFlag2        = 0;
        }
    }
}

#######################################################

sub _getIf()
{
    my $this    = shift;
    my $Tmpl    = shift;
    my $I       = shift;
    my $VarName = shift;

    my $fFlag          = 0;
    my $colonFlag      = 0;
    my $endBracketFlag = 0;
    my $hyphenFlag1    = 0;
    my $hyphenFlag2    = 0;

    while (++$I < scalar(@$Tmpl))
    {
        my $c = $Tmpl->[$I];

        if ($c eq 'f') { $fFlag = 1; }

        elsif ($c eq ':' && $fFlag) { $colonFlag = 1; }

        elsif ($c eq '}' && $colonFlag) { $endBracketFlag = 1; }

        elsif ($c eq '-')
        {
            if (!$hyphenFlag1) { $hyphenFlag1 = 1; }

            else { $hyphenFlag2 = 1; }
        }

        elsif ($c eq '>' && $hyphenFlag2) { return $I; }

        elsif ($colonFlag) { $$VarName .= $c; }

        else
        {
            $fFlag          = 0;
            $colonFlag      = 0;
            $endBracketFlag = 0;
            $hyphenFlag1    = 0;
            $hyphenFlag2    = 0;
        }
    }
}

#######################################################

sub _getElseOrEndifEnd()
{
    my $this = shift;
    my $Tmpl = shift;
    my $I    = shift;

    my $endBracketFlag = 0;
    my $hyphenFlag1    = 0;
    my $hyphenFlag2    = 0;

    while (++$I < scalar(@$Tmpl))
    {
        my $c = $Tmpl->[$I];

        if ($c eq '}') { $endBracketFlag = 1; }

        elsif ($c eq '-' && $endBracketFlag)
        {
            if   (!$hyphenFlag1) { $hyphenFlag1 = 1; }
            else                 { $hyphenFlag2 = 1; }
        }

        elsif ($c eq '>' && $hyphenFlag2) { return $I; }

        else
        {
            $endBracketFlag = 0;
            $hyphenFlag1    = 0;
            $hyphenFlag2    = 0;
        }
    }

}

#######################################################

# check if a loop exists at a specific nesting level
sub _loopExistsAtLevel()
{
    my $this     = shift;
    my $LoopName = shift;
    my $Level    = shift;

    my $tmpl = $this->{Survey::Template::TEMPLATE};

    $this->_setSearchOffset(0);

    while ((my $index = $this->_findNextByType(Survey::Template::LOOPBEGIN, $LoopName)) >= 0)
    {
        if ($tmpl->[$index]->{Survey::Template::LEVEL} eq $Level)
        {
            return $index;
        }
    }

    return -1;
}

#######################################################

# check if a specific variable exists
sub _variableExits
{
    my $this    = shift;
    my $VarName = shift;

    # check if a variable with this name exists
    $this->_setSearchOffset(0);
    while ((my $index = $this->_findNextByType(Survey::Template::VARIABLE)) >= 0)
    {
        my $name = $this->{Survey::Template::TEMPLATE}->[$index]->{Survey::Template::NAME};

        if ($name eq $VarName) { return $index; }
    }

    # check if variable name occures in an if-construct
    $this->_setSearchOffset(0);
    while ((my $index = $this->_findNextByType(Survey::Template::IF)) >= 0)
    {
        my $name = $this->{Survey::Template::TEMPLATE}->[$index]->{Survey::Template::NAME};

        if ($name eq $VarName) { return $index; }
    }

    return -1;
}

#######################################################

sub _setSearchOffset()
{
    my $this   = shift;
    my $Offset = shift;

    $this->{Survey::Template::SEARCH_OFFSET} = $Offset;
}

#######################################################

# finds the first occurrence of a element type in  the template (variable, loopbegin, loopend, text)
sub _findFirstByType
{
    my $this  = shift;
    my $Type  = shift;
    my $Value = shift;

    $this->{Survey::Template::SEARCH_OFFSET} = 0;
    return $this->_findNextByType($Type, $Value);

}

#######################################################

# finds the next occurrence of a element type in  the template (variable, loopbegin, loopend, text)
sub _findNextByType
{
    my $this  = shift;
    my $Type  = shift;
    my $Value = shift;

    my $tmpl = $this->{Survey::Template::TEMPLATE};

    for (my $i = $this->{Survey::Template::SEARCH_OFFSET} ; $i < scalar(@$tmpl) ; $i++)
    {
        if ($tmpl->[$i]->{Survey::Template::TYPE} eq $Type)
        {
            my $name = $this->{Survey::Template::TEMPLATE}->[$i]->{Survey::Template::NAME};

            if ($Value && $name eq $Value)
            {
                $this->{Survey::Template::SEARCH_OFFSET} = $i + 1;
                return $i;
            }

            elsif (!$Value)
            {
                $this->{Survey::Template::SEARCH_OFFSET} = $i + 1;
                return $i;
            }
        }
    }

    return -1;
}

#######################################################

# parse template datastructure, run loops and set variables
sub _setValues()
{
    my $this       = shift;
    my $Tmpl       = shift;    # the template structure must be a parameter to enable recursive calls
    my $ValueIndex = shift;
    my $LoopInit   = shift;

    $ValueIndex = (defined $ValueIndex) ? $ValueIndex : 0;
    $LoopInit   = (defined $LoopInit)   ? $LoopInit   : 0;

    my $vars = $this->{Survey::Template::VARIABLES};

    # iterate over the template structure
    for (my $i = 0 ; $i < scalar(@$Tmpl) ; $i++)
    {
        my $type     = $Tmpl->[$i]->{Survey::Template::TYPE};
        my $name     = $Tmpl->[$i]->{Survey::Template::NAME};
        my $contexts = $Tmpl->[$i]->{Survey::Template::CONTEXT};

        # if current element is a variable
        if ($type eq Survey::Template::VARIABLE)
        {
            my $value = $this->_getVariableValue($name, $contexts, $ValueIndex, $LoopInit);
            $Tmpl->[$i]->{Survey::Template::VALUE} = $value;
        }

        # handle loops
        elsif ($type eq Survey::Template::LOOPBEGIN)
        {

            # set $i to end of the loop
            $i = $this->_runLoop($Tmpl, $i);
        }

        elsif ($type eq Survey::Template::IF)
        {
            $i = $this->_execIf($Tmpl, $i, $ValueIndex, $LoopInit);
        }

    }

}

#######################################################

sub _getVariableValue()
{
    my $this       = shift;
    my $VarName    = shift;
    my $Contexts   = shift;
    my $ValueIndex = shift;
    my $LoopInit   = shift;

    my $vars = $this->{Survey::Template::VARIABLES};

    # iterate over all valid contexts for current variable
    for (my $j = scalar(@$Contexts) - 1 ; $j >= 0 ; $j--)
    {
        my $context = $Contexts->[$j];

        if (!defined $vars->{$VarName}->{$context}->[$LoopInit])
        {
            $vars->{$VarName}->{$context}->[$LoopInit] = [""];
        }

        # if at least one value is availabe for the variable in current context
        if (scalar(@{ $vars->{$VarName}->{$context}->[$LoopInit] }) > 0)
        {
            my $values = $vars->{$VarName}->{$context}->[$LoopInit];

            return $values->[$ValueIndex];
        }
    }

    return "";
}

#######################################################

sub _runLoop()
{
    my $this      = shift;
    my $Tmpl      = shift;
    my $LoopStart = shift;

    # get index where loop ends
    my $loopEnd = $this->_findLoopEnd($Tmpl, $LoopStart);

    # get the name of the loop
    my $loopName = $Tmpl->[$LoopStart]->{Survey::Template::NAME};

    # save, how often the loop was "exectued"  (if there's an undefined value, it means, that the loop was not run)
    if (!defined $this->{Survey::Template::RAN_LOOP}->{$loopName})
    {
        $this->{Survey::Template::RAN_LOOP}->{$loopName} = 0;
    }

    #  number of times, the loop should run
    my $runs =
      $this->{Survey::Template::LOOP_RUNS}->{$loopName}->[$this->{Survey::Template::RAN_LOOP}->{$loopName}]
      ->[Survey::Template::NUMBER_OF_RUNS];
    my $random =
      $this->{Survey::Template::LOOP_RUNS}->{$loopName}->[$this->{Survey::Template::RAN_LOOP}->{$loopName}]
      ->[Survey::Template::RANDOMIZED];

    #print Dumper $this->{Survey::Template::LOOP_RUNS}->{$loopName}->[];
    #exit;

    # run at last once
    #if ($runs == 0)
    #{$runs ++;}
    if (not defined $runs) { $runs = 0; }

    my @array;

    for (my $i = 0 ; $i < $runs ; $i++)
    {

        # get everything inside the loop
        my $loopContent = $this->_getLoopContent($Tmpl, $LoopStart);

        # set variables, handle if-else-structures, run loops inside current loop
        $this->_setValues($loopContent, $i, $this->{Survey::Template::RAN_LOOP}->{$loopName});

        push(@array, $loopContent);
    }

    if ($random)
    {
        $this->_fisher_yates_shuffle(\@array, $loopName, $this->{Survey::Template::RAN_LOOP}->{$loopName});
    }

    my @loop;

    # @array contains arrayrefs as elements to enable randomisation,
    # but the template datastructure cannot deal with arrayrefs
    foreach my $item (@array) { push(@loop, @$item); }

    # now the loop was run one more often
    $this->{Survey::Template::RAN_LOOP}->{$loopName}++;

    # delete the loop in template-structure
    splice(@$Tmpl, $LoopStart, $loopEnd - $LoopStart + 1, @loop);

    # set the index to the last element inserted in this loop
    return $LoopStart - 1 + scalar(@loop);
}

#######################################################

# randomizes an array (source from http://sedition.com/perl/javascript-fy.html)
# (modified to exclude some arrayelements from randomization)
sub _fisher_yates_shuffle()
{
    my $this          = shift;
    my $list          = shift;    # this is an array reference
    my $LoopName      = shift;
    my $NumberOfInits = shift;

    my $i = @{$list};
    return unless $i;

    # this elements shouldn't be randomized
    my $fixedElements = $this->{Survey::Template::FIXED_LOOP_RUNS}->{$LoopName}->[$NumberOfInits];

    # swap every element of the array with a randomly chosen other element
    while (--$i)
    {

        # if $i points to an "static" element, do not touch it
        if (exists $fixedElements->{$i}) { next; }

        my $j;

        # get a new random value until $j doesn't point
        # to a "static" element
        do
        {
            $j = int rand($i + 1);
        } while (exists $fixedElements->{$j});

        @{$list}[$i, $j] = @{$list}[$j, $i];
    }
}

#######################################################

sub _findLoopEnd()
{
    my $this  = shift;
    my $Tmpl  = shift;
    my $Index = shift;

    my $loopName  = $Tmpl->[$Index]->{Survey::Template::NAME};
    my $loopLevel = $Tmpl->[$Index]->{Survey::Template::LEVEL};

    while (++$Index < scalar(@$Tmpl))
    {
        my $currentName  = $Tmpl->[$Index]->{Survey::Template::NAME};
        my $currentLevel = $Tmpl->[$Index]->{Survey::Template::LEVEL};
        my $currentType  = $Tmpl->[$Index]->{Survey::Template::TYPE};

        if ($currentName eq $loopName && $currentLevel == $loopLevel && $currentType eq Survey::Template::LOOPEND)
        {
            return $Index;
        }
    }

    return -1;
}

#######################################################

sub _getLoopContent()
{
    my $this  = shift;
    my $Tmpl  = shift;
    my $Index = shift;

    my $loopEndIndex = $this->_findLoopEnd($Tmpl, $Index);

    my @content;

    while (++$Index < $loopEndIndex)
    {
        my %item = %{ $Tmpl->[$Index] };

        push(@content, \%item);
    }

    return \@content;
}
#######################################################

sub _execIf
{
    my $this       = shift;
    my $Tmpl       = shift;
    my $BeginIf    = shift;
    my $ValueIndex = shift;
    my $LoopInit   = shift;

    my $ifName     = $Tmpl->[$BeginIf]->{Survey::Template::NAME};
    my $ifLevel    = $Tmpl->[$BeginIf]->{Survey::Template::LEVEL};
    my $ifContexts = $Tmpl->[$BeginIf]->{Survey::Template::CONTEXT};

    my $variableValue = $this->_getVariableValue($ifName, $ifContexts, $ValueIndex, $LoopInit);

    my $endIf = -1;
    my $else  = -1;

    # find 'else' and 'endif'
    my $i = $BeginIf;
    while (++$i < scalar(@$Tmpl))
    {
        my $currentName  = $Tmpl->[$i]->{Survey::Template::NAME};
        my $currentLevel = $Tmpl->[$i]->{Survey::Template::LEVEL};
        my $currentType  = $Tmpl->[$i]->{Survey::Template::TYPE};

        if ($currentType eq Survey::Template::ENDIF && $currentLevel == $ifLevel)
        {
            $endIf = $i;
            last;
        }

        elsif ($currentType eq Survey::Template::ELSE && $currentLevel == $ifLevel) { $else = $i; }
    }

    my $content;

    # if the variable has a value that can be interpreted as true
    if ($variableValue)
    {

        # if a 'else'-part exists in the template
        if ($else >= 0) { $content = $this->_getIfContent($Tmpl, $BeginIf, $else); }

        else { $content = $this->_getIfContent($Tmpl, $BeginIf, $endIf); }
    }

    elsif ($else >= 0)
    {
        $content = $this->_getIfContent($Tmpl, $else, $endIf);
    }

    if (defined $content)
    {
        $this->_setValues($content, $ValueIndex, $LoopInit);
        splice(@$Tmpl, $BeginIf, $endIf - $BeginIf + 1, @$content);
        return $BeginIf + scalar(@$content);

        #return $endIf - $BeginIf - scalar(@$content);
    }

    else
    {
        splice(@$Tmpl, $BeginIf, $endIf - $BeginIf + 1);

        #return $endIf - $BeginIf - 1;
        return $BeginIf - 1;
    }
}

#######################################################

sub _getIfContent()
{
    my $this    = shift;
    my $Tmpl    = shift;
    my $BeginIf = shift;
    my $EndIf   = shift;

    my @content;

    while (++$BeginIf < $EndIf)
    {
        my %item = %{ $Tmpl->[$BeginIf] };

        push(@content, \%item);
    }

    return \@content;

}

1
__END__