with Ada.Strings.Unbounded;
package body GNAT.CGI.Debug is
use Ada.Strings.Unbounded;
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;
function New_Line
(Mode : Format)
return String
is abstract;
function Title
(Mode : Format;
Str : String)
return String
is abstract;
function Header
(Mode : Format;
Str : String)
return String
is abstract;
end IO;
package HTML_IO is
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;
package Text_IO is
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;
package body IO is
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;
package body HTML_IO is
NL : constant String := (1 => ASCII.LF);
function Bold (S : in String) return String;
function Italic (S : in String) return String;
function Bold (S : in String) return String is
begin
return "<b>" & S & "</b>";
end Bold;
function Header (IO : in Format; Str : in String) return String is
pragma Warnings (Off, IO);
begin
return "<h2>" & Str & "</h2>" & NL;
end Header;
function Italic (S : in String) return String is
begin
return "<i>" & S & "</i>";
end Italic;
function New_Line (IO : in Format) return String is
pragma Warnings (Off, IO);
begin
return "<br>" & NL;
end New_Line;
function Title (IO : in Format; Str : in String) return String is
pragma Warnings (Off, IO);
begin
return "<p align=center><font size=+2>" & Str & "</font></p>" & NL;
end Title;
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;
package body Text_IO is
function Header (IO : in Format; Str : in String) return String is
begin
return "*** " & Str & New_Line (IO);
end Header;
function New_Line (IO : in Format) return String is
pragma Warnings (Off, IO);
begin
return String'(1 => ASCII.LF);
end New_Line;
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;
function Variable
(IO : Format;
Name : String;
Value : String)
return String
is
pragma Warnings (Off, IO);
begin
return " " & Name & " = " & Value;
end Variable;
end Text_IO;
function HTML_Output return String is
HTML : HTML_IO.Format;
begin
return IO.Output (Mode => HTML);
end HTML_Output;
function Text_Output return String is
Text : Text_IO.Format;
begin
return IO.Output (Mode => Text);
end Text_Output;
end GNAT.CGI.Debug;