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)
   {
      $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"),
                                       "Login") .
                      ">" .
                      i18n("login") .
                      "</A>"),
              "BtnExit");
      &MyExit();
   }

   # select all user-procedures
   {
      my @lProcedures = ();

      # get all user procedures, but not that one,
      # used in trggers (they return OPAQUE)
      my $plSelect = $oDbSessionGL->SqlSelect
           ("SELECT
                 oid, proname, prolang, proargtypes, prorettype
             FROM
                 pg_proc
             WHERE
                 prolang    > 100 AND
                 prorettype > 0
             ORDER BY
                 proname");

       foreach (@$plSelect)
       {
          my @lProArgTypes = ();

          foreach (split /\s+/, $_->[3])
          {
             push (@lProArgTypes, &GetType($_));
          }

          push @lProcedures, sprintf("%s,%s\\,%s(%s) -> %s",
                                     $_->[0],
                                     $_->[1],
                                     $_->[1],
                                     (join ", ", @lProArgTypes),
                                     &GetType($_->[4]));
       }

       &MySetVal("Layout Field procedure",
                 "Values", join "\n", @lProcedures);
    }
}



sub MyBtnDoTest()
{
   my $cResult = "";
   my $cSqlCmd = sprintf("SELECT %s(%s)",
                         ((split /,/, &GetField("procedure"))[1]),
                         &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,
           "");

   &MyExit();

   return;
}



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 GetType(;)
{
   my $iOidOfType = shift;

   my $cResult = $hPgTypesGL{$iOidOfType};

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

   return $cResult || "OPAQUE";
}



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;