#    This source code file is part of the "mod_survey" package.
#
#    Copyright (C) 2004  Joel Palmius
#
#    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::Document;

use File::Basename;

use Text::ParseWords;
use Survey::Debug;
use strict;
use Safe;
use Encode;
use Encode::Guess qw/latin1 utf8 ascii/;

use Survey::Session;
use Survey::Language;

use CGI;

use Survey::Argument;
use Survey::Session;

use Survey::Component::Component;
use Survey::Component::Env;
use Survey::Component::Constant;
use Survey::Component::Calculated;
use Survey::Component::Lickert;
use Survey::Component::Choice;
use Survey::Component::List;
use Survey::Component::Matrix;
use Survey::Component::Boolean;
use Survey::Component::Geo;
use Survey::Component::Text;
use Survey::Component::Memo;
use Survey::Component::Newline;
use Survey::Component::Custom;
use Survey::Component::Comment;
use Survey::Component::DateTime;
use Survey::Component::Timer;

use Survey::Component::Submit;
use Survey::Component::SubmitError;
use Survey::Component::MailCopy;
use Survey::Component::Cati;

#use Survey::Component::Import;
use Survey::Component::Ifroute;
use Survey::Component::Caseroute;
use Survey::Component::Route;
use Survey::Component::Randomroute;
use Survey::Component::Sequence;
use Survey::Component::Security;

sub new
{
    my ($crap, $r, $fn, $arg, $ses) = @_;

    my $self = {};
    my ($part, $valid, $type, $rest, $iscache, @timestamp, $ftime, $etime, $ctime, $sb, $debug);

    $debug = Survey::Debug->new();

    if (!$ses) { $ses = Survey::Session->new(); }
    if (!$arg) { $arg = Survey::Argument->new($ses); }

    $self->{DEBUG}    = $debug;
    $self->{SESSION}  = $ses;
    $self->{ARGUMENT} = $arg;

    #  $ses->setValue("test","doesitwork?");

    @timestamp = localtime(time);
    $debug->SetDebugParam("BEFOREDOCTIME", $timestamp[2] * 3600 + $timestamp[1] * 60 + $timestamp[0]);

    $self->{HANDLER}       = $r;
    $self->{ERROR}         = 0;
    $self->{ERRORCODE}     = 0;
    $self->{NUMTAGS}       = 0;
    $self->{APPENDEDFILES} = "0";

    # added in CRU patch (MJ/20020822)
    $self->{EMAIL} = 0;

    $self->{MAXLOOP} = 100;

    $self->{MAILCOPYTAG} = -1;
    $self->{FILE}        = $fn || $r->filename;
    $self->{OPTION_FILE} = $self->{FILE};
    if ($r)
    {
        $self->{OPTION_URI} = $r->uri;
    }
    else
    {

        #bugant -- horrible workaround 4 persistance --
        $self->{OPTION_URI} = basename($self->{FILE});
    }

    if ($fn)
    {
        $debug->AddDebugMsg("DOCUMENT", "A local filename was supplied. Disabling caches and key generation.");
        $self->{OPTION_ISLOCAL} = 1;
    }

    $self->{OPTION_SENSIBLE} = $ENV{"_SURVEY_SENSIBLE"};

    if (!$self->{OPTION_ISLOCAL})
    {
        $debug->AddDebugMsg("DOCUMENT", "Env parameter _SURVEY_SENSIBLE contains \"" . $ENV{"_SURVEY_SENSIBLE"} . "\"");
        $debug->AddDebugMsg("DOCUMENT", "Env parameter _SURVEY_USEDBI contains \"" . $ENV{"_SURVEY_USEDBI"} . "\"");
        $debug->AddDebugMsg("DOCUMENT",
                            "Env parameter _SURVEY_ALLOWAUTO contains \"" . $ENV{"_SURVEY_ALLOWAUTO"} . "\"");
        $debug->AddDebugMsg("DOCUMENT", "Env parameter _SURVEY_SYSBASE contains \"" . $ENV{"_SURVEY_SYSBASE"} . "\"");
        $debug->AddDebugMsg("DOCUMENT",
                            "Env parameter _SURVEY_PROTESTILLEGAL contains \"" . $ENV{"_SURVEY_PROTESTILLEGAL"} . "\"");

        $rest = $self->{FILE};
        $rest =~ s/\\/\_/g;
        $rest =~ s/\//\_/g;
        $rest =~ s/\:/\_/g;    # Needed for windows compat

        if ($self->{OPTION_SENSIBLE})    ## Sensible if unix/linux. Otherwise windows
        {
            $sb = $ENV{"_SURVEY_SYSBASE"} || "/tmp/.mod_survey";
            unless (-e $sb) { mkdir($sb, 0700); }
            $rest = $sb . "/" . $rest;
            unless (-e $rest) { mkdir($rest, 0700); }

            $self->{OPTION_SYSBASE} = $rest . "/";
        }
        else
        {
            my ($winloc);

            if   (-e "c:\\windows") { $winloc = "c:\\windows"; }
            else                    { $winloc = "c:\\winnt"; }
            $sb = $ENV{"_SURVEY_SYSBASE"} || $winloc;
            unless (-e $sb) { mkdir($sb, 0700); }
            $rest = $sb . "\\" . $rest;
            unless (-e $rest) { mkdir($rest, 0700); }

            $self->{OPTION_SYSBASE} = $rest . "\\";
        }

        $debug->AddDebugMsg("DOCUMENT", "Sysbase is " . $self->{OPTION_SYSBASE});
    }

    bless($self);

    $self->ParamsFill();

    unless (-e $self->{FILE})
    {
        $self->{ERROR}     = lprint("File does not exist : ") . $self->{FILE};
        $self->{ERRORCODE} = 1;
    }

    if ($ENV{"_SURVEY_USEDBI"})
    {
        eval "use Survey::Component::Import";
        if ($@)
        {
            $self->{ERROR}     = lprint("Could not include IMPORT") . " " . $@;
            $self->{ERRORCODE} = 99;
        }
    }

    if (!$self->{ERROR})
    {
        unless (-r $self->{FILE})
        {
            $self->{ERROR}     = lprint("Permission denied for ") . $self->{FILE};
            $self->{ERRORCODE} = 2;
        }
    }

    if (!$self->{ERROR})
    {

        # open survey file
        if (open(FIL, $self->{FILE}))
        {
            $self->{RAW} = join(' ', <FIL>);

            # parse some perlsnippets
            $self->PreParsePerl();

            #includes external files ( {@ ... @} )
            $self->PreParse();

            if($ENV{"_SURVEY_PARRY_ENCODING"})
            {
              $self->ParryEncoding();
            }

            # if a SURVEY-tag exists
            if (index($self->{RAW}, "<SURVEY") > -1)
            {

                # create a copy of the survey file content starting with the parameters
                # of SURVEY Tag
                $self->{WORK} = substr($self->{RAW}, index($self->{RAW}, "<SURVEY"));

                # if there is no closing SURVEY tag
                if (index($self->{WORK}, "</SURVEY>") eq -1)
                {
                    $self->{ERROR}     = lprint("No termination of survey tag in ") . $self->{FILE};
                    $self->{ERRORCODE} = 5;
                }

                # until the next subtag is not the closing SURVEY-tag (???)
                while ((my $part = $self->CutTag()) ne "</SURVEY>")
                {

                    # end loop on errors
                    if ($self->{ERROR}) { last; }

                    $valid = 0;

                    # get type (for example CHOICE, LICKERT...) and parameters of the tag
                    ($type, $rest) = $self->CleanUpTag($part);

                    # do further parsing and syntax checking
                    # this parses the given element and its subtags
                    # when this is done, Document::PlaceParams() is called from within
                    # Component::XXX::PlaceComponent
                    if ($type eq "SURVEY") { $self->PlaceSurvey($rest); $valid = 1; }
                    elsif ($type eq "ENV")
                    {
                        Survey::Component::Env->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "CONSTANT")
                    {
                        Survey::Component::Constant->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "CALCULATED")
                    {
                        Survey::Component::Calculated->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "LICKERT")
                    {
                        Survey::Component::Lickert->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "CHOICE")
                    {
                        Survey::Component::Choice->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "LIST")
                    {
                        Survey::Component::List->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "MATRIX")
                    {
                        Survey::Component::Matrix->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "BOOLEAN")
                    {
                        Survey::Component::Boolean->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "TEXT")
                    {
                        Survey::Component::Text->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "MEMO")
                    {
                        Survey::Component::Memo->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "NEWLINE")
                    {
                        Survey::Component::Newline->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "CUSTOM")
                    {
                        Survey::Component::Custom->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "GEO")
                    {
                        Survey::Component::Geo->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "COMMENT")
                    {
                        Survey::Component::Comment->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "IFROUTE")
                    {
                        Survey::Component::Ifroute->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "CASEROUTE")
                    {
                        Survey::Component::Caseroute->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "RANDOMROUTE")
                    {
                        Survey::Component::Randomroute->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "ROUTE")
                    {
                        Survey::Component::Route->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "SEQUENCE")
                    {
                        Survey::Component::Sequence->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "TIMER")
                    {
                        Survey::Component::Timer->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "DATETIME")
                    {
                        Survey::Component::DateTime->PlaceComponent($self, $rest);
                        $valid = 1;
                    }

                    elsif ($type eq "MAILCOPY")
                    {
                        Survey::Component::MailCopy->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "SECURITY")
                    {
                        Survey::Component::Security->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "IMPORT")
                    {
                        Survey::Component::Import->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "CATI")
                    {
                        Survey::Component::Cati->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "SUBMIT")
                    {
                        Survey::Component::Submit->PlaceComponent($self, $rest);
                        $valid = 1;
                    }
                    elsif ($type eq "SUBMITERROR")
                    {
                        Survey::Component::SubmitError->PlaceComponent($self, $rest);
                        $valid = 1;
                    }

                    if (!$valid)
                    {
                        $self->{ERROR} = "\"" . $type . "\"" . lprint("is not a valid tag (in ") . $self->{FILE} . ")";
                        $self->{ERRORCODE} = 6;
                    }
                }

                ## Append earlier files in multipage sequence (JP/20030707)
                if ($self->{OPTION_SEQUENCE} && ($arg->ArgByName("action") ne "display"))
                {
                    $self->AppendFiles();
                }
            }
            else
            {
                $self->{ERROR}     = $self->{FILE} . " " . lprint("does not contain survey tag");
                $self->{ERRORCODE} = 4;
            }
            $debug->AddDebugMsg("DOCUMENT", "Document was read from source");
        }
        else
        {
            $self->{ERROR}     = lprint("Could not open ") . $self->{FILE} . " " . lprint("for reading");
            $self->{ERRORCODE} = 3;
        }

        @timestamp = localtime(time);

        $debug->SetDebugParam("AFTERPARSETIME", $timestamp[2] * 3600 + $timestamp[1] * 60 + $timestamp[0]);
    }

    @timestamp = localtime(time);
    $debug->SetDebugParam("TOTDOCTIME", $timestamp[2] * 3600 + $timestamp[1] * 60 + $timestamp[0]);

    $debug->AddDebugMsg("DOCUMENT", "Asciifile is set to: " . $self->GetOption("ASCIIFILE"));
    $debug->AddDebugMsg("DOCUMENT", "Dbitable is set to: " . $self->GetOption("DBITABLE"));

    # added in CRU patch (MJ/20020802)
    if ($self->GetOption("REQAUTH") eq "yes")
    {
        $self->{REMOTE_USER} = $ENV{"REMOTE_USER"};
    }
    return ($self);
}


