------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- G N A T . C G I . D E B U G -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 2000-2001 Ada Core Technologies, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT 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 distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ with Ada.Strings.Unbounded; package body GNAT.CGI.Debug is use Ada.Strings.Unbounded; -- -- Define the abstract type which act as a template for all debug IO mode. -- To create a new IO mode you must: -- 1. create a new package spec -- 2. create a new type derived from IO.Format -- 3. implement all the abstract rountines in IO -- package IO is type Format is abstract tagged null record; function Output (Mode : in Format'Class) return String; function Variable (Mode : Format; Name : String; Value : String) return String is abstract; -- Returns variable Name and its associated value. function New_Line (Mode : Format) return String is abstract; -- Returns a new line such as this concatenated between two strings -- will display the strings on two lines. function Title (Mode : Format; Str : String) return String is abstract; -- Returns Str as a Title. A title must be alone and centered on a -- line. Next output will be on the following line. function Header (Mode : Format; Str : String) return String is abstract; -- Returns Str as an Header. An header must be alone on its line. Next -- output will be on the following line. end IO; -- -- IO for HTML mode -- package HTML_IO is -- see IO for comments about these routines. type Format is new IO.Format with null record; function Variable (IO : Format; Name : String; Value : String) return String; function New_Line (IO : in Format) return String; function Title (IO : in Format; Str : in String) return String; function Header (IO : in Format; Str : in String) return String; end HTML_IO; -- -- IO for plain text mode -- package Text_IO is -- See IO for comments about these routines type Format is new IO.Format with null record; function Variable (IO : Format; Name : String; Value : String) return String; function New_Line (IO : in Format) return String; function Title (IO : in Format; Str : in String) return String; function Header (IO : in Format; Str : in String) return String; end Text_IO; -------------- -- Debug_IO -- -------------- package body IO is ------------ -- Output -- ------------ function Output (Mode : in Format'Class) return String is Result : Unbounded_String; begin Result := Result & Title (Mode, "CGI complete runtime environment"); Result := Result & Header (Mode, "CGI parameters:") & New_Line (Mode); for K in 1 .. Argument_Count loop Result := Result & Variable (Mode, Key (K), Value (K)) & New_Line (Mode); end loop; Result := Result & New_Line (Mode) & Header (Mode, "CGI environment variables (Metavariables):") & New_Line (Mode); for P in Metavariable_Name'Range loop if Metavariable_Exists (P) then Result := Result & Variable (Mode, Metavariable_Name'Image (P), Metavariable (P)) & New_Line (Mode); end if; end loop; return To_String (Result); end Output; end IO; ------------- -- HTML_IO -- ------------- package body HTML_IO is NL : constant String := (1 => ASCII.LF); function Bold (S : in String) return String; -- Returns S as an HTML bold string. function Italic (S : in String) return String; -- Returns S as an HTML italic string. ---------- -- Bold -- ---------- function Bold (S : in String) return String is begin return "" & S & ""; end Bold; ------------ -- Header -- ------------ function Header (IO : in Format; Str : in String) return String is pragma Warnings (Off, IO); begin return "

" & Str & "

" & NL; end Header; ------------ -- Italic -- ------------ function Italic (S : in String) return String is begin return "" & S & ""; end Italic; -------------- -- New_Line -- -------------- function New_Line (IO : in Format) return String is pragma Warnings (Off, IO); begin return "
" & NL; end New_Line; ----------- -- Title -- ----------- function Title (IO : in Format; Str : in String) return String is pragma Warnings (Off, IO); begin return "

" & Str & "

" & NL; end Title; -------------- -- Variable -- -------------- function Variable (IO : Format; Name : String; Value : String) return String is pragma Warnings (Off, IO); begin return Bold (Name) & " = " & Italic (Value); end Variable; end HTML_IO; ------------- -- Text_IO -- ------------- package body Text_IO is ------------ -- Header -- ------------ function Header (IO : in Format; Str : in String) return String is begin return "*** " & Str & New_Line (IO); end Header; -------------- -- New_Line -- -------------- function New_Line (IO : in Format) return String is pragma Warnings (Off, IO); begin return String'(1 => ASCII.LF); end New_Line; ----------- -- Title -- ----------- function Title (IO : in Format; Str : in String) return String is Spaces : constant Natural := (80 - Str'Length) / 2; Indent : constant String (1 .. Spaces) := (others => ' '); begin return Indent & Str & New_Line (IO); end Title; -------------- -- Variable -- -------------- function Variable (IO : Format; Name : String; Value : String) return String is pragma Warnings (Off, IO); begin return " " & Name & " = " & Value; end Variable; end Text_IO; ----------------- -- HTML_Output -- ----------------- function HTML_Output return String is HTML : HTML_IO.Format; begin return IO.Output (Mode => HTML); end HTML_Output; ----------------- -- Text_Output -- ----------------- function Text_Output return String is Text : Text_IO.Format; begin return IO.Output (Mode => Text); end Text_Output; end GNAT.CGI.Debug;