1 |
#!/usr/bin/perl -w |
2 |
|
3 |
# Updates the built-in LSCP documentation reference of the LSCP shell. |
4 |
# |
5 |
# Copyright (c) 2014-2016 Christian Schoenebeck |
6 |
# |
7 |
# Extracts all sections from Documentation/lscp.xml marked with our magic |
8 |
# XML attribute "lscp_cmd=true" (and uses the section's "anchor" XML attribute |
9 |
# for *knowing* the respective exact LSCP command of the section). |
10 |
# Then src/network/lscp_shell_reference.cpp is generated by this script with |
11 |
# the documentation for each individual LSCP command extracted. |
12 |
# |
13 |
# Usage: generate_lscp_shell_reference.pl [--output=OUTFILE] [--debug-xml-extract] |
14 |
|
15 |
use XML::Parser; |
16 |
use Data::Dumper; # just for debugging |
17 |
use Storable qw(dclone); |
18 |
|
19 |
my $YACC_FILE = "../Documentation/lscp.xml"; |
20 |
my $REFERENCE_CPP_FILE = "../src/network/lscp_shell_reference.cpp"; |
21 |
|
22 |
########################################################################### |
23 |
# class MyDOM |
24 |
# |
25 |
# Wraps the data model returned by XML::Parser and provides convenient methods |
26 |
# to access the model in DOM style. Because the tree model provided by |
27 |
# XML::Parser uses a very inconvenient layout, which would require a lot of |
28 |
# hard readable and error prone code if accessed directly. |
29 |
|
30 |
package MyDOM; |
31 |
|
32 |
# $dom = MyDOM->new($doc); |
33 |
sub new { |
34 |
my ($class, $self) = @_; |
35 |
my $data = { |
36 |
'type' => 0, |
37 |
'attr' => 0, |
38 |
'content' => $self |
39 |
}; |
40 |
# print ::Dumper($self) . "\n"; |
41 |
return bless $data, $class; |
42 |
} |
43 |
|
44 |
# $element = $dom->element($name, [$index = 0]); |
45 |
sub element { |
46 |
my $self = shift @_; |
47 |
my $name = shift @_; |
48 |
my $nr = (@_) ? shift @_ : 0; |
49 |
my $content = $self->{content}; |
50 |
my $i = 0; |
51 |
my $k = 0; |
52 |
CYCLE: while ($i + 1 < @$content) { |
53 |
my $type = $content->[$i++]; |
54 |
my $subContent = $content->[$i++]; |
55 |
|
56 |
next CYCLE if ($type ne $name); |
57 |
|
58 |
if ($k == $nr) { |
59 |
my $attr = ($type && @$subContent) ? $subContent->[0] : 0; |
60 |
my $subContentClone = ($type) ? ::dclone($subContent) : $subContent; # clone it, since we will modify it next |
61 |
if ($attr && $type) { shift @$subContentClone; } # drop first element, which contains attributes |
62 |
my $data = { |
63 |
'type' => $type, |
64 |
'attr' => $attr, |
65 |
'content' => $subContentClone |
66 |
}; |
67 |
return bless $data, 'MyDOM'; |
68 |
} |
69 |
$k++; |
70 |
} |
71 |
return 0; |
72 |
} |
73 |
|
74 |
# $element = $dom->elementNr(4); |
75 |
sub elementNr { |
76 |
my $self = shift @_; |
77 |
my $nr = shift @_; |
78 |
my $content = $self->{content}; |
79 |
my $i = 0; |
80 |
my $k = 0; |
81 |
while ($i + 1 < @$content) { |
82 |
my $type = $content->[$i++]; |
83 |
my $subContent = $content->[$i++]; |
84 |
if ($k == $nr) { |
85 |
my $attr = ($type && @$subContent) ? $subContent->[0] : 0; |
86 |
# print "type $type\n"; |
87 |
# print ::Dumper($subContent) . "\n"; |
88 |
my $subContentClone = ($type) ? ::dclone($subContent) : $subContent; # clone it, since we will modify it next |
89 |
if ($attr && $type) { shift @$subContentClone; } # drop first element, which contains attributes |
90 |
my $data = { |
91 |
'type' => $type, |
92 |
'attr' => $attr, |
93 |
'content' => $subContentClone |
94 |
}; |
95 |
return bless $data, 'MyDOM'; |
96 |
} |
97 |
$k++; |
98 |
} |
99 |
return 0; |
100 |
} |
101 |
|
102 |
# $s = $element->name(); |
103 |
sub name { |
104 |
my $self = shift @_; |
105 |
return $self->{type}; |
106 |
} |
107 |
|
108 |
# $s = $element->attr("anchor"); |
109 |
sub attr { |
110 |
my $self = shift @_; |
111 |
my $name = shift @_; |
112 |
if (!$self->{attr} || !exists $self->{attr}->{$name}) { |
113 |
return 0; |
114 |
} |
115 |
return $self->{attr}->{$name}; |
116 |
} |
117 |
|
118 |
# $s = $element->body(); |
119 |
sub body { |
120 |
my $self = shift @_; |
121 |
$s = ""; |
122 |
if (!$self->{type}) { |
123 |
return $self->{content}; |
124 |
} |
125 |
for (my $i = 0; $self->elementNr($i); $i++) { |
126 |
$e = $self->elementNr($i); |
127 |
if (!$e->name()) { |
128 |
$s .= $e->{content}; |
129 |
} |
130 |
} |
131 |
return $s; |
132 |
} |
133 |
|
134 |
# $element->dumpMe(); |
135 |
sub dumpMe { |
136 |
my $self = shift @_; |
137 |
print "[dumpME()]: " . ::Dumper($self->{content}) . "\n"; |
138 |
} |
139 |
|
140 |
########################################################################### |
141 |
# main app |
142 |
|
143 |
package main; |
144 |
|
145 |
# parse command line argument(s) |
146 |
my $g_debug_xml_extract = 0; |
147 |
foreach $arg (@ARGV) { |
148 |
if ($arg eq "--debug-xml-extract") { |
149 |
$g_debug_xml_extract = 1; |
150 |
} elsif ($arg =~ /^--output/) { # argument --output=OUTFILE |
151 |
my ($name, $value) = split(/=|\s+/, $arg); # key value separated by space or "=" character |
152 |
$REFERENCE_CPP_FILE = $value; |
153 |
} |
154 |
} |
155 |
|
156 |
# will be populated by collectCommands() |
157 |
my $g_cmds = { }; |
158 |
|
159 |
# collectCommands($dom); |
160 |
sub collectCommands { |
161 |
my $dom = shift @_; |
162 |
for (my $i = 0; $dom->element("section", $i); $i++) { |
163 |
my $section = $dom->element("section", $i); |
164 |
if ($section->attr("lscp_cmd")) { |
165 |
if (!$section->attr("anchor")) { |
166 |
die "ERROR: Section deteced with 'lscp_cmd' attribute, but without 'anchor' attribute."; |
167 |
} |
168 |
my $name = $section->attr("anchor"); |
169 |
if (exists $g_cmds->{$name}) { |
170 |
die "ERROR: Multiple occurence of LSCP command detected: $name"; |
171 |
} |
172 |
$g_cmds->{$name} = $section; |
173 |
} else { |
174 |
collectCommands($section); |
175 |
} |
176 |
} |
177 |
} |
178 |
|
179 |
# removes redundant white spaces |
180 |
sub trimAll { |
181 |
my $s = shift; |
182 |
# replace tabs by space |
183 |
$s =~ s/\t/ /g; |
184 |
# replace occurences of more than one space character by only one space |
185 |
# character (including new line character) |
186 |
$s =~ s/\s+/ /g; |
187 |
# remove leading white spaces |
188 |
$s =~ s/^\s+//g; |
189 |
# remove trailing white spaces |
190 |
$s =~ s/\s+$//g; |
191 |
return $s; |
192 |
} |
193 |
|
194 |
# creates an optional space intended to be appended to the given string |
195 |
sub wordSepFor { |
196 |
my $s = shift; |
197 |
if ($s eq '') { return ""; } |
198 |
if ($s =~ /\n$/) { return ""; } |
199 |
return " "; |
200 |
} |
201 |
|
202 |
# $s = encodeXref($xref); |
203 |
sub encodeXref { |
204 |
my $xref = shift; |
205 |
return trimAll($xref->body()); |
206 |
} |
207 |
|
208 |
# $s = encodeT($t); |
209 |
sub encodeT { |
210 |
my $t = shift; |
211 |
my $s = ""; |
212 |
for (my $i = 0; $t->elementNr($i); $i++) { |
213 |
$e = $t->elementNr($i); |
214 |
$type = $e->name(); |
215 |
if (!$type) { |
216 |
$s .= wordSepFor($s); |
217 |
$s .= trimAll($e->body()); |
218 |
} elsif ($type eq "t") { |
219 |
$s .= wordSepFor($s); |
220 |
$s .= encodeT($e); |
221 |
} elsif ($type eq "list") { |
222 |
$s .= wordSepFor($s); |
223 |
$s .= encodeSection($e); |
224 |
} elsif ($type eq "xref") { |
225 |
$s .= wordSepFor($s); |
226 |
$s .= encodeXref($e); |
227 |
} |
228 |
} |
229 |
if (!($s =~ /\n\n$/)) { $s .= "\n\n"; } |
230 |
return $s; |
231 |
} |
232 |
|
233 |
# $s = encodeSection($section); |
234 |
sub encodeSection { |
235 |
my $section = shift; |
236 |
my $s = ""; |
237 |
for (my $i = 0; $section->elementNr($i); $i++) { |
238 |
$e = $section->elementNr($i); |
239 |
$type = $e->name(); |
240 |
if (!$type) { |
241 |
# nothing here for now |
242 |
} elsif ($type eq "t") { |
243 |
$s .= wordSepFor($s); |
244 |
$s .= encodeT($e); |
245 |
} elsif ($type eq "list") { |
246 |
$s .= wordSepFor($s); |
247 |
$s .= encodeSection($e); |
248 |
} elsif ($type eq "xref") { |
249 |
$s .= wordSepFor($s); |
250 |
$s .= encodeXref($e); |
251 |
} |
252 |
} |
253 |
return $s; |
254 |
} |
255 |
|
256 |
# open and parse lscp.xml |
257 |
my $parser = XML::Parser->new(Style => 'Tree'); |
258 |
my $doc = $parser->parsefile($YACC_FILE); |
259 |
my $dom = MyDOM->new($doc); |
260 |
my $middle = $dom->element("rfc")->element("middle"); |
261 |
|
262 |
# extract all sections from the document with the individual LSCP commands |
263 |
collectCommands($middle); |
264 |
|
265 |
# if --debug-xml-extract is supplied, just show the result of XML parsing and exit |
266 |
if ($g_debug_xml_extract) { |
267 |
while (my ($name, $section) = each(%$g_cmds)) { |
268 |
print "-> " . $name . "\n"; |
269 |
print encodeSection($section); |
270 |
} |
271 |
exit(0); |
272 |
} |
273 |
|
274 |
# start generating lscp_shell_reference.cpp ... |
275 |
open(OUT, ">", $REFERENCE_CPP_FILE) || die "Can't open LSCP shell doc reference C++ file for output"; |
276 |
print OUT <<EOF_BLOCK; |
277 |
/***************************************************************************** |
278 |
* * |
279 |
* LSCP documentation reference built into LSCP shell. * |
280 |
* * |
281 |
* Copyright (c) 2014 - 2016 Christian Schoenebeck * |
282 |
* * |
283 |
* This program is part of LinuxSampler and released under the same terms. * |
284 |
* * |
285 |
* This source file is auto generated by 'generate_lscp_shell_reference.pl' * |
286 |
* from 'lscp.xml'. Thus do not modify this C++ file directly! * |
287 |
* * |
288 |
*****************************************************************************/ |
289 |
|
290 |
/* |
291 |
This C++ file should automatically be re-generated if lscp.xml was |
292 |
modified, if not, you may call "make parser" explicitly. |
293 |
*/ |
294 |
|
295 |
#include "lscp_shell_reference.h" |
296 |
#include <string.h> |
297 |
|
298 |
static lscp_ref_entry_t lscp_reference[] = { |
299 |
EOF_BLOCK |
300 |
while (my ($name, $section) = each(%$g_cmds)) { |
301 |
# convert reference string block into C-style string format |
302 |
my $s = encodeSection($section); |
303 |
$s =~ s/\n/\\n/g; |
304 |
$s =~ s/\"/\\\"/g; |
305 |
# split reference string into equal length chunks, so we can distribute |
306 |
# them over lines, in order to not let them float behind 80 chars per line |
307 |
my @lines = unpack("(A70)*", $s); |
308 |
my $backSlashWrap = 0; |
309 |
print OUT " { \"$name\",\n"; |
310 |
foreach my $line (@lines) { |
311 |
if ($backSlashWrap) { $line = "\\" . $line; } |
312 |
$backSlashWrap = ($line =~ /\\$/); |
313 |
if ($backSlashWrap) { chop $line; } |
314 |
print OUT " \"$line\"\n"; |
315 |
|
316 |
} |
317 |
print OUT " },\n"; |
318 |
} |
319 |
print OUT <<EOF_BLOCK; |
320 |
}; |
321 |
|
322 |
lscp_ref_entry_t* lscp_reference_for_command(const char* cmd) { |
323 |
const int n1 = (int)strlen(cmd); |
324 |
if (!n1) return NULL; |
325 |
int foundLength = 0; |
326 |
lscp_ref_entry_t* foundEntry = NULL; |
327 |
for (int i = 0; i < sizeof(lscp_reference) / sizeof(lscp_ref_entry_t); ++i) { |
328 |
const int n2 = (int)strlen(lscp_reference[i].name); |
329 |
const int n = n1 < n2 ? n1 : n2; |
330 |
if (!strncmp(cmd, lscp_reference[i].name, n)) { |
331 |
if (foundEntry) { |
332 |
if (n1 < foundLength && n1 < n2) return NULL; |
333 |
if (n2 == foundLength) return NULL; |
334 |
if (n2 < foundLength) continue; |
335 |
} |
336 |
foundEntry = &lscp_reference[i]; |
337 |
foundLength = n2; |
338 |
} |
339 |
} |
340 |
return foundEntry; |
341 |
} |
342 |
EOF_BLOCK |
343 |
close(OUT); |
344 |
exit(0); # all done, success |