/[svn]/linuxsampler/trunk/scripts/generate_lscp_shell_reference.pl
ViewVC logotype

Contents of /linuxsampler/trunk/scripts/generate_lscp_shell_reference.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3054 - (show annotations) (download)
Thu Dec 15 12:47:45 2016 UTC (7 years, 3 months ago) by schoenebeck
File MIME type: text/plain
File size: 10682 byte(s)
* Fixed numerous compiler warnings.
* Bumped version (2.0.0.svn32).

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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC