#    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;

use Encode;
use Encode::Guess qw/latin1 utf8 ascii/;

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.7-pre1 (testing)";
}

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 isMobileOverride
{
  if($ENV{_SURVEY_DISABLE_MOBILEOVERRIDE} ne "1")
  {
    # Detecting of and overriding for handhelds is enabled

    my($agent) = lc($ENV{HTTP_USER_AGENT});

    if($agent =~ /android/)
    {
      # Assume android phone => handheld
      return 1;
    }

    if($agent =~ /iphone/)
    {
      # Assume iphone => handheld
      return 1;
    }
  }

  return 0;
}

sub MobileHeader
{
  if(Survey::Slask->isMobileOverride())
  {
    print "    <meta name=\"HandheldFriendly\" content=\"true\" />\n";
    print "    <meta name=\"viewport\" content=\"width=device-width; height=device-height, initial-scale=1.0; maximum-scale=1.0; user-scalable=0;\" />\n";
  }
}

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

    my($enc) = $ENV{_SURVEY_ENCODING};

    print "<?xml version=\"1.0\" charset=\"$enc\" ?>\n";
    print "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3c.org/TR/xhtml1/DTD/strict.dtd\" >\n";
    print "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n";
    print "  <head>\n";

    Survey::Slask->MobileHeader();
    
    print "    <meta http-equiv=\"Content-Type\" content=\"text/html; charset=$enc\" />\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 LangHack
{
  my($self) = shift;
  my($string) = shift;

  my($enc) = $ENV{"_SURVEY_ENCODING"} || "utf8";

  my($inputformat) = guess_encoding($string, qw/latin1 utf8 ascii/);
  ref($inputformat) or return $string;

  my($utf8) = $inputformat->decode($string);

  $string = encode($enc,$utf8);

  if($ENV{"_SURVEY_LANGHACK"})
  {
    # Å -> &Aring;
    $string =~ s/\xc3\x85/\&Aring;/g;
    $string =~ s/\xc5/\&Aring;/g;

    # Ä -> &Auml;
    $string =~ s/\xc3\x84/\&Auml;/g;
    $string =~ s/\xc4/\&Auml;/g;

    # Ö -> &Ouml;
    $string =~ s/\xc3\x96/\&Ouml;/g;
    $string =~ s/\xd6/\&Ouml;/g;

    # å -> &aring;
    $string =~ s/\xc3\xa5/\&aring;/g;
    $string =~ s/\xe5/\&aring;/g;

    # ä -> &auml;
    $string =~ s/\xc3\xa4/\&auml;/g;
    $string =~ s/\xe4/\&auml;/g;

    # ö -> &ouml;
    $string =~ s/\xc3\xb6/\&ouml;/g;
    $string =~ s/\xf6/\&ouml;/g;
  }

  return $string;
}

sub explicitEncoding
{
  my($self) = shift;
  my($enc) = shift;
  my($string) = shift;

  my($inputformat) = guess_encoding($string, qw/utf8 latin1 ascii/);
  ref($inputformat) or return $string;

  my($utf8) = $inputformat->decode($string);

  $string = encode($enc,$utf8);

  return $string;
}

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

sub HtmlHead
{
    my ($self) = shift;

    my($enc) = $ENV{"_SURVEY_ENCODING"} || "UTF-8";

    #print "Content-type: text/html\n\n";
    print "<?xml version=\"1.0\" charset=\"$enc\" ?>\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";
    Survey::Slask->MobileHeader();
    print "    <meta http-equiv=\"Content-Type\" content=\"text/html; charset=$enc\" />\n";

    1;
}

sub HtmlFoot
{
  my ($self) = shift;
  if(!Survey::Slask->isMobileOverride())
  {
    print "    <hr />\n";
    print "    <p>\n";
    print "      <br />\n";
    print "      " . &VersionString() . " \&copy; Joel Palmius in 2010<br /><br />\n";
    print "    </p>\n";
  }
  print "  </body>\n";
  print "</html>\n";

  1;
}

1;