1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- G N A T . C G I . D E B U G --
9 -- Copyright (C) 2000-2001 Ada Core Technologies, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada.Strings.Unbounded;
36 package body GNAT.CGI.Debug is
38 use Ada.Strings.Unbounded;
41 -- Define the abstract type which act as a template for all debug IO mode.
42 -- To create a new IO mode you must:
43 -- 1. create a new package spec
44 -- 2. create a new type derived from IO.Format
45 -- 3. implement all the abstract rountines in IO
50 type Format is abstract tagged null record;
52 function Output (Mode : in Format'Class) return String;
60 -- Returns variable Name and its associated value.
66 -- Returns a new line such as this concatenated between two strings
67 -- will display the strings on two lines.
74 -- Returns Str as a Title. A title must be alone and centered on a
75 -- line. Next output will be on the following line.
82 -- Returns Str as an Header. An header must be alone on its line. Next
83 -- output will be on the following line.
93 -- see IO for comments about these routines.
95 type Format is new IO.Format with null record;
103 function New_Line (IO : in Format) return String;
105 function Title (IO : in Format; Str : in String) return String;
107 function Header (IO : in Format; Str : in String) return String;
112 -- IO for plain text mode
117 -- See IO for comments about these routines
119 type Format is new IO.Format with null record;
127 function New_Line (IO : in Format) return String;
129 function Title (IO : in Format; Str : in String) return String;
131 function Header (IO : in Format; Str : in String) return String;
145 function Output (Mode : in Format'Class) return String is
146 Result : Unbounded_String;
150 & Title (Mode, "CGI complete runtime environment");
153 & Header (Mode, "CGI parameters:")
156 for K in 1 .. Argument_Count loop
158 & Variable (Mode, Key (K), Value (K))
164 & Header (Mode, "CGI environment variables (Metavariables):")
167 for P in Metavariable_Name'Range loop
168 if Metavariable_Exists (P) then
171 Metavariable_Name'Image (P),
177 return To_String (Result);
186 package body HTML_IO is
188 NL : constant String := (1 => ASCII.LF);
190 function Bold (S : in String) return String;
191 -- Returns S as an HTML bold string.
193 function Italic (S : in String) return String;
194 -- Returns S as an HTML italic string.
200 function Bold (S : in String) return String is
202 return "<b>" & S & "</b>";
209 function Header (IO : in Format; Str : in String) return String is
210 pragma Warnings (Off, IO);
213 return "<h2>" & Str & "</h2>" & NL;
220 function Italic (S : in String) return String is
222 return "<i>" & S & "</i>";
229 function New_Line (IO : in Format) return String is
230 pragma Warnings (Off, IO);
240 function Title (IO : in Format; Str : in String) return String is
241 pragma Warnings (Off, IO);
244 return "<p align=center><font size=+2>" & Str & "</font></p>" & NL;
257 pragma Warnings (Off, IO);
260 return Bold (Name) & " = " & Italic (Value);
269 package body Text_IO is
275 function Header (IO : in Format; Str : in String) return String is
277 return "*** " & Str & New_Line (IO);
284 function New_Line (IO : in Format) return String is
285 pragma Warnings (Off, IO);
288 return String'(1 => ASCII.LF);
295 function Title (IO : in Format; Str : in String) return String is
296 Spaces : constant Natural := (80 - Str'Length) / 2;
297 Indent : constant String (1 .. Spaces) := (others => ' ');
300 return Indent & Str & New_Line (IO);
313 pragma Warnings (Off, IO);
316 return " " & Name & " = " & Value;
325 function HTML_Output return String is
326 HTML : HTML_IO.Format;
329 return IO.Output (Mode => HTML);
336 function Text_Output return String is
337 Text : Text_IO.Format;
340 return IO.Output (Mode => Text);