sub ParryEncoding
{
  my ($self) = shift;

  my($raw) = $self->{RAW};

  my($inputformat) = guess_encoding($raw, qw/latin1 utf8 ascii/);
  if(ref($inputformat))
  {
    my($internalformat) = $inputformat->decode($raw);
    my($enc) = $ENV{"_SURVEY_ENCODING"} || "UTF-8";
    my($utf8format) = encode($enc,$internalformat);
    $self->{RAW} = $utf8format;
  }
}


sub PreParsePerl
{
    my ($self) = shift;

    my ($start) = -1;
    my ($end)   = 0;

    my ($ml) = $self->{MAXLOOP};

    while (!$self->{ERROR} && ($start = index($self->{RAW}, "{\&")) >= 0 && ($ml > 0))
    {
        $ml--;
        my ($contents) = "";
        $end = index($self->{RAW}, "\&}");
        if ($end > $start)
        {
            my ($substr) = substr($self->{RAW}, $start + 2, $end - $start - 2);
            $substr =~ s/\x0d//g;
            my (@ops) = split(/\x0a/, $substr);
            my ($cell, $reval);
            $reval = "\$output = \"\";\n";

            foreach $cell (@ops)
            {
                $cell =~ s/^[\x09\ ]+//g;
                $cell =~ s/^print\ /\$output\ \.\=\ /;
                if ($cell)
                {
                    $reval .= $cell . "\n";
                }
            }

            my ($output);

            $reval .= "\$output;\n";

            my ($compartment) = new Safe("Tempo");

            $Tempo::self     = $self;
            $Tempo::document = $self;
            $Tempo::argument = $self->{ARGUMENT};
            $Tempo::session  = $self->{SESSION};

            if ($ENV{_SURVEY_DISABLE_SAFE} eq 1)
            {
                $compartment->deny_only(qw(:dangerous));
            }
            else
            {
                $compartment->permit(qw(time localtime crypt :browse));
            }
            $output = $compartment->reval($reval);
            if ($@)
            {
                $self->{ERROR}     = lprint("Security exception: " . $@);
                $self->{ERRORCODE} = 99;
            }

            my ($contents) = $output;
            $contents = substr($self->{RAW}, 0, $start) . $contents;
            $contents .= substr($self->{RAW}, $end + 2);
            $self->{RAW} = $contents;

        }
        else
        {
            $self->{ERROR}     = lprint("Found \"{\&\" without \"\&}\"");
            $self->{ERRORCODE} = 99;
        }
    }
    1;
}

sub PreParse
{
    my ($self) = shift;

    my ($start) = -1;
    my ($end)   = 0;

    my ($ml) = $self->{MAXLOOP};

    while (!$self->{ERROR} && ($start = index($self->{RAW}, "{\@")) >= 0 && ($ml > 0))
    {
        $ml--;
        my ($contents) = "";
        $end = index($self->{RAW}, "\@}");
        if ($end > $start)
        {
            my ($substr) = substr($self->{RAW}, $start + 2, $end - $start - 2);
            if (!-e $substr)
            {
                my ($path, $file) = $self->{FILE} =~ m/(.*)\/(.*)/;
                my ($delim) = "/";
                if (!$ENV{"_SURVEY_SENSIBLE"}) { $delim = "\\"; }

                $file = $path . $delim . $substr;
                if (-e $file)
                {
                    $substr = $file;
                }
            }

            if (!-r $substr)
            {
                $self->{ERROR}     = lprint("Could not open") . " $substr " . lprint("for reading");
                $self->{ERRORCODE} = 99;
            }
            else
            {
                open(FIL, $substr) || die;
                $contents = "";
                $contents = join(' ', <FIL>);
                close(FIL);

                #print "+$contents+\n";

                $contents = substr($self->{RAW}, 0, $start) . $contents;
                $contents .= substr($self->{RAW}, $end + 2);

                $self->{RAW} = $contents;
            }

            #print "$start $end $substr $contents\n";
        }
        else
        {
            $self->{ERROR}     = lprint("Found \"{\@\" without \"\@}\"");
            $self->{ERRORCODE} = 99;
        }
    }
    1;
}

# Append files in multipage (JP/20020524)
sub AppendFiles
{
    my ($self) = shift;
    my ($part, $doc, $i, $n, $type, $param, $els, $tn, $s);

    my (@parts) = @{ $self->{OPTION_SEQUENCE} };

    $self->{APPENDEDFILES} = "1";

    $self->{DEBUG}->AddDebugMsg("DOCUMENT", "In appendfiles (" . scalar(@parts) . " lines)");

    foreach $part (@parts)
    {
        if ($part && (!$self->{ERROR}))
        {
            if (!-e $part)    # file does not exist. Try relative path instead of absolute
            {

                # In theory this stuff should require a check for windows
                # path delimiters. In indigoperl it does not though.
                #
                # There's no use in trying to understand it I guess, windows
                # being what it is.
                my ($rel, $path, $file);
                ($path, $file) = $self->{FILE} =~ m/(.*)\/(.*)/;
                $rel = $path . "/" . $part;
                if (-e $rel) { $part = $rel; }
            }

            if ($part eq $self->{FILE}) { next; }

            $doc = Survey::Document->new(0, $part, undef, $self->{SESSION});

            if ($doc->{ERROR})
            {
                $self->{ERROR}     = lprint("A part (") . $part . lprint(") produced an error (") . $doc->{ERROR} . ")";
                $self->{ERRORCODE} = 42;
            }
            else
            {
                for ($i = 0 ; $i < $doc->GetTagCount() ; $i++)
                {
                    $type = $doc->GetTagParam($i, "TYPE");

                    if (grep(/^$type$/,
                             ("TIMER",
                              "DATETIME",
                              "ENV",
                              "GEO",
                              "CALCULATED",
                              "CONSTANT",
                              "CUSTOM",
                              "LICKERT",
                              "BOOLEAN",
                              "TEXT",
                              "MEMO",
                              "CATI",
                              "CHOICE",
                              "LIST",
                              "MATRIX",
                              "IMPORT"
                               )))
                    {
                        $tn = "TAG" . $self->{NUMTAGS} . "_";
                        foreach $param (@{ $self->{ "ALL_" . $type } })
                        {
                            $self->SetTagParam($self->{NUMTAGS}, $param, $doc->GetTagParam($i, $param));
                            $self->{DEBUG}->AddDebugMsg("DOCUMENT", "NUMTAGS: " . $self->{NUMTAGS});
                            $self->{DEBUG}->AddDebugMsg("DOCUMENT", "param: " . $param);
                            $self->{DEBUG}->AddDebugMsg("DOCUMENT", "value: " . $doc->GetTagParam($i, $param));
                        }
                        if ($type eq "CHOICE")
                        {
                            $els = $doc->GetTagParam($i, "ELEMENTS");
                            for ($n = 0 ; $n < $els ; $n++)
                            {
                                $s = $tn . "CE" . $n . "_";
                                $self->{ $s . "VALUE" }   = $doc->GetChoiceElementParam($i, $n, "VALUE");
                                $self->{ $s . "CAPTION" } = $doc->GetChoiceElementParam($i, $n, "CAPTION");
                                $self->{ $s . "CHECKED" } = $doc->GetChoiceElementParam($i, $n, "CHECKED");
                            }
                        }
                        if ($type eq "LIST")
                        {
                            $els = $doc->GetTagParam($i, "ELEMENTS");
                            for ($n = 0 ; $n < $els ; $n++)
                            {
                                $s = $tn . "LE" . $n . "_";
                                $self->{ $s . "VALUE" }    = $doc->GetListElementParam($i, $n, "VALUE");
                                $self->{ $s . "CAPTION" }  = $doc->GetListElementParam($i, $n, "CAPTION");
                                $self->{ $s . "SELECTED" } = $doc->GetListElementParam($i, $n, "SELECTED");
                            }
                        }
                        if ($type eq "MATRIX")
                        {

                            #BugAnt -patch- new matrix stuff
                            #Modified by JP to add my()

                            my ($col_els) = $doc->GetTagParam($i, "COLS");
                            for ($n = 1 ; $n <= $col_els ; $n++)
                            {
                                $s = $tn . "MC" . $n . "_";
                                $self->{ $s . "CAPTION" } = $doc->GetMatrixColumnParam($i, $n, "CAPTION");
                                $self->{ $s . "VALUE" }   = $doc->GetMatrixColumnParam($i, $n, "VALUE");
                                $self->{ $s . "TYPE" }    = $doc->GetMatrixColumnParam($i, $n, "TYPE");
                            }
                            my ($row_els) = $doc->GetTagParam($i, "ROWS");
                            for ($n = 1 ; $n <= $row_els ; $n++)
                            {
                                $s = $tn . "MR" . $n . "_";
                                $self->{ $s . "CAPTION" } = $doc->GetMatrixRowParam($i, $n, "CAPTION");
                                $self->{ $s . "VALUE" }   = $doc->GetMatrixRowParam($i, $n, "VALUE");
                                $self->{ $s . "TYPE" }    = $doc->GetMatrixRowParam($i, $n, "TYPE");
                            }
                        }
                        $self->{NUMTAGS}++;
                    }
                }
            }
        }
    }

    my ($names) = {};

    for (my ($t) = 0 ; $t < $self->{NUMTAGS} ; $t++)
    {
        my ($name) = $self->GetTagParam($t, "NAME");
        if ($name)
        {
            if ($names->{$name})
            {
                $self->{ERROR} =
                    lprint("The variable name '") 
                  . $name
                  . lprint("' has been defined more than once in the survey chain.");
                $self->{ERRORCODE} = 99;
            }
            else
            {
                $names->{$name} = $name;
            }
        }
    }

    1;
}

