1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- G N A T . C G I . D E B U G --
11 -- Copyright (C) 2000-2001 Ada Core Technologies, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
33 ------------------------------------------------------------------------------
35 with Ada.Strings.Unbounded;
37 package body GNAT.CGI.Debug is
39 use Ada.Strings.Unbounded;
42 -- Define the abstract type which act as a template for all debug IO mode.
43 -- To create a new IO mode you must:
44 -- 1. create a new package spec
45 -- 2. create a new type derived from IO.Format
46 -- 3. implement all the abstract rountines in IO
51 type Format is abstract tagged null record;
53 function Output (Mode : in Format'Class) return String;
61 -- Returns variable Name and its associated value.
67 -- Returns a new line such as this concatenated between two strings
68 -- will display the strings on two lines.
75 -- Returns Str as a Title. A title must be alone and centered on a
76 -- line. Next output will be on the following line.
83 -- Returns Str as an Header. An header must be alone on its line. Next
84 -- output will be on the following line.
94 -- see IO for comments about these routines.
96 type Format is new IO.Format with null record;
104 function New_Line (IO : in Format) return String;
106 function Title (IO : in Format; Str : in String) return String;
108 function Header (IO : in Format; Str : in String) return String;
113 -- IO for plain text mode
118 -- See IO for comments about these routines
120 type Format is new IO.Format with null record;
128 function New_Line (IO : in Format) return String;
130 function Title (IO : in Format; Str : in String) return String;
132 function Header (IO : in Format; Str : in String) return String;
146 function Output (Mode : in Format'Class) return String is
147 Result : Unbounded_String;
151 & Title (Mode, "CGI complete runtime environment");
154 & Header (Mode, "CGI parameters:")
157 for K in 1 .. Argument_Count loop
159 & Variable (Mode, Key (K), Value (K))
165 & Header (Mode, "CGI environment variables (Metavariables):")
168 for P in Metavariable_Name'Range loop
169 if Metavariable_Exists (P) then
172 Metavariable_Name'Image (P),
178 return To_String (Result);
187 package body HTML_IO is
189 NL : constant String := (1 => ASCII.LF);
191 function Bold (S : in String) return String;
192 -- Returns S as an HTML bold string.
194 function Italic (S : in String) return String;
195 -- Returns S as an HTML italic string.
201 function Bold (S : in String) return String is
203 return "<b>" & S & "</b>";
210 function Header (IO : in Format; Str : in String) return String is
212 return "<h2>" & Str & "</h2>" & NL;
219 function Italic (S : in String) return String is
221 return "<i>" & S & "</i>";
228 function New_Line (IO : in Format) return String is
237 function Title (IO : in Format; Str : in String) return String is
239 return "<p align=center><font size=+2>" & Str & "</font></p>" & NL;
253 return Bold (Name) & " = " & Italic (Value);
262 package body Text_IO is
268 function Header (IO : in Format; Str : in String) return String is
270 return "*** " & Str & New_Line (IO);
277 function New_Line (IO : in Format) return String is
279 return String'(1 => ASCII.LF);
286 function Title (IO : in Format; Str : in String) return String is
287 Spaces : constant Natural := (80 - Str'Length) / 2;
288 Indent : constant String (1 .. Spaces) := (others => ' ');
291 return Indent & Str & New_Line (IO);
305 return " " & Name & " = " & Value;
314 function HTML_Output return String is
315 HTML : HTML_IO.Format;
318 return IO.Output (Mode => HTML);
325 function Text_Output return String is
326 Text : Text_IO.Format;
329 return IO.Output (Mode => Text);