1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- G N A T . C G I . D E B U G -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2000-2019, AdaCore -- 10-- -- 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 3, 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. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32with Ada.Strings.Unbounded; 33 34package body GNAT.CGI.Debug is 35 36 use Ada.Strings.Unbounded; 37 38 -- Define the abstract type which act as a template for all debug IO modes. 39 -- To create a new IO mode you must: 40 -- 1. create a new package spec 41 -- 2. create a new type derived from IO.Format 42 -- 3. implement all the abstract routines in IO 43 44 package IO is 45 46 type Format is abstract tagged null record; 47 48 function Output (Mode : Format'Class) return String; 49 50 function Variable 51 (Mode : Format; 52 Name : String; 53 Value : String) return String is abstract; 54 -- Returns variable Name and its associated value 55 56 function New_Line (Mode : Format) return String is abstract; 57 -- Returns a new line such as this concatenated between two strings 58 -- will display the strings on two lines. 59 60 function Title (Mode : Format; Str : String) return String is abstract; 61 -- Returns Str as a Title. A title must be alone and centered on a 62 -- line. Next output will be on the following line. 63 64 function Header 65 (Mode : Format; 66 Str : String) return String is abstract; 67 -- Returns Str as an Header. An header must be alone on its line. Next 68 -- output will be on the following line. 69 70 end IO; 71 72 ---------------------- 73 -- IO for HTML Mode -- 74 ---------------------- 75 76 package HTML_IO is 77 78 -- See IO for comments about these routines 79 80 type Format is new IO.Format with null record; 81 82 function Variable 83 (IO : Format; 84 Name : String; 85 Value : String) return String; 86 87 function New_Line (IO : Format) return String; 88 89 function Title (IO : Format; Str : String) return String; 90 91 function Header (IO : Format; Str : String) return String; 92 93 end HTML_IO; 94 95 ---------------------------- 96 -- IO for Plain Text Mode -- 97 ---------------------------- 98 99 package Text_IO is 100 101 -- See IO for comments about these routines 102 103 type Format is new IO.Format with null record; 104 105 function Variable 106 (IO : Format; 107 Name : String; 108 Value : String) return String; 109 110 function New_Line (IO : Format) return String; 111 112 function Title (IO : Format; Str : String) return String; 113 114 function Header (IO : Format; Str : String) return String; 115 116 end Text_IO; 117 118 -------------- 119 -- Debug_IO -- 120 -------------- 121 122 package body IO is 123 124 ------------ 125 -- Output -- 126 ------------ 127 128 function Output (Mode : Format'Class) return String is 129 Result : Unbounded_String; 130 131 begin 132 Result := 133 To_Unbounded_String 134 (Title (Mode, "CGI complete runtime environment") 135 & Header (Mode, "CGI parameters:") 136 & New_Line (Mode)); 137 138 for K in 1 .. Argument_Count loop 139 Result := Result 140 & Variable (Mode, Key (K), Value (K)) 141 & New_Line (Mode); 142 end loop; 143 144 Result := Result 145 & New_Line (Mode) 146 & Header (Mode, "CGI environment variables (Metavariables):") 147 & New_Line (Mode); 148 149 for P in Metavariable_Name'Range loop 150 if Metavariable_Exists (P) then 151 Result := Result 152 & Variable (Mode, 153 Metavariable_Name'Image (P), 154 Metavariable (P)) 155 & New_Line (Mode); 156 end if; 157 end loop; 158 159 return To_String (Result); 160 end Output; 161 162 end IO; 163 164 ------------- 165 -- HTML_IO -- 166 ------------- 167 168 package body HTML_IO is 169 170 NL : constant String := (1 => ASCII.LF); 171 172 function Bold (S : String) return String; 173 -- Returns S as an HTML bold string 174 175 function Italic (S : String) return String; 176 -- Returns S as an HTML italic string 177 178 ---------- 179 -- Bold -- 180 ---------- 181 182 function Bold (S : String) return String is 183 begin 184 return "<b>" & S & "</b>"; 185 end Bold; 186 187 ------------ 188 -- Header -- 189 ------------ 190 191 function Header (IO : Format; Str : String) return String is 192 pragma Unreferenced (IO); 193 begin 194 return "<h2>" & Str & "</h2>" & NL; 195 end Header; 196 197 ------------ 198 -- Italic -- 199 ------------ 200 201 function Italic (S : String) return String is 202 begin 203 return "<i>" & S & "</i>"; 204 end Italic; 205 206 -------------- 207 -- New_Line -- 208 -------------- 209 210 function New_Line (IO : Format) return String is 211 pragma Unreferenced (IO); 212 begin 213 return "<br>" & NL; 214 end New_Line; 215 216 ----------- 217 -- Title -- 218 ----------- 219 220 function Title (IO : Format; Str : String) return String is 221 pragma Unreferenced (IO); 222 begin 223 return "<p align=center><font size=+2>" & Str & "</font></p>" & NL; 224 end Title; 225 226 -------------- 227 -- Variable -- 228 -------------- 229 230 function Variable 231 (IO : Format; 232 Name : String; 233 Value : String) return String 234 is 235 pragma Unreferenced (IO); 236 begin 237 return Bold (Name) & " = " & Italic (Value); 238 end Variable; 239 240 end HTML_IO; 241 242 ------------- 243 -- Text_IO -- 244 ------------- 245 246 package body Text_IO is 247 248 ------------ 249 -- Header -- 250 ------------ 251 252 function Header (IO : Format; Str : String) return String is 253 begin 254 return "*** " & Str & New_Line (IO); 255 end Header; 256 257 -------------- 258 -- New_Line -- 259 -------------- 260 261 function New_Line (IO : Format) return String is 262 pragma Unreferenced (IO); 263 begin 264 return String'(1 => ASCII.LF); 265 end New_Line; 266 267 ----------- 268 -- Title -- 269 ----------- 270 271 function Title (IO : Format; Str : String) return String is 272 Spaces : constant Natural := (80 - Str'Length) / 2; 273 Indent : constant String (1 .. Spaces) := (others => ' '); 274 begin 275 return Indent & Str & New_Line (IO); 276 end Title; 277 278 -------------- 279 -- Variable -- 280 -------------- 281 282 function Variable 283 (IO : Format; 284 Name : String; 285 Value : String) return String 286 is 287 pragma Unreferenced (IO); 288 begin 289 return " " & Name & " = " & Value; 290 end Variable; 291 292 end Text_IO; 293 294 ----------------- 295 -- HTML_Output -- 296 ----------------- 297 298 function HTML_Output return String is 299 HTML : HTML_IO.Format; 300 begin 301 return IO.Output (Mode => HTML); 302 end HTML_Output; 303 304 ----------------- 305 -- Text_Output -- 306 ----------------- 307 308 function Text_Output return String is 309 Text : Text_IO.Format; 310 begin 311 return IO.Output (Mode => Text); 312 end Text_Output; 313 314end GNAT.CGI.Debug; 315