#modified by P. Sweatman to add MULTICHOICE tag info Nov 01
sub ParamsFill
{
    my ($self) = shift;

    @{ $self->{"ALLOWED_SURVEY"} } = ("TITLE",
                                      "DESCRIPTION",
                                      "KEYWORDS",
                                      "ASCIIFILE",
                                      "DELIMITER",
                                      "DOSBR",
                                      "STYLESHEET",
                                      "THEME",
                                      "BACKGROUND",
                                      "BGCOLOR",
                                      "TEXTCOLOR",
                                      "LINKCOLOR",
                                      "VLINKCOLOR",
                                      "CAPTWIDTH",
                                      "CONTINUE",
                                      "REDIRECT",
                                      "SUBMITTEXT",
                                      "CLEARTEXT",
                                      "SAVETEXT",
                                      "DBITABLE",
                                      "DBIDSN",
                                      "DBIUSER",
                                      "DBIPASSWD",
                                      "AUTONEWLINES",
                                      "PROGRES",
                                      "SHOWCLEAR",
                                      "SHOWSAVE",
                                      "RANDOM",
                                      "SUBSET",
                                      "NOTDISPLAYEDVAL",
                                      "CHECKKEY",
                                      "MOBILEOVERRIDE",
                                      "PERSIST",
                                      "PERSISTTEXT",
                                      "RETRIVETEXT",
                                      "LANGUAGE",
                                      "ACCESSJS",
                                      "ACCESSFUN");

    @{ $self->{"DEPRECATED_SURVEY"} } = ("ALLOWDATA",
                                         "ALLOWFLUSH",
                                         "ALLOWSOURCE",
                                         "ALLOWDEBUG",
                                         "SAVETEXT",
                                         "SHOWSAVE",
                                         "REQAUTH",
                                         "ADMINUSER",
                                         "PASSWORD",
                                         "UNIQUE");

    @{ $self->{"ALL_SURVEY"} } = (@{ $self->{"ALLOWED_SURVEY"} },
                                  @{ $self->{"DEPRECATED_SURVEY"} },
                                  "MULTIPAGE", "LASTPAGE", "SEQUENCEFILE", "SYSTEMSS", "ISAUTO");

    $self->{"SURVEY_TITLE"}       = "";
    $self->{"SURVEY_DESCRIPTION"} = "";
    $self->{"SURVEY_KEYWORDS"}    = "";
    $self->{"SURVEY_ASCIIFILE"}   = "";
    $self->{"SURVEY_DELIMITER"}   = "\;";
    $self->{"SURVEY_DOSBR"}       = "no";
    $self->{"SURVEY_STYLESHEET"}  = "";
    $self->{"SURVEY_THEME"}       = "cloud";
    $self->{"SURVEY_BACKGROUND"}  = "";
    $self->{"SURVEY_BGCOLOR"}     = "#FFFFFF";
    $self->{"SURVEY_TEXTCOLOR"}   = "#000000";
    $self->{"SURVEY_LINKCOLOR"}   = "#0044FF";
    $self->{"SURVEY_VLINKCOLOR"}  = "#0044FF";
    $self->{"SURVEY_CAPTWIDTH"}   = "300";
    $self->{"SURVEY_CONTINUE"}    = "";

    # added by Joshua Gramlich (jggramlich@yahoo.com) on 4 January 2002
    # modified with default value by me 2002-01-05
    $self->{"SURVEY_REDIRECT"} = "no";

    # end added by Joshua Gramlich
    $self->{"SURVEY_SUBMITTEXT"} = "Submit";
    $self->{"SURVEY_CLEARTEXT"}  = "Clear";

    # added in CRU patch (MJ/20020726)
    $self->{"SURVEY_SAVETEXT"} = "Save";
    $self->{"SURVEY_PASSWORD"} = "";

    #auth additions
    $self->{"SURVEY_REQAUTH"}   = "no";
    $self->{"SURVEY_UNIQUE"}    = "no";
    $self->{"SURVEY_ADMINUSER"} = "";

    #end auth additions
    $self->{"SURVEY_DBITABLE"}     = "";
    $self->{"SURVEY_DBIDSN"}       = "";
    $self->{"SURVEY_DBIUSER"}      = "";
    $self->{"SURVEY_DBIPASSWD"}    = "";
    $self->{"SURVEY_AUTONEWLINES"} = "0";
    $self->{"SURVEY_ALLOWSOURCE"}  = "yes";
    $self->{"SURVEY_ALLOWDATA"}    = "yes";
    $self->{"SURVEY_ALLOWDEBUG"}   = "yes";
    $self->{"SURVEY_ALLOWSTATS"}   = "yes";
    $self->{"SURVEY_ALLOWFLUSH"}   = "yes";
    $self->{"SURVEY_ALLOWCACHE"}   = "no";

    # 270402 MH Added rudimentary multipage support
    $self->{"SURVEY_MULTIPAGE"} = "";
    $self->{"SURVEY_LASTPAGE"}  = "";

    # Sequence files for multipages (JP/20020524)
    $self->{"SURVEY_SEQUENCEFILE"} = "";

    # Show progres in title when multipage
    $self->{"SURVEY_PROGRES"} = "no";

    # 200502 MH Added option not to show 'Clear' button
    $self->{"SURVEY_SHOWCLEAR"}       = "yes";
    $self->{"SURVEY_SHOWSAVE"}        = "no";
    $self->{"SURVEY_RANDOM"}          = "no";
    $self->{"SURVEY_SUBSET"}          = "0";
    $self->{"SURVEY_NOTDISPLAYEDVAL"} = "999";
    $self->{"SURVEY_CHECKKEY"}        = "yes";
    $self->{"SURVEY_ISAUTO"}          = "0";
    $self->{"SURVEY_SYSTEMSS"}        = "";
    $self->{"SURVEY_PERSIST"}         = "no";
    $self->{"SURVEY_PERSISTTEXT"}     = "Complete later";
    $self->{"SURVEY_RETRIVETEXT"}     = "Finish your pre-answered survey";
    $self->{"SURVEY_LANGUAGE"}        = "";
    $self->{"SURVEY_ACCESSJS"}        = "";
    $self->{"SURVEY_ACCESSFUN"}       = "";

    $self->{"SURVEY_MOBILEOVERRIDE"}  = "yes";

    Survey::Component::Env->FillParams($self);
    Survey::Component::Geo->FillParams($self);
    Survey::Component::Constant->FillParams($self);
    Survey::Component::Calculated->FillParams($self);
    Survey::Component::Lickert->FillParams($self);
    Survey::Component::Choice->FillParams($self);
    Survey::Component::List->FillParams($self);
    Survey::Component::Matrix->FillParams($self);
    Survey::Component::Boolean->FillParams($self);
    Survey::Component::Text->FillParams($self);
    Survey::Component::Memo->FillParams($self);
    Survey::Component::Newline->FillParams($self);
    Survey::Component::Custom->FillParams($self);
    Survey::Component::Comment->FillParams($self);
    Survey::Component::Ifroute->FillParams($self);
    Survey::Component::Caseroute->FillParams($self);
    Survey::Component::Route->FillParams($self);
    Survey::Component::Randomroute->FillParams($self);
    Survey::Component::Sequence->FillParams($self);
    Survey::Component::Timer->FillParams($self);
    Survey::Component::DateTime->FillParams($self);

    Survey::Component::Security->FillParams($self);
    Survey::Component::Cati->FillParams($self);
    Survey::Component::MailCopy->FillParams($self);
    Survey::Component::Submit->FillParams($self);
    Survey::Component::SubmitError->FillParams($self);

    if ($ENV{"_SURVEY_USEDBI"})
    {
        Survey::Component::Import->FillParams($self);
    }

    Survey::Component::Env->FillDefaults($self);
    Survey::Component::Geo->FillDefaults($self);
    Survey::Component::Constant->FillDefaults($self);
    Survey::Component::Calculated->FillDefaults($self);
    Survey::Component::Lickert->FillDefaults($self);
    Survey::Component::Choice->FillDefaults($self);
    Survey::Component::List->FillDefaults($self);
    Survey::Component::Matrix->FillDefaults($self);
    Survey::Component::Boolean->FillDefaults($self);
    Survey::Component::Text->FillDefaults($self);
    Survey::Component::Memo->FillDefaults($self);
    Survey::Component::Newline->FillDefaults($self);
    Survey::Component::Custom->FillDefaults($self);
    Survey::Component::Comment->FillDefaults($self);
    Survey::Component::Ifroute->FillDefaults($self);
    Survey::Component::Caseroute->FillDefaults($self);
    Survey::Component::Randomroute->FillDefaults($self);
    Survey::Component::Route->FillDefaults($self);
    Survey::Component::Sequence->FillDefaults($self);
    Survey::Component::Timer->FillDefaults($self);
    Survey::Component::DateTime->FillDefaults($self);

    Survey::Component::Submit->FillDefaults($self);
    Survey::Component::SubmitError->FillDefaults($self);
    Survey::Component::Security->FillDefaults($self);
    Survey::Component::Cati->FillDefaults($self);
    Survey::Component::MailCopy->FillDefaults($self);

    if ($ENV{"_SURVEY_USEDBI"})
    {
        Survey::Component::Import->FillDefaults($self);
    }

    $self->{TRANSLATE}->{ENV}         = "Survey::Component::Env";
    $self->{TRANSLATE}->{GEO}         = "Survey::Component::Geo";
    $self->{TRANSLATE}->{CONSTANT}    = "Survey::Component::Constant";
    $self->{TRANSLATE}->{CALCULATED}  = "Survey::Component::Calculated";
    $self->{TRANSLATE}->{LICKERT}     = "Survey::Component::Lickert";
    $self->{TRANSLATE}->{CHOICE}      = "Survey::Component::Choice";
    $self->{TRANSLATE}->{LIST}        = "Survey::Component::List";
    $self->{TRANSLATE}->{MATRIX}      = "Survey::Component::Matrix";
    $self->{TRANSLATE}->{BOOLEAN}     = "Survey::Component::Boolean";
    $self->{TRANSLATE}->{TEXT}        = "Survey::Component::Text";
    $self->{TRANSLATE}->{MEMO}        = "Survey::Component::Memo";
    $self->{TRANSLATE}->{NEWLINE}     = "Survey::Component::Newline";
    $self->{TRANSLATE}->{CUSTOM}      = "Survey::Component::Custom";
    $self->{TRANSLATE}->{COMMENT}     = "Survey::Component::Comment";
    $self->{TRANSLATE}->{IFROUTE}     = "Survey::Component::Ifroute";
    $self->{TRANSLATE}->{CASEROUTE}   = "Survey::Component::Caseroute";
    $self->{TRANSLATE}->{ROUTE}       = "Survey::Component::Route";
    $self->{TRANSLATE}->{RANDOMROUTE} = "Survey::Component::Randomroute";
    $self->{TRANSLATE}->{SEQUENCE}    = "Survey::Component::Sequence";
    $self->{TRANSLATE}->{TIMER}       = "Survey::Component::Timer";
    $self->{TRANSLATE}->{DATETIME}    = "Survey::Component::DateTime";

    $self->{TRANSLATE}->{SUBMIT}      = "Survey::Component::Submit";
    $self->{TRANSLATE}->{SUBMITERROR} = "Survey::Component::SubmitError";
    $self->{TRANSLATE}->{SECURITY}    = "Survey::Component::Security";
    $self->{TRANSLATE}->{CATI}        = "Survey::Component::Cati";
    $self->{TRANSLATE}->{MAILCOPY}    = "Survey::Component::MailCopy";
    $self->{TRANSLATE}->{IMPORT}      = "Survey::Component::Import";

    1;
}

