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

use Survey::Document;
use Survey::Argument;
use Survey::Display;
use Survey::System;
use Survey::Submit;
use Survey::Admin;
use Survey::Language;

sub VersionString
{
    my ($style) = "style=\"color: #777799; font-weight: bold; text-decoration: none;\"";
    my ($href)  = "href=\"http://www.modsurvey.org/\"";
    return "<a $style $href >Mod_Survey</a> v3.2.5 (stable)";
}

sub IsError
{
    my ($crap, $obj) = @_;
    my ($errname, $iserror);

    if ($obj->Error())
    {
        $iserror = 1;

        ($crap,    $errname) = split("::", $obj,     2);
        ($errname, $crap)    = split("=",  $errname, 2);

        if ($errname eq "Submit")
        {
            if (defined($obj->{DOCUMENT}->{ "SUBMITERROR_" . $obj->{ERRORCODE} }))
            {

                my ($tagno) = $obj->{DOCUMENT}->{ "SUBMITERROR_" . $obj->{ERRORCODE} };

                my ($raw) = $obj->{DOCUMENT}->GetTagParam($tagno, "RAW");

                my ($realtagno) = $obj->{ERRORTAG};

                # Parse dynamics

                my ($caption)    = $obj->{DOCUMENT}->GetTagParam($realtagno, "CAPTION");
                my ($rowcaption) = $obj->{MATRIXWORKAROUND};
                my ($tagnumber)  = $realtagno;
                my ($name)       = $obj->{DOCUMENT}->GetTagParam($realtagno, "NAME");
                my ($shortdesc)  = $obj->{ERROR};

                $raw =~ s/\$caption/$caption/g;
                $raw =~ s/\$rowcaption/$rowcaption/g;
                $raw =~ s/\$tagnumber/$tagnumber/g;
                $raw =~ s/\$name/$name/g;
                $raw =~ s/\$shortdesc/$shortdesc/g;

                print $raw;

                $obj->{ERRORHANDLED} = 1;

                return $iserror;

            }
        }

        print "    <title>" . lprint("SURVEY") . " : " . $errname . " " . lprint("error") . "</title>\n";
        print "    <style><!--\n";
        print "      body     { color: black; background-color: #ffffff;  }";
        print "      :link    { color: #0044ff; }";
        print "      :visited { color: #0044ff; }";
        print "      .bad { color: #EE0000; }\n";
        print "    --></style>\n";
        print "  </head>\n";
        Survey::Slask->BodyTag();
        print "    <h1 class=\"bad\">" . $errname . " error</h1>\n";
        print "    <b>" . $obj->Error() . "</b><br />\n";
        $obj->PrintErrorDescription();
        print "    <br /><br />\n";
        print "    <b><i>"
          . lprint("Did the above not help you ? You can find documentation and examples for the mod_survey system at");
        print "    <a href=\"http://www.modsurvey.org\">http://www.modsurvey.org</a>.\n";
        print "    " . lprint("There you can also find instructions for joining the survey-discussion mail list, ");
        print "    " . lprint("which might provide some support") . ".";
        print "    "
          . lprint("You can also check the")
          . " <a href=\""
          . $ENV{"_SURVEY_ROOT_ALIAS"}
          . "docs/index.html\">";
        print lprint("local documentation") . "</a>.</i></b> <br /><br />\n";
    }
    else
    {
        $iserror = 0;
    }

    return $iserror;
}

sub PasswordDialog
{
    my ($crap, $doc, $arg) = @_;
    $doc->{HANDLER}->content_type("text/html");
    my ($action) = $arg->ArgByName("action");
    my ($admin)  = $arg->ArgByName("admin");

    print "<html>\n";
    print "  <head>\n";
    print "    <title>" . lprint("Password needed") . "</title>\n";
    print "    <link rel=\"stylesheet\" type=\"text/css\" href=\""
      . $ENV{_SURVEY_ROOT_ALIAS}
      . "system/data.css\" />\n";
    print "  </head>\n";
    print "  <body>\n";

    print "    <span class=\"commonblk\"><center>\n";
    print "      <span class=\"mainhead\">" . lprint("Password needed") . "</span><br />\n";
    print "    </center></span>\n";

    my ($uri) = $doc->GetOption("URI");

    print "    <span class=\"commonblk\">\n";

    print "<form method=\"post\" action=\"$uri\">\n";
    print "<input type=\"hidden\" value=\"$action\" name=\"action\" />\n";
    print "<input type=\"hidden\" value=\"$admin\" name=\"admin\" />\n";

    print "<span class=\"subhead\">Info</span><br /><br />\n";
    print lprint("The author of the survey has protected this module with a password.");
    print lprint("You will have to give the correct password to proceed.");
    print "<br /><br />";

    print "<b>" . lprint("Password") . ":</b><br />\n";
    print "<input type=\"password\" value=\"\" name=\"password\" />\n";
    print "<input type=\"submit\" value=\"" . lprint("Retry") . "\" />\n";
    print "</form>\n";

    print "    </span>\n";

    print "  </body>\n";
    print "</html>\n";

    1;
}

sub BodyTag
{
    my ($self) = shift;
    print "  <body bgcolor=\"#ffffff\" text=\"#000000\" link=\"#0044FF\" vlink=\"#0000EE\">\n";
    1;
}

sub HtmlHead
{
    my ($self) = shift;

    #print "Content-type: text/html\n\n";
    print "<?xml version=\"1.0\" charset=\"iso-8859-1\" ?>\n";
    print "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" ";
    print "\"http://www.w3c.org/TR/xhtml1/DTD/strict.dtd\" >\n";
    print "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n";
    print "  <head>\n";

    1;
}

sub HtmlFoot
{
    my ($self) = shift;
    print "    <hr />\n";
    print "    <p>\n";
    print "      <br />\n";
    print "      " . &VersionString() . " \&copy; Joel Palmius in 2008<br /><br />\n";
    print "    </p>\n";
    print "  </body>\n";
    print "</html>\n";

    1;
}

1;