1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198 | -----------------------------------------------------------------------
-- util-commands-drivers -- Support to make command line tools
-- Copyright (C) 2017, 2018, 2019 Stephane Carrez
-- Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-----------------------------------------------------------------------
with Util.Log;
with Util.Commands.Parsers;
private with Ada.Strings.Unbounded;
private with Ada.Containers.Ordered_Sets;
-- == Command line driver ==
-- The `Util.Commands.Drivers` generic package provides a support to build command line
-- tools that have different commands identified by a name. It defines the `Driver_Type`
-- tagged record that provides a registry of application commands. It gives entry points
-- to register commands and execute them.
--
-- The `Context_Type` package parameter defines the type for the `Context` parameter
-- that is passed to the command when it is executed. It can be used to provide
-- application specific context to the command.
--
-- The `Config_Parser` describes the parser package that will handle the analysis of
-- command line options. To use the GNAT options parser, it is possible to use the
-- `Util.Commands.Parsers.GNAT_Parser` package.
generic
-- The command execution context.
type Context_Type (<>) is limited private;
with package Config_Parser is new Util.Commands.Parsers.Config_Parser (<>);
with function Translate (Message : in String) return String is No_Translate;
Driver_Name : String := "Drivers";
package Util.Commands.Drivers is
subtype Config_Type is Config_Parser.Config_Type;
-- A simple command handler executed when the command with the given name is executed.
type Command_Handler is not null access procedure (Name : in String;
Args : in Argument_List'Class;
Context : in out Context_Type);
-- A more complex command handler that has a command instance as context.
type Command_Type is abstract tagged limited private;
type Command_Access is access all Command_Type'Class;
-- Get the description associated with the command.
function Get_Description (Command : in Command_Type) return String;
-- Get the name used to register the command.
function Get_Name (Command : in Command_Type) return String;
-- Execute the command with the arguments. The command name is passed with the command
-- arguments.
procedure Execute (Command : in out Command_Type;
Name : in String;
Args : in Argument_List'Class;
Context : in out Context_Type) is abstract;
-- Setup the command before parsing the arguments and executing it.
procedure Setup (Command : in out Command_Type;
Config : in out Config_Type;
Context : in out Context_Type) is null;
-- Write the help associated with the command.
procedure Help (Command : in out Command_Type;
Name : in String;
Context : in out Context_Type) is abstract;
-- Write the command usage.
procedure Usage (Command : in out Command_Type;
Name : in String;
Context : in out Context_Type);
-- Print a message for the command. The level indicates whether the message is an error,
-- warning or informational. The command name can be used to known the originator.
-- The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
procedure Log (Command : in Command_Type;
Level : in Util.Log.Level_Type;
Name : in String;
Message : in String);
type Help_Command_Type is new Command_Type with private;
-- Execute the help command with the arguments.
-- Print the help for every registered command.
overriding
procedure Execute (Command : in out Help_Command_Type;
Name : in String;
Args : in Argument_List'Class;
Context : in out Context_Type);
-- Write the help associated with the command.
overriding
procedure Help (Command : in out Help_Command_Type;
Name : in String;
Context : in out Context_Type);
type Driver_Type is tagged limited private;
-- Report the command usage.
procedure Usage (Driver : in Driver_Type;
Args : in Argument_List'Class;
Context : in out Context_Type;
Name : in String := "");
-- Set the driver description printed in the usage.
procedure Set_Description (Driver : in out Driver_Type;
Description : in String);
-- Set the driver usage printed in the usage.
procedure Set_Usage (Driver : in out Driver_Type;
Usage : in String);
-- Register the command under the given name.
procedure Add_Command (Driver : in out Driver_Type;
Name : in String;
Command : in Command_Access);
procedure Add_Command (Driver : in out Driver_Type;
Name : in String;
Description : in String;
Command : in Command_Access);
-- Register the command under the given name.
procedure Add_Command (Driver : in out Driver_Type;
Name : in String;
Description : in String;
Handler : in Command_Handler);
-- Find the command having the given name.
-- Returns null if the command was not found.
function Find_Command (Driver : in Driver_Type;
Name : in String) return Command_Access;
-- Execute the command registered under the given name.
procedure Execute (Driver : in Driver_Type;
Name : in String;
Args : in Argument_List'Class;
Context : in out Context_Type);
-- Print a message for the command. The level indicates whether the message is an error,
-- warning or informational. The command name can be used to known the originator.
procedure Log (Driver : in Driver_Type;
Level : in Util.Log.Level_Type;
Name : in String;
Message : in String);
private
type Command_Type is abstract tagged limited record
Driver : access Driver_Type'Class;
Name : Ada.Strings.Unbounded.Unbounded_String;
Description : Ada.Strings.Unbounded.Unbounded_String;
end record;
function "<" (Left, Right : in Command_Access) return Boolean is
(Ada.Strings.Unbounded."<" (Left.Name, Right.Name));
package Command_Sets is
new Ada.Containers.Ordered_Sets (Element_Type => Command_Access,
"<" => "<",
"=" => "=");
type Help_Command_Type is new Command_Type with null record;
type Handler_Command_Type is new Command_Type with record
Handler : Command_Handler;
end record;
-- Execute the command with the arguments.
overriding
procedure Execute (Command : in out Handler_Command_Type;
Name : in String;
Args : in Argument_List'Class;
Context : in out Context_Type);
-- Write the help associated with the command.
overriding
procedure Help (Command : in out Handler_Command_Type;
Name : in String;
Context : in out Context_Type);
type Driver_Type is tagged limited record
List : Command_Sets.Set;
Desc : Ada.Strings.Unbounded.Unbounded_String;
Usage : Ada.Strings.Unbounded.Unbounded_String;
end record;
end Util.Commands.Drivers;
|