sub Translate
{
    my ($self, $tag) = @_;
    return $self->{TRANSLATE}->{$tag};
}

sub CheckVisited
{
    my ($self, $name) = @_;
    return $self->{SESSION}->getValue("VISITED_$name");
}

sub SetVisited
{
    my ($self, $name) = @_;
    $self->{SESSION}->setValue("VISITED_$name", "1");
    1;
}

sub GetTagNo
{
    my ($self, $name) = @_;

    my ($max)   = $self->GetTagCount();
    my ($tagno) = -1;
    my ($i, $tn, $type, $mn);

    for ($i = 0 ; $i < $max ; $i++)
    {
        $type = $self->GetTagParam($i, "TYPE");
        $tn   = $self->GetTagParam($i, "NAME");

        if ($tn)
        {
            if ($type ne "MATRIX")
            {
                if ($tn eq $name)
                {
                    $tagno = $i;
                }
            }
            else
            {
                $mn = substr($name, 0, length($name) - 2);
                if ($mn eq $tn)
                {
                    $tagno = $1;
                }
            }
        }
    }
    return $tagno;
}

sub GetOption
{
    my ($self, $cfg) = @_;
    if (defined($self->{ "OPTION_" . $cfg }))
    {
        return $self->{ "OPTION_" . $cfg };
    }
    else
    {
        return "";
    }
}

sub SetOption
{
    my ($self, $cfg, $value) = @_;
    $self->{ "OPTION_" . $cfg } = $value;
    1;
}

sub GetTagParam
{
    my ($self, $tagno, $param) = @_;
    my ($tp) = "TAG" . $tagno . "_" . $param;
    if (defined($self->{$tp}))
    {
        return $self->{$tp};
    }
    else
    {
        return "";
    }
}

sub SetTagParam
{
    my ($self, $tagno, $param, $value) = @_;
    my ($tp) = "TAG" . $tagno . "_" . $param;

    $self->{$tp} = $value;
    1;
}

sub SetTagValue
{
    my ($self, $tagno, $value) = @_;
    my ($tp) = "TAG" . $tagno . "_VALUE";
    $self->{$tp} = $value;
    1;
}

sub GetImportFilter
{
    my ($self, $tagno, $fno, $param) = @_;
    my ($tp) = "TAG" . $tagno . "_FIL" . $fno . "_" . $param;

    if (defined($self->{$tp}))
    {
        return $self->{$tp};
    }
    else
    {
        return "";
    }
}

sub GetChoiceElementParam
{
    my ($self, $tagno, $ceno, $param) = @_;
    my ($tp) = "TAG" . $tagno . "_CE" . $ceno . "_" . $param;
    if (defined($self->{$tp}))
    {
        return $self->{$tp};
    }
    else
    {
        return "";
    }
}

sub GetListElementParam
{
    my ($self, $tagno, $leno, $param) = @_;
    my ($tp) = "TAG" . $tagno . "_LE" . $leno . "_" . $param;
    if (defined($self->{$tp}))
    {
        return $self->{$tp};
    }
    else
    {
        return "";
    }
}

sub GetCaseParam
{
    my ($self, $tagno, $ifno, $param) = @_;
    my ($tp) = "TAG" . $tagno . "_CASE" . $ifno . "_" . $param;
    if (defined($self->{$tp}))
    {
        return $self->{$tp};
    }
    else
    {
        return "";
    }
}

sub GetAlternativeParam
{
    my ($self, $tagno, $ifno, $param) = @_;
    my ($tp) = "TAG" . $tagno . "_ALTERNATIVE" . $ifno . "_" . $param;
    if (defined($self->{$tp}))
    {
        return $self->{$tp};
    }
    else
    {
        return "";
    }
}

sub GetIfParam
{
    my ($self, $tagno, $ifno, $param) = @_;
    my ($tp) = "TAG" . $tagno . "_IF" . $ifno . "_" . $param;
    if (defined($self->{$tp}))
    {
        return $self->{$tp};
    }
    else
    {
        return "";
    }
}

sub GetIfOperatorParam
{
    my ($self, $tagno, $ifno, $opno, $param) = @_;
    my ($tp) = "TAG" . $tagno . "_IF" . $ifno . "_SUB" . $opno . "_" . $param;
    if (defined($self->{$tp}))
    {
        return $self->{$tp};
    }
    else
    {
        return "";
    }
}

sub GetMatrixRowParam
{
    my ($self, $tagno, $leno, $param) = @_;
    my ($tp) = "TAG" . $tagno . "_MR" . $leno . "_" . $param;
    if (defined($self->{$tp}))
    {
        return $self->{$tp};
    }
    else
    {
        return "";
    }
}

sub GetMatrixColumnParam
{
    my ($self, $tagno, $leno, $param) = @_;
    my ($tp) = "TAG" . $tagno . "_MC" . $leno . "_" . $param;

    if (defined($self->{$tp}))
    {
        return $self->{$tp};
    }
    else
    {
        return "";
    }
}

sub GetMatrixElementParam
{
    die "GetMatrixElementParam() is deprecated, use *RowParam or *ColumnParam instead";
    my ($self, $tagno, $leno, $param) = @_;
    my ($tp) = "TAG" . $tagno . "_ME" . $leno . "_" . $param;
    if (defined($self->{$tp}))
    {
        return $self->{$tp};
    }
    else
    {
        return "";
    }
}

sub GetTagCount
{
    my ($self) = shift;
    return $self->{NUMTAGS};
}

