#    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::Handler;
use strict;

use Survey::Constants;
use Survey::Document;
use Survey::Argument;
use Survey::Auth::Auth;
use Survey::Auth::DBIAuth;
use Survey::Auth::FileAuth;
use Survey::Display;
use Survey::System;
use Survey::Submit;
use Survey::Admin;
use Survey::Slask;
use Survey::Data;
use Survey::Session;
use Survey::Persistance;

use constant MP2 => $mod_perl::VERSION < 1.99 ? 0 : 1;

use Safe;

sub handler
{
    my $r = shift;

    my ($printfoot) = 1;
    my ($constants) = Survey::Constants->new();

    return $constants->{DECLINED} unless $r->content_type() eq 'text/html';

    my($enc) = $ENV{"_SURVEY_ENCODING"} || "UTF-8";
    $r->content_type("text/html; charset=$enc");

    #print "Content-type: text/plain\n\n";

    my $ses = Survey::Session->new($r);
    if ($ses->{ERROR})
    {
        Survey::Slask->IsError($ses);
        return $constants->{OK};
    }

    # responsible for accessing GET/POST data
    my $arg = Survey::Argument->new($ses);

    print STDERR $arg->ArgByName("ch"), "\n";

    # parses the survey file and creates a datastructure from
    # the given tags
    my $doc = Survey::Document->new($r, 0, $arg, $ses);
    my $sys = Survey::System->new($doc, $arg);

    my ($user, $pass);

    # Start new authentication code / JP 20031023 --------------
    if (!$doc->{ERROR})
    {

        # prefer authentication via session
        my $authtype = "external";
        $user = $ses->getValue("username");
        $pass = $ses->getValue("password");

        # prefer authentication via GET/POST data, but
        # only if explicitly set
        if ($arg->ArgByName("username"))
        {
            $user = $arg->ArgByName("username");
            $pass = $arg->ArgByName("password");
        }

        # if username or password are missing in GET/POST and Session data
        if (!$user || !$pass)
        {
            $pass = ($r->get_basic_auth_pw())[1];

            #$user = $r->connection->user;
            $user = $r->user;    # MP2 compatibility, crashes older MP1 (before 1.24)

            $authtype = "basic";
        }

        # Patch from BugAnt: REMOTE_USER isn't set when doing internal
        # authentication handling.
        $ENV{REMOTE_USER} = $user;

        # build auth object
        my $auth;
        my $validauth = 0;

        if ($doc->GetOption("AUTH_TYPE") eq "dbi_auth")
        {
            $auth = Survey::Auth::DBIAuth->new($doc, $arg, $ses, $user, $pass);
            $validauth = 1;
        }
        if ($doc->GetOption("AUTH_TYPE") eq "file_auth")
        {
            $auth = Survey::Auth::FileAuth->new($doc, $arg, $ses, $user, $pass);
            $validauth = 1;
        }
        if ($doc->GetOption("AUTH_TYPE") eq "token_auth")
        {
            $auth = Survey::Auth::TokenAuth->new($doc, $arg, $ses, $user, $pass);
            $validauth = 1;
        }

        if (!$validauth)
        {
            $auth = Survey::Auth::Auth->new($doc, $arg, $ses, $user, $pass);
        }

        # handle logout action
        if ($arg->ArgByName("action") eq "logout")
        {
            $ses->setValue("username", "");
            $ses->setValue("password", "");
            $ses->writeToDisk();
            $r->note_basic_auth_failure();
            return $constants->{AUTH_REQUIRED};
        }

        # check HOST parameter of ANSWER, DEBUG, DATA...
        if (!$auth->CheckHostRestriction())
        {
            Survey::Slask->IsError($auth);
            return $constants->{OK};
        }

        # check PASSWORD parameter of ANSWER, DEBUG, DATA...
        if (!$auth->CheckPasswordRestriction())
        {
            Survey::Slask->PasswordDialog($doc, $arg);
            $ses->writeToDisk();
            return $constants->{OK};
        }

        # check, if the user is authenticated
        my ($al) = $auth->GetUserLevel();

        # if an error occurred up to now
        # (for example if connecting the database failed)
        if ($doc->{ERROR})
        {
            Survey::Slask->HtmlHead();
            Survey::Slask->IsError($doc);
            return $constants->{OK};
        }

        # if the user is not authenticated
        if (!$al)
        {
            $ses->setValue("username", "");
            $ses->setValue("password", "");
            $ses->writeToDisk();

            # if username and password were given via GET/POST
            # ->display an error message
            if ($authtype eq "external")
            {
                if (MP2) { $doc->{HANDLER}->headers_out->set('Content-type' => "text/plain"); }
                else     { print "Content-type:text/plain\n\n"; }

                print "Authorization Required";
                return $constants->{OK};
            }

            # use basic authorization
            else
            {
                if ($doc->GetOption("AUTH_TYPE") eq "token_auth")
                {
                    print "The supplied token was not valid.";
                    return $constants->{OK};
                }
                else
                {
                    $r->note_basic_auth_failure();
                    return $constants->{AUTH_REQUIRED};
                }
            }
        }

        # check USER parameter of ANSWER, DEBUG, DATA...
        if (!$auth->CheckUserRestriction())
        {
            $ses->setValue("username", "");
            $ses->setValue("password", "");
            $ses->writeToDisk();
            $r->note_basic_auth_failure();
            return $constants->{AUTH_REQUIRED};
        }

        if ($auth->{ERROR})
        {
            Survey::Slask->IsError($auth);
            return $constants->{OK};
        }
    }

    # If we came this far, user and pass must be reasonably ok
    $ses->setValue("username", $user);
    $ses->setValue("password", $pass);

    # End new auth code ----------------------------------------

   #  if(($arg->ArgByName("action") ne "admin") && ($arg->ArgByName("action") ne "data")) { Survey::Slask->HtmlHead(); }
   #  Patch: Ertl, no html head for submit, to enable Location header
    if (   ($arg->ArgByName("action") ne "admin")
        && ($arg->ArgByName("action") ne "data")
        && ($arg->ArgByName("action") ne "submit"))
    {
        Survey::Slask->HtmlHead();
    }

    if ((!Survey::Slask->IsError($doc)) && (!Survey::Slask->IsError($arg)) && (!Survey::Slask->IsError($sys)))
    {
        if ($arg->ArgByName("action") eq "data")
        {
            my ($dat) = Survey::Data->new($doc, $arg);
            Survey::Slask->IsError($dat);
        }

        if ($arg->ArgByName("action") eq "display" or $arg->ArgByName("action") eq "soap")
        {
            my $dis = Survey::Display->new($doc, $arg, $sys, undef, undef);    # added in CRU patch (MJ/20020802)
            Survey::Slask->IsError($dis);
        }

        # added in CRU patch (MJ/20020802)
        if ($arg->ArgByName("action") eq "retrieve")
        {
            my $dis = Survey::Display->new($doc, $arg, $sys, "retrieve", $arg->ArgByName("user"));
            Survey::Slask->IsError($dis);
        }

        # added in CRU patch (MJ/20020802)

        if ($arg->ArgByName("action") eq "admin")
        {
            my ($adm) = Survey::Admin->new($doc, $arg);
            Survey::Slask->IsError($adm);
        }

        # added in CRU patch (MJ/20020802)
        # WARNING : don't change the order between the ifs
        if ($arg->ArgByName("save") eq $doc->GetOption("SAVETEXT"))
        {
            my ($adm) = Survey::Submit->new($doc, $arg, $sys, 1);
            Survey::Slask->IsError($adm);
        }

        # if a respondent has answered questions on a page and clicked
        # "submit" button
        elsif ($arg->ArgByName("action") eq "submit")
        {
            if (($arg->ArgByName("saveitb")) || ($arg->ArgByName("retriveitb")))
            {
                my ($per) = Survey::Persistance->new($r);

                if ($per->Error())
                {
                    Survey::Slask->IsError($per);
                }
                if ($arg->ArgByName("saveit"))
                {

                    #so... you wanna left.
                    #let's save what you've done.
                    my ($falsesub);
                    $falsesub->{ERROR}     = 0;
                    $falsesub->{ERRORCODE} = 0;
                    $falsesub->{DOCUMENT}  = $doc;
                    $falsesub->{ARGUMENT}  = $arg;
                    $falsesub->{SYSTEM}    = $sys;
                    bless($falsesub, "Survey::Submit");
                    $falsesub->FillDocument();
                    $doc->{DATA} = $falsesub->{DATA};
                    $per->popolate($doc, $doc->{SESSION});
                    $per->writeToDisk();
                    $per->htmlPerCode($per->getValue("PERSISTANCE_ID", 0));
                    return;
                }
                else
                {
                    if ($per->{ACCESS_FORM} != 1)
                    {

                        #let's read what you've done
                        $per->readFromDisk();
                        if ($per->Error())
                        {
                            Survey::Slask->IsError($per);
                        }
                        else
                        {

                            #Ok let's go to the latest page you left
                            my $go = $per->getValue("PAGELEFT", 0);

                            #$r->uri($go);
                            my $per_doc =
                              Survey::Document->new("", $go, $arg, bless($per->{SESSION}, "Survey::Session"));
                            if ($per_doc->Error())
                            {
                                Survey::Slask->IsError($per_doc);
                                return;
                            }
                            my $per_go = Survey::Display->new($per_doc, $per_doc->{ARGUMENT}, $sys, undef, undef);

                            #we've done... removing crap from your disk
                            $per->clear();
                            $per->writeToDisk();
                        }
                    }
                }
            }
            else
            {
                my ($smi) = Survey::Submit->new($doc, $arg, $sys, 0);    # added in CRU patch (MJ/20020802)
                if ($smi->Error())
                {
                    if (!Survey::Slask->IsError($sys)) { Survey::Slask->IsError($smi); }
                    if ($smi->{ERRORHANDLED})
                    {
                        $printfoot = 0;
                    }
                }
            }

            # added in CRU patch (MJ/20020802)
        }
    }

    if (($arg->ArgByName("action") ne "admin") && ($arg->ArgByName("action") ne "data"))
    {
        if ($printfoot)
        {
            Survey::Slask->HtmlFoot();
        }
    }

    $ses->writeToDisk();

    return $constants->{OK};
}

1;