+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- G N A T . C G I . D E B U G --
--- --
--- B o d y --
--- --
--- $Revision: 1.1 $
--- --
--- 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 "<b>" & S & "</b>";
- end Bold;
-
- ------------
- -- Header --
- ------------
-
- function Header (IO : in Format; Str : in String) return String is
- begin
- return "<h2>" & Str & "</h2>" & NL;
- end Header;
-
- ------------
- -- Italic --
- ------------
-
- function Italic (S : in String) return String is
- begin
- return "<i>" & S & "</i>";
- end Italic;
-
- --------------
- -- New_Line --
- --------------
-
- function New_Line (IO : in Format) return String is
- begin
- return "<br>" & NL;
- end New_Line;
-
- -----------
- -- Title --
- -----------
-
- function Title (IO : in Format; Str : in String) return String is
- begin
- return "<p align=center><font size=+2>" & Str & "</font></p>" & NL;
- end Title;
-
- --------------
- -- Variable --
- --------------
-
- function Variable
- (IO : Format;
- Name : String;
- Value : String)
- return String
- is
- 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
- 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
- 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;
projects / msp430-gcc.git / blobdiff