# checks the "NAME"-parameter of a tag
# returns 1 if the name is ok, otherwise sets $self->{ERROR}
sub CheckName
{
    my $self = shift;
    my $name = shift;
    my $comp = shift;

    $_ = $name;

    # name starts with a number
    if (/^[0-9]/)
    {
        $self->{ERROR} =
          lprint("A ") . $comp . " " . lprint("name cannot start with a number") . " (\"" . $name . "\")";
        $self->{ERRORCODE} = 26;
    }

    # illegal characters
    if (/[\-\+\.\,\!\(\)\=\/\\\@\{\}\[\]\%\&\#\?\'\"\^\~\*\<\>\|\;\:]/)
    {
        $self->{ERROR} =
          lprint("A ") . $comp . " " . lprint("name") . " (\"" . $name . "\") " . lprint("contains illegal characters");
        $self->{ERRORCODE} = 27;
    }

    if ((!$self->{ERROR}) && (!$self->GetOption("ISLOCAL")))
    {
        $self->{DEBUG}->AddDebugMsg("DOCUMENT", $name . ":" . $self->{ARGUMENT}->{ "TAGNAME_" . $name });

        if ($self->{ARGUMENT}->{ "TAGNAME_" . $name })
        {
            $self->{ERROR} =
              lprint("The name") . " \"" . $name . "\" " . lprint("was defined earlier in the multipart sequence");
            $self->{ERRORCODE} = 43;
        }
    }

    1;
}

# performs a check if the parameter of an element is valid
# return 1 if so, otherwise sets $self->{ERROR}
sub CheckParam
{
    my $self  = shift;
    my $param = shift;    # the parameter
    my $comp  = shift;    # the element (for example CHOICE)

    if ((!$self->{ERROR}) && ($param ne "empty") && ($param ne ""))
    {

        # if the parameter is not defined
        if (!grep(/^$param$/, @{ $self->{ "ALLOWED_" . $comp } }))
        {
            $self->{ERROR}     = $param . " " . lprint("is not a valid parameter in a ") . $comp . " " . lprint("tag");
            $self->{ERRORCODE} = 30;
        }

        if ($self->{ "DEPRECATED_" . $comp })
        {
            if (grep(/^$param$/, @{ $self->{ "DEPRECATED_" . $comp } }))
            {
                $self->{ERROR} =
                  $param . " " . lprint("has been deprecated in the") . " " . $comp . " " . lprint("tag");
                $self->{ERRORCODE} = 99;
            }
        }
    }

    1;
}

# return all possible parameters of a tag (???)
sub GetDefaults
{
    my $self = shift;
    my $type = shift;

    my %params;

    foreach my $cell (@{ $self->{ "ALL_" . $type } })
    {

        if (defined($self->{ $type . "_" . $cell }))
        {
            $params{$cell} = $self->{ $type . "_" . $cell };

            #      print $type . "_" . $cell . " = " . $self->{$type . "_" . $cell} . "\n";
        }
    }

    return %params;
}

sub PlaceSurvey
{
    my ($self, $paramstr) = @_;

    my (%params, $cell, $name, $value, @pararr);

    %params = $self->GetDefaults("SURVEY");

    @pararr = @{$paramstr};
    foreach $cell (@pararr)
    {
        ($name, $value) = split(/=/, $cell, 2);
        $params{$name} = $value;
        $self->CheckParam($name, "SURVEY");
    }

    if (!$params{TITLE})
    {
        $self->{ERROR}     = lprint("TITLE is a required parameter for survey tags (in ") . $self->{FILE} . ")";
        $self->{ERRORCODE} = 7;
    }

    if ((!$self->{ERROR}) && (!$ENV{"_SURVEY_USEDBI"}) && ($params{DBITABLE}))
    {
        $self->{ERROR}     = lprint("DBI is switched off");
        $self->{ERRORCODE} = 28;
    }

    if ((!$self->{ERROR}) && (!$params{"ASCIIFILE"}) && (!$params{"DBITABLE"}) && (!$self->{OPTION_ISLOCAL}))
    {

        if (!$ENV{"_SURVEY_ALLOWAUTO"})
        {
            $self->{ERROR}     = lprint("Both ASCIIFILE and DBITABLE unset for survey tag (in ") . $self->{FILE} . ")";
            $self->{ERRORCODE} = 8;
        }
        else
        {
            $params{"ISAUTO"}    = 1;
            $params{"ASCIIFILE"} = $self->GetOption("SYSBASE") . "AutoData.dat";
            $self->{DEBUG}->AddDebugMsg("DOCUMENT", "AUTOFILE is set to " . $params{"ASCIIFILE"});

            if (open(FIL, ">>" . $params{"ASCIIFILE"})) { close(FIL); }
            else
            {
                $self->{ERROR} =
                    lprint("Could not create autodata file (")
                  . $params{"ASCIIFILE"} . ") ("
                  . $self->GetOption("SYSBASE") . ")";
                $self->{ERRORCODE} = 29;
            }
        }
    }
    else { $params{"ISAUTO"} = 0; }

    if ((!$self->{ERROR}) && ($params{DBITABLE}) && (!$params{DBIDSN}))
    {
        $self->{ERROR}     = lprint("DBITABLE is set but DBIDSN is missing (in ") . $self->{FILE} . ")";
        $self->{ERRORCODE} = 9;
    }

    if ((!$self->{ERROR}) && ($params{empty} eq "yes"))
    {
        $self->{ERROR}     = lprint("A SURVEY tag cannot be immediately terminated (in ") . $self->{FILE} . ")";
        $self->{ERRORCODE} = 10;
    }

    if ((!$self->{ERROR}) && ($params{DBITABLE}) && (substr($params{DBIDSN}, 0, 4) ne "DBI:"))
    {
        $self->{ERROR}     = lprint("DBIDSN is malformed, must start with DBI: (in ") . $self->{FILE} . ")";
        $self->{ERRORCODE} = 22;
    }

    if (!$self->{ERROR})    # addition as consequence to gramlich redirect patch
    {
        if ((!$params{CONTINUE}) && ($params{REDIRECT} eq "yes"))
        {
            $self->{ERROR}     = lprint("Cannot have REDIRECT without CONTINUE");
            $self->{ERRORCODE} = 33;
        }
    }

    if ((!$self->{ERROR}) && ($params{SHOWSAVE} eq "yes"))    # Parameter checking for CRU patches
    {
        if (!$params{DBITABLE})
        {
            $self->{ERROR}     = lprint("Saving of partial answers requires DBI, but DBITABLE is not set");
            $self->{ERRORCODE} = 45;
        }
        if ($params{ALLOWCACHE} eq "yes")
        {
            $self->{ERROR}     = lprint("Saving of partial answers will not work if cache is enabled");
            $self->{ERRORCODE} = 46;
        }
    }

    if (!$self->{ERROR})    # 270402 MH Multipage support
    {
        if ($params{"MULTIPAGE"} xor $params{"LASTPAGE"})
        {
            $self->{ERROR}     = lprint("Cannot have MULTIPAGE without LASTPAGE");
            $self->{ERRORCODE} = 38;
        }
    }

    if ((!$self->{ERROR}) && $params{"MULTIPAGE"})    # Multipage saneness checking (JP/20020524)
    {
        if (   (int($params{"MULTIPAGE"}) < 1)
            || (int($params{"LASTPAGE"}) < 1)
            || (int($params{"LASTPAGE"}) < int($params{"MULTIPAGE"})))
        {
            $self->{ERROR}     = lprint("Bad values for MULTIPAGE sequence");
            $self->{ERRORCODE} = 39;
        }
    }

    # Sequence file checking (JP/20020524)
    if ((!$self->{ERROR}) && $params{"MULTIPAGE"} && ($params{"MULTIPAGE"} eq $params{"LASTPAGE"}))
    {
        if (!$params{"SEQUENCEFILE"})
        {
            $self->{ERROR} = lprint("SEQUENCEFILE is a required parameter in the last page of a multipage sequence");
            $self->{ERRORCODE} = 40;
        }
        if ((!$self->{ERROR}) && ((!(-e $params{"SEQUENCEFILE"})) || (!(-r $params{"SEQUENCEFILE"}))))
        {
            $self->{ERROR}     = lprint("SEQUENCEFILE does not exists or no read permissions");
            $self->{ERRORCODE} = 41;
        }
    }

    if (!$self->{ERROR})    # 20041201, language override
    {
        if ($params{"LANGUAGE"})
        {
            my ($sld)           = $ENV{"_SURVEY_LANG_DIRECTORY"};
            my ($sl)            = $params{"LANGUAGE"};
            my ($language_file) = "$sld/$sl.sl";
            my ($error)         = Survey::Language->setupLanguage($language_file);
            if ($error)
            {
                $self->{ERROR}     = lprint("Language override caused an error:") . " $error";
                $self->{ERRORCODE} = 99;
            }
            else
            {
                $ENV{"_INTERNAL_LANGUAGE_OVERRIDE"} = $language_file;
            }
        }
        else
        {
            $ENV{"_INTERNAL_LANGUAGE_OVERRIDE"} = "";
        }
    }

    my($isMobile) = Survey::Slask->isMobileOverride();
    if($isMobile)
    {
      if($params{"MOBILEOVERRIDE"} ne "no")
      {
        $params{"THEME"} = "mobile";
        $self->{SESSION}->setValue("themeoverride", "mobile");
      }
    }

    my ($arg) = $self->{ARGUMENT};
    my ($ta);
    if (defined($arg))
    {
      $ta = $arg->ArgByName("themeoverride");
      if (!defined($ta)) { $ta = $self->{SESSION}->getValue("themeoverride"); }

      if ($ta)
      {
        if (grep(/^$ta$/, ("cloud", "mobile", "eveca", "formal", "slate", "invert", "rose", "msu", "null")))
        {
          $params{"THEME"} = $ta;
          $self->{SESSION}->setValue("themeoverride", $ta);
        }
        else
        {
          $self->{ERROR}     = lprint("THEME") . " " . $ta . " " . lprint("does not exists");
          $self->{ERRORCODE} = 99;
        }
      }
      else
      {
        $self->{SESSION}->setValue("themeoverride", undef);
      }
    }

    #bugant 4 accesskey via js
    if (!$self->{ERROR}
        && (($params{"ACCESSJS"} && !($params{"ACCESSFUN"})) || ($params{"ACCESSFUN"} && !($params{"ACCESSJS"}))))
    {
        $self->{ERROR} =
          lprint("ACCESS property (ACCESSJS and ACCESSFUN) has to be used togheter (in ") . $self->{FILE} . ")";
        $self->{ERRORCODE} = 777;
    }

    # New theme handling (JP/20040613)
    if (!$self->{ERROR} && $params{"THEME"})
    {
        my ($ft) = 0;
        if ($params{"THEME"} eq "cloud")  { $params{"SYSTEMSS"} = "system/cloud.css";  $ft = 1; }
        if ($params{"THEME"} eq "mobile") { $params{"SYSTEMSS"} = "system/mobile.css";  $ft = 1; }
        if ($params{"THEME"} eq "formal") { $params{"SYSTEMSS"} = "system/formal.css"; $ft = 1; }
        if ($params{"THEME"} eq "slate")  { $params{"SYSTEMSS"} = "system/slate.css";  $ft = 1; }
        if ($params{"THEME"} eq "invert") { $params{"SYSTEMSS"} = "system/invert.css"; $ft = 1; }
        if ($params{"THEME"} eq "rose")   { $params{"SYSTEMSS"} = "system/rose.css";   $ft = 1; }
        if ($params{"THEME"} eq "msu")    { $params{"SYSTEMSS"} = "system/msu.css";    $ft = 1; }
        if ($params{"THEME"} eq "null")   { $params{"SYSTEMSS"} = "system/null.css";   $ft = 1; }
        if ($params{"THEME"} eq "cleanhtml") { $ft = 1; }
        if ($params{"THEME"} eq "external")  { $ft = 1; }

        if (!$ft)
        {
            $self->{ERROR}     = lprint("THEME") . " " . $params{"THEME"} . " " . lprint("does not exists");
            $self->{ERRORCODE} = 99;
        }
    }
    else
    {
        $params{"THEME"} = "cleanhtml";
    }

    foreach $cell (@{ $self->{"ALL_SURVEY"} })
    {
        $self->{ "OPTION_" . $cell } = $params{$cell};
    }

    if (!$self->{ERROR} && ($self->GetOption("REQAUTH") eq "yes"))
    {
        my ($ru) = $ENV{"REMOTE_USER"} || "";
        if (!$ru)
        {
            $self->{ERROR}     = lprint("This survey requires user authentication");
            $self->{ERRORCODE} = 36;
        }
    }

    # added in CRU patch (MJ/20020820)
    if (!$self->{ERROR} && ($self->GetOption("REQAUTH") eq "soap") && (!$self->GetOption("ISLOCAL")))
    {

        # added in CRU patch (MJ/20020820)
        if ($ENV{"_SURVEY_SOAP"} and $ENV{"_SURVEY_SOAP_WSDL"})
        {
            my %cookies = fetch CGI::Cookie;
            if (exists $cookies{ $ENV{"_SURVEY_COOKIE_NAME"} })
            {
                my ($val, $service, %fault, @ret);

                # Connect to the server hosting the description of the web services
                $service = SOAP::Lite->service($ENV{"_SURVEY_SOAP_WSDL"});
                $service->check_cookie($cookies{ $ENV{"_SURVEY_COOKIE_NAME"} }->value);
                if ($service->call->fault)
                {
                    %fault = %{ $service->call->fault };
                    foreach $val (keys %fault)
                    {
                        $self->{ERROR} .= "$fault{$val}\n";
                    }
                    $self->{ERRORCODE} = 48;
                }
                @ret = $service->call->result;

                # We get the email of the authenticated user
                $self->{EMAIL} = $ret[0];
            }
            else
            {
                if ($self->{ARGUMENT}->ArgByName("action") ne "soap")
                {
                    $self->{ERROR}     = lprint("Needs SOAP authentication");
                    $self->{ERRORCODE} = 49;
                }
                else
                {
                    my ($service, $val, $login, $passwd, %fault, @ret);
                    $login  = $self->{ARGUMENT}->ArgByName("login");
                    $passwd = $self->{ARGUMENT}->ArgByName("passwd");

                    # Connect to the server hosting the description of the web services
                    $service = SOAP::Lite->service($ENV{"_SURVEY_SOAP_WSDL"});
                    $service->do_login($ENV{'HTTP_HOST'}, $login, $passwd);
                    if ($service->call->fault)
                    {
                        %fault = %{ $service->call->fault };
                        foreach $val (keys %fault)
                        {
                            $self->{ERROR} .= "$fault{$val}\n";
                        }
                        $self->{ERRORCODE} = 48;
                    }
                    @ret = $service->call->result;
                    foreach $val (@ret)
                    {
                        my %cookies = parse CGI::Cookie($val);
                        print CGI::header(-cookie => $cookies{ $ENV{"_SURVEY_COOKIE_NAME"} });
                    }
                }
            }
        }
        else
        {
            $self->{ERROR}     = lprint("SOAP authentication is disabled");
            $self->{ERRORCODE} = 47;
        }
    }

    # added in CRU patch (MJ/20020820)

    1;
}

# saves parametes to a datastructure
# is called from a component module in sub PlaceComponent
# (for example from Component::Choice::PlaceComponent())
sub PlaceParams
{
    my ($self, $type, $tn, %params) = @_;

    # $type: what element, for example: CHOICE
    # $tn:   Prefix (for example: TAG0_)
    # %params: parameters (and other information) of the tag specified by $type

    foreach my $cell (@{ $self->{ "ALL_" . $type } })
    {
        $self->{ $tn . $cell } = $params{$cell};
    }

    1;
}

# expects a tag: <TEST VAL="KEY" ... > (or an empty tag)
# returns a list: the first element is "type" of the tag (like CHOICE),
# the second are the parameters of the tag (arrayref)
sub CleanUpTag
{
    my $self = shift;
    my $tag  = shift;

    # remove linebreaks
    $tag =~ s/[\x0a\x0d]/\ /g;

    my $isEmpty = (index($tag, "/>") > 0) ? "yes" : "no";

    #remove tabs
    $tag =~ s/\x09/\ /g;

    # replace several spaces with a single one
    $tag =~ s/\ +/\ /g;

    # remove opening tag brackets
    $tag =~ s/\<//g;

    # remove closing tag brackets
    $tag =~ s/\>//g;

    my (@parts);

    # get the name of the tag (for example CHOICE, LICKERT...)
    my ($type, $rest) = split(/\ /, $tag, 2);

    # if there is a "/>"
    if ($isEmpty eq "yes") { chop($rest); }

    # get parameters of the tag
    if ($rest)
    {
        @parts = quotewords(" ", 0, $rest);
        push(@parts, "empty=$isEmpty");
    }

    return ($type, \@parts);
}

sub CleanUpTagExpr
{
    my ($self, $tag) = @_;
    $tag = substr($tag, 1, length($tag) - 2);
    $tag =~ s/[\x0a\x0d]/\ /g;
    $tag =~ s/\x09/\ /g;
    $tag =~ s/\ +/\ /g;

    #$tag =~ s/\<//g;
    #$tag =~ s/\>//g;
    my (@parts, $isempty);
    my ($type, $rest) = split(/\ /, $tag, 2);

    if (index($_[1], "/>") > 0)
    {
        $isempty = "yes";
        chop($rest);
    }
    else
    {
        $isempty = "no";
    }

    if ($rest)
    {
        @parts = quotewords(" ", 0, $rest);
        push(@parts, "empty=$isempty");
    }

    return ($type, \@parts);
}

sub CutTag
{
    my $self = shift;
    my $s    = index($self->{WORK}, "<");
    my $e    = index($self->{WORK}, ">");

    # if there is an endig tag bracket
    if ($e != -1)
    {

        # if there's an opening tag bracket
        # adapt $e so $s and $e + 1 mark the begining and end
        # of the tag
        if ($s) { $e = $e - $s; }

        # get the tag
        my $ret = substr($self->{WORK}, $s, $e + 1);

        # if the opening tag is not at position 0
        if ($s)
        {

            # seems like this construct removing leading whitespace ???
            $self->{WORK} = substr($self->{WORK}, 0 - length($self->{WORK}) + $s);
        }

        # ???
        $self->{WORK} = substr($self->{WORK}, 0 - length($self->{WORK}) + length($ret));

        return $ret;
    }
    else
    {
        return 0;
    }
}

sub MakeSurveyTagXML
{
    my ($self) = shift;
    my ($out)  = "<SURVEY ";

    my (@allowed) = @{ $self->{"ALLOWED_SURVEY"} };
    my ($par);

    foreach $par (@allowed)
    {
        my ($default) = $self->{ "SURVEY_" . $par };
        my ($value)   = $self->GetOption("$par");
        if ($value ne $default)
        {
            $out .= "$par=\"" . $value . "\" ";
        }
    }

    $out .= " >\n\n";

    return $out;

}

sub MakeXML
{
    my ($self) = shift;
    my ($i, $out, $type, $tr);

    $out = $self->MakeSurveyTagXML();

    for ($i = 0 ; $i < $self->GetTagCount() ; $i++)
    {
        $type = $self->GetTagParam($i, "TYPE");

        my ($tr) = $self->Translate($type);
        if ($tr)
        {
            my ($xml);
            my ($call) = "\$xml = " . $tr . "->MakeXML(\$self,\$i);";
            eval($call);
            if ($@)
            {
                $xml = "[" . $@ . "]";
            }

            $out .= $xml;
        }
    }

    $out .= "</SURVEY>\n";

    return $out;
}

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

# finds the first occurrence of an element and
# returns its tag number if it is found, otherwise -1
sub FindFirst
{
    my $self   = shift;
    my $ToFind = shift;

    # iterate over all elements
    for (my $i = 0 ; $i < $self->GetTagCount() ; $i++)
    {
        my $type = $self->GetTagParam($i, "TYPE");

        # if the element is found
        if ($type eq $ToFind) { return $i; }
    }
    return -1;
}

#modified by P. Sweatman to handle MULTICHOICE tag Nov01
#wherever CHOICE shows up, an additional statement is added to additionally
#display MULTICHOICE
sub PrintErrorDescription
{
    my $self = shift;

    my ($e)     = $self->{ERRORCODE};
    my ($found) = 0;

    my ($lb) = "<b>\&lt\;";
    my ($rb) = "\&gt\;</b>";

    print "    <br /><br />\n    ";

    if ($e)
    {
        if ($e eq 1)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 1, FILE DOES NOT EXIST") . "]</i></b> ";
            print lprint("This error occurs if the referenced survey file does not exist. ");
            print lprint(
"The most common cause of this is that the user has simply misspelled the address in the browser\'s address field. ");
            print lprint(
"To solve this problem, check that the the address has been correctly spelled and that the survey file is where you think it should be."
            );
            $found = 1;
        }
        if ($e eq 2)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 2, PERMISSION DENIED") . "]</i></b> ";
            print lprint(
"The referenced survey exists in the correct place, but the web user does not have permission to read it. ");
            print lprint("To solve this you will have to <b>chmod</b> the file to grant sufficient privilegies. ");
            print lprint(
                  "Information on how to use <b>chmod</b> can be found by typing <b>man chmod</b> on a shell prompt. ");
            print lprint("For quick and dirty sollution, simply write <b>chmod 755 </b>") 
              . $lb
              . lprint("filename")
              . $rb;
            print " (" . lprint("or whatever your survey file is called") . ").";
            $found = 1;
        }
        if ($e eq 3)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 3, UNABLE TO OPEN FILE FOR READING") . "]</i></b> ";
            print lprint("This is one of them errors that should never happen. ");
            print lprint("The program could for some unknown reason not open the survey file for reading. ");
            print lprint(
                "If it had been a permission problem, error 2 should have occured, so it is probably something else. ");
            print lprint("A good start would be to see if you can access the file from a shell prompt.");
            $found = 1;
        }
        if ($e eq 4)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 4, DOES NOT CONTAIN SURVEY TAG") . "]</i></b> ";
            print lprint(
"To denote that the file indeed is a survey file, it has to contain a <b>SURVEY</b> tag, something that looks a bit like "
            );
            print $lb
              . lprint("SURVEY TITLE=\"My First Survey\" ... ")
              . $rb . ". "
              . lprint("If the document does not contain ");
            print $lb . "SURVEY.." . $rb . ", " . lprint("the parser assumes that the document is not a survey file. ");
            print lprint("Please note that everything before the <b>SURVEY</b> tag will be ignored.");
            $found = 1;
        }
        if ($e eq 5)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 5, NO TERMINATION OF SURVEY TAG") . "]</i></b> ";
            print lprint(
"The document has to contain a termination of the survey tag, or in other words something that looks like ");
            print $lb . "/SURVEY" . $rb . ". " . lprint("This in order to know where to stop parsing the file. ");
            print lprint("Text after the termination of the survey tag will be ignored.");
            $found = 1;
        }
        if ($e eq 6)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 6, IS NOT A VALID TAG") . "]</i></b> ";
            print lprint("The document contains a tag that the parser does not know how to handle. ");
            print lprint("Valid tags in the survey part of the document are ");
            print "<b>LICKERT</b>, <b>CHOICE</b>, <b>LIST</b>, <b>BOOLEAN</b>, <b>TEXT</b>, <b>MEMO</b>, ";
            print "<b>NEWLINE</b>, <b>CUSTOM</b> " . lprint("and") . " <b>COMMENT</b>. ";
            print lprint("Please note that case is important : Survey and SURVEY is not the same thing. ");
            print lprint(
"If you want to use other tags than these, as an example to add custom HTML code, then you have to place those tags in a "
            );
            print $lb . "CUSTOM" . $rb . $lb . "/CUSTOM" . $rb . lprint(" block. ");
            $found = 1;
        }
        if ($e eq 7)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 7, TITLE IS REQUIRED") . "]</i></b> ";
            print lprint(
                  "The document\'s survey tag does not contain the TITLE parameter, or the TITLE parameter is empty. ");
            print lprint("The TITLE parameter must be set in order to produce an output that makes sense. ");
            print lprint(
"Please note that all parameters are written in upper case : Title and TITLE is not interpreted in the same way. ");
            $found = 1;
        }
        if ($e eq 8)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 8, BOTH ASCIIFILE AND DBITABLE UNSET") . "]</i></b> ";
            print lprint(
                  "In order to know how to save submitted data, the survey script needs one of these parameters set. ");
            print lprint(
"If you want to save your data to a \'flat file\', or in other words an asciifile with delimited fields, set ASCIIFILE to the filename where you want to save the data. "
            );
            print lprint(
                  "If you want to save the data in a database table, set DBITABLE to the name of the database table. ");
            print lprint("If you set DBITABLE, you will also have to set DBIDSN. ");
            print lprint(
"Please note that all parameters are written in upper case : AsciiFile and ASCIIFILE is not the same thing. ");
            print lprint(
"Please note further that if the global configuration option _SURVEY_ALLOWAUTO is switched on, the system will suppose an automatic ASCIIFILE and will not display this error message."
            );
            $found = 1;
        }
        if ($e eq 9)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 9, DBIDSN MISSING") . "]</i></b> ";
            print lprint(
"When DBITABLE is set, the script must know how to connect to the database containing that table. In order to know this, the script must be supplied with a DSN string, something that is a bit like an address to the database."
            ) . " ";
            print lprint("A typical string for connecting to a MySQL database via DBI would look a bit something like");
            print " <b>\"DBI:mysql:mydatabase\"</b>. " . lprint("Please note that DBIDSN must be written uppercase.");
            $found = 1;
        }
        if ($e eq 10)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 10, TAG CANNOT BE IMMEDIATELY TERMINATED") . "]</i></b> ";
            print lprint("Tags can either be empty or contain data. ");
            print lprint("In the survey context there are tags that are required to have data. ");
            print lprint("These are ") . "<b>SURVEY</b>, <b>CHOICE</b>, <b>LIST</b>, <b>MEMO</b>, <b>CUSTOM</b> ";
            print lprint("and")
              . " <b>COMMENT</b>. "
              . lprint("Tags of this kind cannot be terminated in the start tag. ");
            print lprint("As an example the <b>SURVEY</b> tag has to be in the form ");
            print $lb . "SURVEY" . $rb . $lb . "/SURVEY" . $rb . lprint(" and cannot be in the form ") . $lb;
            print "SURVEY/" . $rb . " (" . lprint("which denotes immediate termination") . "). ";
            print lprint("Please refer to the DTD or the documentation for the correct syntax of the tags. ");
            print lprint(
"The above said does not apply to data inside a <b>CUSTOM</b> block, as that data follows (or should follow) the html-strict DTD."
            );
            $found = 1;
        }
        if ($e eq 11)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 11, TAG MUST BE TERMINATED IMMEDIATELY") . "]</i></b> ";
            print lprint("Tags can either be empty or contain data. ");
            print lprint(
"In the survey context there are tags that are required to be immediately terminated, or in other words to be empty. ");
            print lprint("These tags are ")
              . "<b>LICKERT</b>, <b>BOOLEAN</b>, <b>TEXT</b> "
              . lprint("and")
              . " <b>NEWLINE</b>. ";
            print lprint("Further, in the") . " <b>LIST</b> " . lprint("and") . " <b>CHOICE</b> " . lprint("blocks");
            print ", <b>LISTELEMENT</b> "
              . lprint("and")
              . "<b>CHOICEELEMENT</b> "
              . lprint("must be terminated immediately. ");
            print lprint("A tag is marked as immediately terminated when it ends with a") . " \"/\". ";
            print lprint("As an example, a valid <b>NEWLINE</b> tag might look like this : ");
            print $lb . "NEWLINE COUNT=\"5\" /" . $rb;
            $found = 1;
        }
        if ($e eq 12)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 12, TAG MUST HAVE A NAME") . "]</i></b> ";
            print lprint(
'All tags that are elements of the survey must be given names. A name can be any ASCII character except "0" (zero). ');
            print lprint("A valid <b>MEMO</b> tag might look like this : ") 
              . $lb
              . "MEMO NAME=\"comments\""
              . $rb . "<b>"
              . lprint("Insert comments") . "</b>";
            print $lb . "/MEMO" . $rb . ". " . lprint("Please note that NAME is written upper case.");
            $found = 1;
        }
        if ($e eq 13)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 13, CHOICE TAG MUST HAVE CHOICEELEMENTS") . "]</i></b> ";
            print lprint(
"A <b>CHOICE</b> tag consists of choices. At least one choice must be given to create a valid <b>CHOICE</b> tag. ");
            print lprint(
"Choices are given in the form of <b>CHOICEELEMENTS</b>. A valid <b>CHOICE</b> block might look like this"
            ) . " :<br /><br />";
            print $lb
              . "CHOICE NAME=\""
              . lprint("query")
              . "\" CAPTION=\""
              . lprint("You like this ?") . "\""
              . $rb
              . "<br />";
            print $lb
              . "CHOICEELEMENT CAPTION=\""
              . lprint("YES")
              . "\" VALUE=\"1\" CHECKED=\"yes\" /"
              . $rb
              . "<br />";
            print $lb . "CHOICEELEMENT CAPTION=\"" . lprint("NO") . "\" VALUE=\"0\" /" . $rb . "<br />";
            print $lb . "CHOICEELEMENT CAPTION=\"" . lprint("DUNNO") . "\" VALUE=\"2\" /" . $rb . "<br />";
            print $lb . "/CHOICE" . $rb;
            $found = 1;
        }
        if ($e eq 14)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 14, MUST HAVE AN END TAG") . "]</i></b> ";
            print lprint(
"All tags that are not terminated immediately must be terminated with an end tag after the data they contain. ");
            print lprint("Tags that has to be terminated this way are");
            print " <b>SURVEY</b>, <b>CHOICE</b>, <b>LIST</b>, <b>MEMO</b>, <b>CUSTOM</b> "
              . lprint("and")
              . " <b>COMMENT</b>. ";
            print lprint("A valid <b>COMMENT</b> tag might look like this : ");
            print $lb
              . "COMMENT EMBED=\"yes\""
              . $rb . "<b>"
              . lprint("Some comments") . "</b>"
              . $lb
              . "/COMMENT"
              . $rb . " ("
              . lprint("where") . " ";
            print $lb . "/COMMENT" . $rb . " " . lprint("is the so called \"end tag\" terminating the block") . ").";
            $found = 1;
        }
        if ($e eq 15)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 15, CAN ONLY CONTAIN CHOICEELEMENTS") . "]</b></i> ";
            print lprint(
"A <b>CHOICE</b> block can only contain <b>CHOICEELEMENT</b> tags. Remove all other tags from within the ");
            print $lb . "CHOICE .." . $rb . "<b> .. </b>" . $lb . "/CHOICE" . $rb . lprint(" block. ");
            print lprint("Please note that <b>CHOICE</b> is written upper case");
            $found = 1;
        }
        if ($e eq 16)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 16, CHOICEELEMENT MUST HAVE NUMERICAL VALUE") . "]</i></b> ";
            print "<b>CHOICE</b> " . lprint("tags are considered having a numerical value when submitted. ");
            print lprint("Each of the elements that are available must be given the value they represent. ");
            print lprint("A valid <b>CHOICE</b> tag might look like this") . " :<br /><br />";
            print $lb
              . "CHOICE NAME=\""
              . lprint("query")
              . "\" CAPTION=\""
              . lprint("You like this ?") . "\""
              . $rb
              . "<br />";
            print $lb
              . "CHOICEELEMENT CAPTION=\""
              . lprint("YES")
              . "\" VALUE=\"1\" CHECKED=\"yes\" /"
              . $rb
              . "<br />";
            print $lb . "CHOICEELEMENT CAPTION=\"" . lprint("NO") . "\" VALUE=\"0\" /" . $rb . "<br />";
            print $lb . "CHOICEELEMENT CAPTION=\"" . lprint("DUNNO") . "\" VALUE=\"2\" /" . $rb . "<br />";
            print $lb . "/CHOICE" . $rb . "<br /><br />";
            print lprint("Currently only positive integers are supported as numerical values. ");
            print lprint("Please note that VALUE is written upper case.");
            $found = 1;
        }
        if ($e eq 17)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 17, LIST TAG MUST HAVE LISTELEMENTS") . "]</i></b> ";
            print lprint(
"A <b>LIST</b> tag consists of lines. At least one line must be given to create a valid <b>LIST</b> tag. ");
            print lprint(
"Lines are given in the form of <b>LISTELEMENTS</b>. A valid <b>LIST</b> block might look like this :<br /><br />");
            print $lb
              . "LIST NAME=\""
              . lprint("query")
              . "\" CAPTION=\""
              . lprint("You like this ?") . "\""
              . $rb
              . "<br />";
            print $lb
              . "LISTELEMENT CAPTION=\""
              . lprint("YES")
              . "\" SELECTED=\""
              . lprint("yes") . "\" /"
              . $rb
              . "<br />";
            print $lb . "LISTELEMENT CAPTION=\"" . lprint("NO") . "\" /" . $rb . "<br />";
            print $lb . "LISTELEMENT CAPTION=\"" . lprint("DUNNO") . "\" /" . $rb . "<br />";
            print $lb . "/LIST" . $rb;
            $found = 1;
        }
        if ($e eq 18)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 18, CAN ONLY CONTAIN LISTELEMENTS") . "]</b></i> ";
            print lprint(
                "A <b>LIST</b> block can only contain <b>LISTELEMENT</b> tags. Remove all other tags from within the ");
            print $lb . "LIST .." . $rb . "<b> .. </b>" . $lb . "/LIST" . $rb . lprint(" block. ");
            print lprint("Please note that <b>LIST</b> is written upper case.");
            $found = 1;
        }
        if ($e eq 19)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 19, LISTELEMENTS MUST HAVE CAPTION") . "]</i></b> ";
            print lprint(
"Each <b>LISTELEMENT</b> tag within a <b>LIST</b> block must be given a caption to represent its value and what is written in the list. A valid <b>LIST</b> block might look like this"
            ) . " :<br /><br />";
            print $lb
              . "LIST NAME=\""
              . lprint("query")
              . "\" CAPTION=\""
              . lprint("You like this ?") . "\""
              . $rb
              . "<br />";
            print $lb . "LISTELEMENT CAPTION=\"" . lprint("YES") . "\" SELECTED=\"yes\" /" . $rb . "<br />";
            print $lb . "LISTELEMENT CAPTION=\"" . lprint("NO") . "\" /" . $rb . "<br />";
            print $lb . "LISTELEMENT CAPTION=\"" . lprint("DUNNO") . "\" /" . $rb . "<br />";
            print $lb . "/LIST" . $rb;
            $found = 1;
        }
        if ($e eq 20)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 20, MUST HAVE A UNIQUE NAME") . "]</i></b> ";
            print lprint("All components in the survet must have unique names. ");
            print lprint("You cannot give two different components the same name. ");
            print lprint(
'Since name parsing is <i>case insensitive</i>, it is <i>not</i> allowed to have one component called "NAME" and another called "name".'
            );
            $found = 1;
        }
        if ($e eq 21)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 21, TAG NAMES CAN ONLY BE 8 CHARACTERS WIDE") . "]</i></b> ";
            print lprint("Currently, the tag (variable) names are limited to 8 characters. ");
            print lprint(
"This is mainly to allow for export to formats such as SPSS syntax. This might change in future versions.");
            $found = 1;
        }
        if ($e eq 22)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 22, MALFORMED DBIDSN") . "]</i></b> ";
            print lprint(
'The DBIDSN must always start with "DBI:" to denote that it is a DSN for a DBI database, which currently is what this program can handle. '
            );
            $found = 1;
        }
        if ($e eq 23)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 23, CAN ONLY BE 6 CHARACTERS WIDE") . "]</i></b> ";
            print lprint(
"Some tags can only have names that are 6 characters wide, as they will automatically get numbers attached to them. ");
            print lprint("One example of this is the MATRIX tag. ");
            print lprint(
'A MATRIX tag with the name "matr" will have MATRIXELEMENTs (either COLUMNs or ROWs) called matr01, matr02 and so on.');
            $found = 1;
        }
        if ($e eq 24)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 24, MUST CONTAIN MATRIXELEMENTS") . "]</i></b> ";
            print lprint(
"A MATRIX block must contain MATRIXELEMENT (either COLUMNs or ROWs) tags, as these define the parts of the matrix.");
            $found = 1;
        }
        if ($e eq 25)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 25, CAN ONLY CONTAIN MATRIXELEMENTS") . "]</i></b> ";
            print lprint(
"A MATRIX block can only contain MATRIXELEMENT (either COLUMNs or ROWs) tags. Please remove all other tags from the block."
            );
            $found = 1;
        }
        if ($e eq 26)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 26, CANNOT START WITH A NUMBER") . "]</i></b> ";
            print lprint(
"As some export formats would whine about variable names that starts with a number, that is prohitibted in the program."
            );
            $found = 1;
        }
        if ($e eq 27)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 27, CONTAINS ILLEGAL CHARACTERS") . "]</i></b> ";
            print lprint("Some characters are forbidden in variable names. These are : ")
              . "\-\+\.\,\!\(\)\=\/\\\@\{\}\[\]\%\&\#\?\'\"\^\~\*\<\>\|\;\:";
            $found = 1;
        }
        if ($e eq 28)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 28, DBI IS SWITCHED OFF") . "]</i></b> ";
            print lprint(
"In the global configuration file, the flag which controls the use of DBI is set to zero, meaning that Mod_Survey should not try to access the DBI modules. "
            );
            print lprint("Therefore, it is not possible to use the DBITABLE export method. ");
            print lprint(
"You can either switch on DBI by setting _SURVEY_USEDBI to 1 in the global configuration file (make sure that you have installed DBI first), or you can use ASCIIFILE export method instead of DBITABLE."
            );

            $found = 1;
        }
        if ($e eq 29)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 29, COULD NOT CREATE AUTODATA FILE") . "]</i></b> ";
            print lprint(
"As neither ASCIIFILE nor DBITABLE was set, and the global configuration option _SURVEY_ALLOWAUTO was enabled, the system tried to create an autodata file. This failed for some unknown reason. "
            );
            $found = 1;
        }
        if ($e eq 30)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 30, IS NOT A VALID PARAMETER") . "]</i></b> ";
            print lprint(
                   "Most tags in the Mod_Survey language accept parameters which control how the tags should behave. ");
            print lprint("You tried to insert a parameter which the parser did not understand. ");
            print lprint("Please refer to the documentation on which parameters are acceptable in which tags.");
            $found = 1;
        }
        if ($e eq 31)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 31, LISTELEMENT MUST BE GIVEN A VALUE") . "]</i></b> ";
            print lprint("When NUMERIAL is set to yes in a LIST, all LISTEMENTS must be given numerical VALUEs.");
            $found = 1;
        }
        if ($e eq 32)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 32, CANNOT CONTAIN WHEN ESCAPED IS YES") . "]</i></b> ";
            print lprint('Since version 3.0.7, the CUSTOM tags have a parameter ESCAPED which defaults to "yes". ');
            print lprint(
'This parameter tell the parser whether the contained HTML code is escaped, that is if a "\&lt\;" is written \&amp\;lt\;. '
            );
            print lprint("The reason to use escaped HTML code is that it makes the survey file valid XML. ");
            print lprint(
'To solve the problem, either escape all HTML code (which is the good solution), or set the ESCAPED parameter to "no" (which is the bad solution).'
            );
            $found = 1;
        }
        if ($e eq 33)    # Addition as consequence to gramlich redirect patch
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 33, REDIRECT WITHOUT CONTINUE") . "]</i></b> ";
            print lprint(
"Since patch version 3.0.7b, the REDIRECT parameter in the SURVEY tag can be used to send the user to the address specified by CONTINUE, rather than asking the user to click a link to that address. For REDIRECT to work the CONTINUE address must be specified (since it is not possible to redirect to an empty address)."
            );
            $found = 1;
        }

        #P. Sweatman changed error message Nov 01
        if ($e eq 34)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 34, ENV TAG MUST HAVE SPECIFIED FIELD") . "]</i></b> ";
            print lprint(
"The ENV tag (which is new since version 3.0.9) reads an environment variable from the system and adds it to the submitted data as if it was sent by the user. "
            );
            print lprint(
"In order for the system to know which variable to read, you have to set the FIELD parameter in the ENV tag.");
            $found = 1;
        }
        if ($e eq 35)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 35, CONSTANT TAG MUST HAVE A VALUE") . "]</i></b> ";
            print lprint(
"The CONSTANT tag (which is new since version 3.0.9) adds a constant value to the submitted data as if it was sent by the user. "
            );
            print lprint(
"In order for the system to know which value to send, you have to set the VALUE parameter in the CONSTANT tag.");
            $found = 1;
        }
        if ($e eq 36)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 36, THIS SURVEY REQUIRES AUTHENTICATION") . "]</i></b> ";
            print lprint("The REQAUTH parameter is set in the SURVEY tag. ");
            print lprint(
                        'This means that a "Basic" authentication must take place before the survey can be answered. ');
            print lprint(
"In theory, you should never see this error message, unless the admin of the survey has forgotten (or failed) placing a valid \".htaccess\" file alongside the survey file. "
            );
            $found = 1;
        }
        if ($e eq 37)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 37, DBI support not implemented") . "]</i></b> ";
            print lprint("As of second patch with MEMO tags, DBI support has not yet been implemented.");
            $found = 1;
        }
        if ($e eq 38)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 38, Cannot have MULTIPAGE without LASTPAGE") . "]</i></b> ";
            print lprint(
                   "Since version 3.0.12, it is possible to tie several surveys into a so called MULTIPAGE sequence. ");
            print lprint(
"In order for the system to know a) whether to accept data from a previous part, and b) when to stop sending data to a next part, both MULTIPAGE and LASTPAGE has to be set."
            );
            $found = 1;
        }
        if ($e eq 39)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 39, Bad values for MULTIPAGE sequence") . "]</i></b> ";
            print lprint(
"The multipage sequence setting must follow a) MULTIPAGE and LASTPAGE must be numerical, b) both must be larger than zero, c) LASTPAGE must be larger than or equal to MULTIPAGE"
            );
            $found = 1;
        }
        if ($e eq 40)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 40, SEQUENCEFILE is a required parameter") . "]</i></b> ";
            print lprint(
"When constructing a multipage sequence, the last page needs to get a list of the survey files to include in itself. ");
            print lprint(
'This list is placed in a "sequence file", which has to be referenced in the SEQUENCEFILE parameter of the SURVEY tag.'
            );
            $found = 1;
        }
        if ($e eq 41)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 41, SEQUENCEFILE does not exist or is unreadable") . "]</i></b> ";
            print lprint(
"When constructing a multipage sequence, the last page needs to get a list of the survey files to include in itself. ");
            print lprint(
"Unfortunately it seems that the file that was referenced by the SEQUENCEFILE parameter of the SURVEY tag was not possible to read, either because it does not exist, or because the web user do not have permission to read it."
            );
            $found = 1;
        }
        if ($e eq 42)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 42, A part produced an error") . "]</i></b> ";
            print lprint(
                     "For some reason one of the pages included in the multipage sequence produced a Document error. ");
            print lprint("Correct that error and try again.");
            $found = 1;
        }
        if ($e eq 43)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 43, The name was defined earlier") . "]</i></b> ";
            print lprint(
"The variable names for all the questions must be unique; not only within all survey files, but also across ");
            print lprint(
                 "multipage sequences. Please change the offending name in one of the places it is set, and try again. "
            );

            $found = 1;
        }
        if ($e eq 44)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 44, Cannot have both ALLOWCACHE and RANDOM") . "]</i></b> ";
            print lprint("Since version 3.0.14 it is possible to randomize the order of the components in a MATRIX. ");
            print lprint(
"However, if cache is enabled, the first randomization will be cached and then displayed again and again. ");
            print lprint('Thus, you will have to set ALLOWCACHE to "no" if you plan to use randomization. ');
            $found = 1;
        }

        # added in CRU patch (MJ/20020726)
        if ($e eq 45)
        {
            print "<b><i>["
              . lprint("DOCUMENT ERROR 45, Saving of partial answers requires DBI, but DBITABLE is not set")
              . "]</i></b> ";
            print lprint("Since version 3.0.15 it is possible to save partial answer. ");
            print lprint("But you must set up a database in order to store the results.");
            $found = 1;
        }

        # added in CRU patch (MJ/20020726)
        if ($e eq 46)
        {
            print "<b><i>["
              . lprint("DOCUMENT ERROR 46, Saving of partial answers will not work when cache is enabled")
              . "]</i></b> ";
            print lprint("Since version 3.0.15 it is possible to save partial answer. ");
            print lprint("However, this requires that the the survey parsing and the HTML output is not caches. ");
            print lprint('Thus you must set ALLOWCACHE="no" in the SURVEY tag to use this feature.');
            $found = 1;
        }

        # added in CRU patch (MJ/20020820)
        if ($e eq 47)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 47, SOAP authentication is disabled") . "]</i></b> ";
            print lprint("Since version 3.0.15 it is possible to use a SOAP client within mod_survey. ");
            print lprint(
'However, as this requires additional libraries and the setup of the mailing-list software <A HREF="http://www.sympa.org">Sympa</A>, the default mode of Mod_Survey is to have this feature disabled. '
            );
            print lprint(
'In order to enable soap authentication you have to (apart from setting REQAUTH="soap" in the SURVEY tag) ask the administrator to a) install Sympa and the required libraries (see documentation), and b) set _SURVEY_SOAP and _SURVEY_SOAP_WSDL in survey.conf.'
            );
            $found = 1;
        }

        # added in CRU patch (MJ/20020820)
        if ($e eq 48)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 48, SOAP error") . "]</i></b> ";
            print lprint("Since version 3.0.15 it is possible to use a SOAP client within mod_survey. ");
            print lprint(
                    "It seems that an error occurs using this feature. Check you configuration please. The error is : ")
              . "\n";
            print $self->{ERROR};
            $found = 1;
        }

        # added in CRU patch (MJ/20020820)
        if ($e eq 49)
        {
            my $query = new CGI();

            print $query->header();
            print $query->start_html(
                        -title => lprint('Login to view the survey'),
                        -meta => { 'http-equiv' => 'Content-Type', 'content' => 'text/html', 'charset' => 'iso-8859-1' }
            );
            print $query->h1({ -align => 'center' }, lprint('You must identify yourself'));
            print $query->br();
            print $query->br();
            print $query->start_form({ -action => $query->url(-absolute => 1), -method => 'POST' });
            print "      <p><input type=\"hidden\" name=\"action\" value=\"soap\"/>\n";
            print $query->h4({ -align => 'center' }, lprint('Your e-mail : '), ' <input type="text" name="login">');
            print $query->h4({ -align => 'center' }, lprint('Your password : '),
                             ' <input type="password" name="passwd">');
            print STDOUT '<div align="center">';
            print $query->input({ -type => 'submit', -value => 'login', -name => 'soap' });
            print STDOUT '</div>';
            print $query->end_form();
            print $query->end_html;
            $found = 1;
        }

        if ($e eq 50)
        {
            print "<b><i>[" . lprint("DOCUMENT ERROR 50, No such array") . "]</i></b> ";
            print lprint("The no such array error can be caused by either of two likely mistakes.") . " ";
            print lprint(
                 "The most likely cause is a spelling mistake: Check that you spelled the name of the array correctly.")
              . " ";
            print lprint("The second likely cause is that you placed a DB*ELEMENT subtag in the last page, ") . " ";
            print lprint(
                    "while its corresponding IMPORT is in a previous page. Either move the DB element to the page with")
              . " ";
            print lprint("the IMPORT, or move the IMPORT to the page with the DB element. Or, place the DB element in")
              . " ";
            print lprint("any page but the last.");
            $found = 1;
        }

        if (!$found)
        {
            print lprint("This error is not in the knowledge base, so I guess the programmer has made a mistake.");
        }
    }
    else
    {
        print "<i>[" . lprint("DOCUMENT ERROR 0, NO ERROR") . "]</i> ";
        print lprint(
                "No error has occured, but the programmer has for some reason called PrintErrorDescription() anyway. ");
        print lprint("I guess the programmer has again made a mistake, something that is a very common event indeed.");
    }
    print "\n    <br /><br />\n";
}

1;