source: trunk/design/fastcgi/demo-callbacks.adb

Last change on this file was 4792, checked in by vadim.godunko, 7 years ago

Fix typo.

  • Property svn:keywords set to Author Date Revision
File size: 5.6 KB
Line 
1with Ada.Calendar;
2with Ada.Containers.Ordered_Sets;
3with Ada.Streams;
4
5with League.Stream_Element_Vectors;
6with League.Strings;
7with League.Text_Codecs;
8
9package body Demo.Callbacks is
10
11 function "+"
12 (Item : Wide_Wide_String) return League.Strings.Universal_String
13 renames League.Strings.To_Universal_String;
14
15 function Less
16 (Left : League.Strings.Universal_String;
17 Right : League.Strings.Universal_String) return Boolean;
18
19 package Sets is
20 new Ada.Containers.Ordered_Sets
21 (League.Strings.Universal_String,
22 Less,
23 League.Strings."=");
24
25 procedure Put
26 (Reply : in out FastCGI.Replies.Reply;
27 Item : League.Strings.Universal_String);
28 -- Outputs string into standard output stream of reply.
29
30 Startup : constant Ada.Calendar.Time := Ada.Calendar.Clock;
31
32 Page_Top : constant League.Strings.Universal_String
33 := +("<?xml version='1.1' encoding='utf-8'?>"
34 & "<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>"
35 & "<html xmlns='http://www.w3.org/1999/xhtml'>"
36 & "<head>"
37 & "<title>Matreshka's FastCGI and Unicode Collation demo</title>"
38 & "</head>"
39 & "<body>"
40 & "<p>This simple FastCGI application sorts set of strings with Unicode Collation Algorithm. You can enter own strings using text box and submit button.</p>"
41 & "<table>"
42 & "<tbody>");
43
44 Page_Middle : constant League.Strings.Universal_String
45 := +("</tbody>"
46 & "</table>"
47 & "<form action='");
48
49 Page_Bottom : constant League.Strings.Universal_String
50 := +("' method='POST' accept-charset='utf-8'>"
51 & "<input type='text' name='string'/>"
52 & "<input type='submit' name='submit'/>"
53 & "</form>");
54
55 Page_Done : constant League.Strings.Universal_String
56 := +("</body>"
57 & "</html>");
58
59 Codec : League.Text_Codecs.Text_Codec
60 := League.Text_Codecs.Codec
61 (League.Strings.To_Universal_String ("utf-8"));
62 String_Parameter :
63 constant League.Stream_Element_Vectors.Stream_Element_Vector
64 := Codec.Encode (+"string");
65 Script_Name_Header :
66 constant League.Stream_Element_Vectors.Stream_Element_Vector
67 := Codec.Encode (+"SCRIPT_NAME");
68
69 Strings : Sets.Set;
70 -- Set of strings. Strings are ordered in collation order.
71
72 -------------
73 -- Handler --
74 -------------
75
76 procedure Handler
77 (Request : FastCGI.Requests.Request;
78 Reply : out FastCGI.Replies.Reply;
79 Status : out Integer)
80 is
81 use type Ada.Calendar.Time;
82
83 procedure Output (Position : Sets.Cursor);
84 -- Outputs string pointed by Position.
85
86 ------------
87 -- Output --
88 ------------
89
90 procedure Output (Position : Sets.Cursor) is
91 Element : constant League.Strings.Universal_String
92 := Sets.Element (Position);
93
94 begin
95 Put (Reply, +"<tr><td>");
96 Put (Reply, Element);
97 Put (Reply, +"<td></tr>");
98 end Output;
99
100 begin
101 -- Process form parameters, if any.
102
103 if Request.Has_Raw_Query_Item (String_Parameter) then
104 Strings.Include
105 (Codec.Decode
106 (Request.Raw_Query_Item
107 (String_Parameter).To_Stream_Element_Array));
108 end if;
109
110 -- Prepare output.
111
112 Reply.Set_Content_Type (+"text/html");
113 Put (Reply, Page_Top);
114 Strings.Iterate (Output'Access);
115 Put (Reply, Page_Middle);
116 Put
117 (Reply,
118 Codec.Decode
119 (Request.Raw_Header (Script_Name_Header).To_Stream_Element_Array));
120 Put (Reply, Page_Bottom);
121 Put
122 (Reply,
123 League.Strings.To_Universal_String
124 ("<p>Uptime:"
125 & Duration'Wide_Wide_Image (Ada.Calendar.Clock - Startup)
126 & "</p>"));
127 Put (Reply, Page_Done);
128 Status := 0;
129 end Handler;
130
131 ----------
132 -- Less --
133 ----------
134
135 function Less
136 (Left : League.Strings.Universal_String;
137 Right : League.Strings.Universal_String) return Boolean
138 is
139 use type League.Strings.Sort_Key;
140
141 begin
142 return Left.Collation < Right.Collation;
143 end Less;
144
145 ---------
146 -- Put --
147 ---------
148
149 procedure Put
150 (Reply : in out FastCGI.Replies.Reply;
151 Item : League.Strings.Universal_String) is
152 begin
153 Ada.Streams.Stream_Element_Array'Write
154 (Reply.Stream,
155 Codec.Encode (Item).To_Stream_Element_Array);
156 end Put;
157
158begin
159 -- Turkish
160 Strings.Include (League.Strings.To_Universal_String ("merhaba dünya"));
161 -- Thai
162 Strings.Include (League.Strings.To_Universal_String ("สวัสดีชาวโลก"));
163 -- Korean
164 Strings.Include (League.Strings.To_Universal_String ("안녕하세요"));
165 -- Japanse
166 Strings.Include (League.Strings.To_Universal_String ("こんにちは世界"));
167 -- Hebrew
168 Strings.Include (League.Strings.To_Universal_String ("שלום העולם"));
169 -- Arabic
170 Strings.Include (League.Strings.To_Universal_String ("مرحبا العالم"));
171 -- Chinese
172 Strings.Include (League.Strings.To_Universal_String ("你好世界"));
173 -- German
174 Strings.Include (League.Strings.To_Universal_String ("Hallo Welt"));
175 -- Greek
176 Strings.Include (League.Strings.To_Universal_String ("Γεια σας κόσμο"));
177 -- English
178 Strings.Include (League.Strings.To_Universal_String ("Hello, world!"));
179 -- French
180 Strings.Include
181 (League.Strings.To_Universal_String ("Bonjour tout le monde"));
182 -- Russian
183 Strings.Include (League.Strings.To_Universal_String ("Здравствуй, мир!"));
184end Demo.Callbacks;
Note: See TracBrowser for help on using the repository browser.