| 1 |
schoenebeck |
2534 |
#!/usr/bin/perl -w |
| 2 |
|
|
|
| 3 |
|
|
# Updates the built-in LSCP documentation reference of the LSCP shell. |
| 4 |
|
|
# |
| 5 |
schoenebeck |
3052 |
# Copyright (c) 2014-2016 Christian Schoenebeck |
| 6 |
schoenebeck |
2534 |
# |
| 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 |
schoenebeck |
3054 |
# Usage: generate_lscp_shell_reference.pl [--output=OUTFILE] [--debug-xml-extract] |
| 14 |
schoenebeck |
2534 |
|
| 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 |
schoenebeck |
3052 |
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 |
schoenebeck |
2534 |
} |
| 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 |
schoenebeck |
3054 |
* Copyright (c) 2014 - 2016 Christian Schoenebeck * |
| 282 |
schoenebeck |
2534 |
* * |
| 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 |
schoenebeck |
3054 |
const int n1 = (int)strlen(cmd); |
| 324 |
schoenebeck |
2534 |
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 |
schoenebeck |
3054 |
const int n2 = (int)strlen(lscp_reference[i].name); |
| 329 |
schoenebeck |
2534 |
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 |
Parent Directory
| 
Revision Log