use HTML::TreeBuilder;

use strict;

# --- Things to do, before the HTML-form will be generated

use File::Basename;

my %hPgTypesGL = ();

sub PreDoAction ()
{

   my $plSelect = $oDbSessionGL->SqlSelect
       ("SELECT oid, typname
         FROM pg_type");

   foreach (@$plSelect)
   {
      print STDERR "{$_->[0]} = $_->[1]\n";

      $hPgTypesGL{$_->[0]} = $_->[1];
   }
}



# --- Things to do, before the HTML-form will be generated
sub PreCreateForm()
{
   my @lCategories;
   my $cResult;
   my @lProArgTypes = ();

  # ensure, that non admins get no access
   if(!$oSessionGL->getState("ActualLogin") ||
      !$oSessionGL->getState("IsAdmin"))
   {
      &OkForm("ERROR",
              sprintf(i18n("Sorry, please %s first as WWWdb-admin!"),
                      "<A HREF=" .
                      &CreateReference(&GetAttr("SessionId"),
                                       "System:Login") .
                      ">" .
                      i18n("login") .
                      "</A>"),
              "BtnExit");
      &MyExit();
   }

   foreach (split /\s+/, &GetField("proargtypes"))
   {
          push (@lProArgTypes, &GetType($_));
   }


   &SetField("proargtypes_resolv", join ",", @lProArgTypes);


   if (&GetField("oid"))
   {
      &ExportFile();

      &MySetVal("Layout Field proargtypes_resolv", "Type", "Label");
   }
}



sub PreBtnQry()
{
   if(!&GetField("prolang"))
   {
      &SetField("prolang", "> 100");

   }
}


sub PreBtnSelect()
{

   if(&GetField("oid"))
   {
      &MyParam('!Serial', "oid");
   }
}

sub MyBtnNew ()
{
   my $cResult;

   if (!&GetAttr("RecordOk")) {
      &GenPage();
   }
   else {
      &SqlExecute(&GenCreateProc());

      print &Redirect(&GetAttr("SessionId"),
                   sprintf("Db:PostgreSQL:Functions;id=%s",
                           &GetMyOid()));
   }
}


sub MyBtnUpd()
{
   my $cResult;

   if (!&GetAttr("RecordOk")) {
      &GenPage();
   }
   else {
      &SqlExecute(&GenDropProc());
      &SqlExecute(&GenCreateProc());

      print &Redirect(&GetAttr("SessionId"),
                      sprintf("Db:PostgreSQL:Functions;id=%s",
                              &GetMyOid()));
   }
}


sub MyBtnDel()
{
   &SqlExecute(&GenDropProc());
}



sub MyBtnImpInit()
{
   &ImportData();
   &MyParam("WWWdbState", "Init");
   &GenPage();
}



sub MyBtnProto()
{
   my $cPrototype = <<EOF;

DECLARE
    <>PI AS \$1;
    Result <> DEFAULT <>;

BEGIN
    ------------------------------------------------------------------------
    -- Author     : .....
    -- Created    : .....
    -- Description: .....
    ------------------------------------------------------------------------

    Result := <>;

    RETURN Result;

END;

EOF

   &SetField("prosrc", $cPrototype);
   &MyParam("WWWdbState", "Init");
   &GenPage();
}


sub MyBtnDoTest()
{
   my $cResult = "";
   my $cSqlCmd = sprintf("SELECT %s(%s)",
                         &GetField("proname"),
                         &GetField("proargs"));

   my $lRecord = &SqlExecute($cSqlCmd);

   # generate them
   foreach (@$lRecord)
   {
      my @lFields;

      @lFields = @{$_};

      $cResult .= "<TR>";

      foreach (@lFields)
      {
         $cResult .= td($_? $_: "NULL");

      }

      $cResult .= "</TR>";
   }

   &MyParam("WWWdbState", "Work");

   &OkForm("",
           b(i18n("Here is the result of your function-call:")) . p() .
           ($cSqlCmd) . p() .
           hr() .
           ($cResult) . p() .
           hr() .
           br() x 2 .
           i18n("Please use the back-button of your browser"),
           "-");

   &MyExit();

   return;
}


sub MyBtnImpWork()
{
   &ImportData();
   &MyParam("WWWdbState", "Work");
   &GenPage();
}


sub SqlExecute($)
{
   my $lRecord = eval
   {
      my $cSqlCmdPI = shift;
      my $cResult;
      my $bResult = 0;

      if($cSqlCmdPI =~ /^select/i)
      {
         $bResult = 1;
      }

      my $pDbHdl = $oDbSessionGL->{"DbHandle"};
      my $pStmtHdl;

      local $SIG{'__DIE__'};
      local $SIG{'__WARN__'};

      $pStmtHdl = $pDbHdl->prepare($cSqlCmdPI) or
          die(sprintf(i18n("Prepare: [%s] %s"),
                      $pDbHdl->state(),
                      $pDbHdl->errstr()));

      print STDERR "SSSSS 1.0\n$cSqlCmdPI\n" . $pDbHdl->errstr();
      unless ($cResult)
      {
         $pStmtHdl->execute();
         print STDERR "SSSSS 2.0\n" . $DBI::errstr;

         if ($bResult)
         {
            $cResult = $pStmtHdl->fetchall_arrayref()
                unless ($DBI::errstr);

            print STDERR "SSSSS 2.1\n" . $DBI::errstr;
         }
      }

      if ($DBI::errstr)
      {
         &Error(b(i18n("Invalid SQL-statement, please re-enter.")) . p() .
                ($DBI::errstr?
                 (b(i18n("The SQL-error was: ")) . p() .
                  sprintf(i18n("[%s] %s"),
                          $DBI::state,
                          i($DBI::errstr)) . p()):
                 "-"));
         &MyExit();
      }

      $cResult;
   };


   return $lRecord;

}

sub ImportData()
{

   # because this is a filehandle we must go this way ...
   my $cFileName      = param("Fldimport_file");
   my $cContentOfFile = "";
   my $oBody;

   if($cFileName)
   {
      my $iSize;
      my $cData;
      my $iTotalSize;

      while ($iSize = read($cFileName, $cData, 1024))
      {
         $cContentOfFile .= $cData;
         $iTotalSize += $iSize;
      }

      &SetField("prosrc", $cContentOfFile);
   }

}



sub MyBtnView()
{
   my $cField = &GenCreateProc();


   &OkForm("",
           (b(i18n("Preview of current entry")) .
            br() x 2 .
            table({-BORDER      => 1,
                   -CELLPADDING => 10},
                  TR(td(p({-ALIGN  => "CENTER"},
                          big(b(&GetField("description")))) .
                        hr({-NOSHADE => 1}) .
                        p({-ALIGN  => "LEFT"},
                          pre($cField))))) .
            br() x 2 .
            i18n("Please use the back-button of your browser")),
           "-");

   &MyExit();
}




sub ExportFile()
{
   my $cExportFileName = &UnTaint(&GenExportFileName());

   open HTML_EXP, ">$cExportFileName"
       or die sprintf(i18n("Can't open %s"),
                      $cExportFileName);

   print HTML_EXP &GetField("prosrc");

   close HTML_EXP;

   chmod 0666, $cExportFileName;

   &SetField("import_file", $cExportFileName);

   &SetField("export_file", "wwwdb://../../../" .
             &GetAttr("ScriptName") .
             "/tmp/" .
             basename("$cExportFileName"));

   &MySetVal("Layout Field export_file", "Value",
             basename("$cExportFileName"));

   &SetField("show_url",
             sprintf("wwwdb://WWWdb:Tools:ShowDoc;id=%d,%s",
                     &GetField("id_doc"),
                     &GetField("lang")));


}


sub GenExportFileName ()
{
   my $cResult = "";
   my $cBuffer = "";

   $cBuffer = &GetField("proname");

   $cBuffer =~ s/[^A-Za-z0-9_]//g;
   # $cBuffer =~ s/[aeiouAEIOU]//g;
   $cBuffer =~ s/_$//g;

   $cResult = (&GetAttr("BaseDir") .
               "/tmp/" .
               $cBuffer .
               ".sql");

   return $cResult;
}


sub PostFirstColumn ()
{
   my $cResult = "";

   return small($cResult);

}



sub QryConv_last_change()
{
   return $oDbSessionGL->DateFromDb(shift);

}


sub GenDropProc()
{
   my $cResult = "";

   $cResult = sprintf("DROP FUNCTION %s (%s);\n",
                       &GetField("proname"),
                       &GetField("proargtypes_resolv"));

   return $cResult;
}


sub GenCreateProc()
{
   my $cResult = "";
   my $cRetType;
   my $cSrc = &GetField("prosrc");
   my $cLanguage =
       $oDbSessionGL->SqlSelect
           ("SELECT lanname
             FROM pg_language
             WHERE
                 oid = ?",
            &GetField("prolang"))->[0]->[0];
   $cSrc =~ s/\'/\'\'/g;

#       $cResult .= sprintf("--------------------------------------------\n");
#       $cResult .= sprintf("-- Function: %s\n", &GetField("proname"));
#       $cResult .= sprintf("-- Date    : %s\n",
#                           $oDbSessionGL->DateFromDb
#                           ($oDbSessionGL->DateToDb(scalar localtime())));
#       $cResult .= sprintf("--------------------------------------------\n");

   $cResult .= sprintf("CREATE FUNCTION %s (%s) RETURNS %s AS '",
                       &GetField("proname"),
                       &GetField("proargtypes_resolv"),
                       &GetType(&GetField("prorettype")));

   $cResult .= $cSrc;

   $cResult .= sprintf ("\n' LANGUAGE '%s';",
                        $cLanguage);

   $cResult =~s/\?/\\077/g;

   return $cResult;
}



sub GetType(;)
{
   my $iOidOfType = shift;

   my $cResult = $hPgTypesGL{$iOidOfType};

   print STDERR "GetType: $iOidOfType -> $cResult\n";

   return $cResult || "OPAQUE";
}



sub GetMyOid()
{
   my $iOid = 0;

   # we must take this way, because proargtypes, prorettype
   # may are arrays, which I dont know to handle in another way
   my $plSelect = $oDbSessionGL->SqlSelect
       ("SELECT
             oid, prolang, proargtypes, prorettype
         FROM
             pg_proc
         WHERE
             proname = ?",
            &GetField("proname"));
   {

      foreach (@$plSelect)
      {
         if(($_->[1] eq &GetField("prolang")) &&
            ($_->[2] eq &GetField("proargtypes")) &&
            ($_->[3] eq &GetField("prorettype")))
         {
            $iOid = $_->[0];
         }

      }

   }

   return $iOid;
}



sub QryConv_prolang($%)
{
   my $cProLangPI = shift;
   my %hRecordPI     = @_;

   my $cResult       =  $oDbSessionGL->SqlSelect
           ("SELECT lanname
             FROM pg_language
             WHERE
                 oid = ?",
            $cProLangPI)->[0]->[0];

   return $cResult;
}



sub QryConv_prorettype($%)
{
   my $cProRettypePI = shift;
   my %hRecordPI     = @_;

   my $cResult       = &GetType($cProRettypePI);
   return $cResult;
}



sub QryConv_proargtypes($%)
{
   my $cProArgTypePI = shift;
   my %hRecordPI     = @_;
   my $cResult = "";
   my @lProArgTypes = ();

   foreach (split /\s+/, $cProArgTypePI)
   {
          push (@lProArgTypes, &GetType($_));
   }

   $cResult = join ", ", @lProArgTypes;

   return $cResult;
}

1;