trunk/scripts/generate_lscp_shell_reference.pl

#!/usr/bin/perl -w

# Updates the built-in LSCP documentation reference of the LSCP shell.
#
# Copyright (c) 2014 Christian Schoenebeck
#
# Extracts all sections from Documentation/lscp.xml marked with our magic
# XML attribute "lscp_cmd=true" (and uses the section's "anchor" XML attribute
# for *knowing* the respective exact LSCP command of the section).
# Then src/network/lscp_shell_reference.cpp is generated by this script with
# the documentation for each individual LSCP command extracted.
#
# Usage: generate_lscp_shell_reference.pl

use XML::Parser;
use Data::Dumper; # just for debugging
use Storable qw(dclone);

my $YACC_FILE = "../Documentation/lscp.xml";
my $REFERENCE_CPP_FILE = "../src/network/lscp_shell_reference.cpp";

###########################################################################
# class MyDOM
#
# Wraps the data model returned by XML::Parser and provides convenient methods
# to access the model in DOM style. Because the tree model provided by
# XML::Parser uses a very inconvenient layout, which would require a lot of
# hard readable and error prone code if accessed directly.

package MyDOM;

# $dom = MyDOM->new($doc);
sub new {
    my ($class, $self) = @_;    
    my $data = {
        'type'    => 0,
        'attr'    => 0,
        'content' => $self
    };
#     print ::Dumper($self) . "\n";
    return bless $data, $class;
}

# $element = $dom->element($name, [$index = 0]);
sub element {
    my $self = shift @_;
    my $name = shift @_;
    my $nr    = (@_) ? shift @_ : 0;
    my $content = $self->{content};
    my $i = 0;
    my $k = 0;
    CYCLE: while ($i + 1 < @$content) {
        my $type = $content->[$i++];
        my $subContent = $content->[$i++];

        next CYCLE if ($type ne $name);

        if ($k == $nr) {
            my $attr = ($type && @$subContent) ? $subContent->[0] : 0;
            my $subContentClone = ($type) ? ::dclone($subContent) : $subContent; # clone it, since we will modify it next
            if ($attr && $type) { shift @$subContentClone; } # drop first element, which contains attributes
            my $data = {
                'type'    => $type,
                'attr'    => $attr,
                'content' => $subContentClone
            };
            return bless $data, 'MyDOM';
        }
        $k++;
    }
    return 0;
}

# $element = $dom->elementNr(4);
sub elementNr {
    my $self = shift @_;
    my $nr   = shift @_;
    my $content = $self->{content};
    my $i = 0;
    my $k = 0;
    while ($i + 1 < @$content) {
        my $type = $content->[$i++];
        my $subContent = $content->[$i++];
        if ($k == $nr) {
            my $attr = ($type && @$subContent) ? $subContent->[0] : 0;
# print "type $type\n";
# print ::Dumper($subContent) . "\n";
            my $subContentClone = ($type) ? ::dclone($subContent) : $subContent; # clone it, since we will modify it next
            if ($attr && $type) { shift @$subContentClone; } # drop first element, which contains attributes
            my $data = {
                'type'    => $type,
                'attr'    => $attr,
                'content' => $subContentClone
            };
            return bless $data, 'MyDOM';
        }
        $k++;
    }
    return 0;
}

# $s = $element->name();
sub name {
    my $self = shift @_;
    return $self->{type};
}

# $s = $element->attr("anchor");
sub attr {
    my $self = shift @_;
    my $name = shift @_;
    if (!$self->{attr} || !exists $self->{attr}->{$name}) {
        return 0;
    }
    return $self->{attr}->{$name};
}

# $s = $element->body();
sub body {
    my $self = shift @_;
    $s = "";
    if (!$self->{type}) {
        return $self->{content};
    }
    for (my $i = 0; $self->elementNr($i); $i++) {
        $e = $self->elementNr($i);
        if (!$e->name()) {
            $s .= $e->{content};
        }
    }
    return $s;
}

# $element->dumpMe();
sub dumpMe {
    my $self = shift @_;
    print "[dumpME()]: " . ::Dumper($self->{content}) . "\n";
}

###########################################################################
# main app

package main;

# parse command line argument(s)
my $g_debug_xml_extract = 0;
if (defined($ARGV[0]) and $ARGV[0] eq "--debug-xml-extract") {
    $g_debug_xml_extract = 1;
}

# will be populated by collectCommands()
my $g_cmds = { };

# collectCommands($dom);
sub collectCommands {
    my $dom = shift @_;
    for (my $i = 0; $dom->element("section", $i); $i++) {
        my $section = $dom->element("section", $i);
        if ($section->attr("lscp_cmd")) {
            if (!$section->attr("anchor")) {
                die "ERROR: Section deteced with 'lscp_cmd' attribute, but without 'anchor' attribute.";
            }
            my $name = $section->attr("anchor");
            if (exists $g_cmds->{$name}) {
                die "ERROR: Multiple occurence of LSCP command detected: $name";
            }
            $g_cmds->{$name} = $section;
        } else {
            collectCommands($section);
        }
    }
}

# removes redundant white spaces
sub trimAll {
    my $s = shift;
    # replace tabs by space
    $s =~ s/\t/ /g;
    # replace occurences of more than one space character by only one space
    # character (including new line character)
    $s =~ s/\s+/ /g;
    # remove leading white spaces
    $s =~ s/^\s+//g;
    # remove trailing white spaces
    $s =~ s/\s+$//g;
    return $s;
}

# creates an optional space intended to be appended to the given string
sub wordSepFor {
    my $s = shift;
    if ($s eq '') { return ""; }
    if ($s =~ /\n$/) { return ""; }
    return " ";
}

# $s = encodeXref($xref);
sub encodeXref {
    my $xref = shift;
    return trimAll($xref->body());
}

# $s = encodeT($t);
sub encodeT {
    my $t = shift;
    my $s = "";
    for (my $i = 0; $t->elementNr($i); $i++) {
        $e = $t->elementNr($i);
        $type = $e->name();
        if (!$type) {
            $s .= wordSepFor($s);
            $s .= trimAll($e->body());
        } elsif ($type eq "t") {
            $s .= wordSepFor($s);
            $s .= encodeT($e);
        } elsif ($type eq "list") {
            $s .= wordSepFor($s);
            $s .= encodeSection($e);
        } elsif ($type eq "xref") {
            $s .= wordSepFor($s);
            $s .= encodeXref($e);
        }
    }
    if (!($s =~ /\n\n$/)) { $s .= "\n\n"; }
    return $s;
}

# $s = encodeSection($section);
sub encodeSection {
    my $section = shift;
    my $s = "";
    for (my $i = 0; $section->elementNr($i); $i++) {
        $e = $section->elementNr($i);
        $type = $e->name();
        if (!$type) {
            # nothing here for now
        } elsif ($type eq "t") {
            $s .= wordSepFor($s);
            $s .= encodeT($e);
        } elsif ($type eq "list") {
            $s .= wordSepFor($s);
            $s .= encodeSection($e);
        } elsif ($type eq "xref") {
            $s .= wordSepFor($s);
            $s .= encodeXref($e);
        }
    }
    return $s;
}

# open and parse lscp.xml
my $parser = XML::Parser->new(Style => 'Tree');
my $doc = $parser->parsefile($YACC_FILE);
my $dom = MyDOM->new($doc);
my $middle = $dom->element("rfc")->element("middle");

# extract all sections from the document with the individual LSCP commands
collectCommands($middle);

# if --debug-xml-extract is supplied, just show the result of XML parsing and exit
if ($g_debug_xml_extract) {
    while (my ($name, $section) = each(%$g_cmds)) {
        print "-> " . $name . "\n";
        print encodeSection($section);
    }
    exit(0);
}

# start generating lscp_shell_reference.cpp ...
open(OUT, ">", $REFERENCE_CPP_FILE) || die "Can't open LSCP shell doc reference C++ file for output";
print OUT <<EOF_BLOCK;
/*****************************************************************************
 *                                                                           *
 *  LSCP documentation reference built into LSCP shell.                      *
 *                                                                           *
 *  Copyright (c) 2014 Christian Schoenebeck                                 *
 *                                                                           *
 *  This program is part of LinuxSampler and released under the same terms.  *
 *                                                                           *
 *  This source file is auto generated by 'generate_lscp_shell_reference.pl' *
 *  from 'lscp.xml'. Thus do not modify this C++ file directly!              *
 *                                                                           *
 *****************************************************************************/

/*
   This C++ file should automatically be re-generated if lscp.xml was
   modified, if not, you may call "make parser" explicitly.
 */

#include "lscp_shell_reference.h"
#include <string.h>

static lscp_ref_entry_t lscp_reference[] = {
EOF_BLOCK
while (my ($name, $section) = each(%$g_cmds)) {
    # convert reference string block into C-style string format
    my $s = encodeSection($section);
    $s =~ s/\n/\\n/g;
    $s =~ s/\"/\\\"/g;
    # split reference string into equal length chunks, so we can distribute
    # them over lines, in order to not let them float behind 80 chars per line
    my @lines = unpack("(A70)*", $s);
    my $backSlashWrap = 0;
    print OUT "    { \"$name\",\n";
    foreach my $line (@lines) {
        if ($backSlashWrap) { $line = "\\" . $line; }
        $backSlashWrap = ($line =~ /\\$/);
        if ($backSlashWrap) { chop $line; }
        print OUT "      \"$line\"\n";
        
    }
    print OUT "    },\n";
}
print OUT <<EOF_BLOCK;
};

lscp_ref_entry_t* lscp_reference_for_command(const char* cmd) {
    const int n1 = strlen(cmd);
    if (!n1) return NULL;
    int foundLength = 0;
    lscp_ref_entry_t* foundEntry = NULL;
    for (int i = 0; i < sizeof(lscp_reference) / sizeof(lscp_ref_entry_t); ++i) {
        const int n2 = strlen(lscp_reference[i].name);
        const int n = n1 < n2 ? n1 : n2;
        if (!strncmp(cmd, lscp_reference[i].name, n)) {
            if (foundEntry) {
                if (n1 < foundLength && n1 < n2) return NULL;
                if (n2 == foundLength) return NULL;
                if (n2 < foundLength) continue;
            }
            foundEntry  = &lscp_reference[i];
            foundLength = n2;
        }
    }
    return foundEntry;
}
EOF_BLOCK
close(OUT);
exit(0); # all done, success
1	#!/usr/bin/perl -w
2
3	# Updates the built-in LSCP documentation reference of the LSCP shell.
4	#
5	# Copyright (c) 2014 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
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	if (defined($ARGV[0]) and $ARGV[0] eq "--debug-xml-extract") {
148	$g_debug_xml_extract = 1;
149	}
150
151	# will be populated by collectCommands()
152	my $g_cmds = { };
153
154	# collectCommands($dom);
155	sub collectCommands {
156	my $dom = shift @_;
157	for (my $i = 0; $dom->element("section", $i); $i++) {
158	my $section = $dom->element("section", $i);
159	if ($section->attr("lscp_cmd")) {
160	if (!$section->attr("anchor")) {
161	die "ERROR: Section deteced with 'lscp_cmd' attribute, but without 'anchor' attribute.";
162	}
163	my $name = $section->attr("anchor");
164	if (exists $g_cmds->{$name}) {
165	die "ERROR: Multiple occurence of LSCP command detected: $name";
166	}
167	$g_cmds->{$name} = $section;
168	} else {
169	collectCommands($section);
170	}
171	}
172	}
173
174	# removes redundant white spaces
175	sub trimAll {
176	my $s = shift;
177	# replace tabs by space
178	$s =~ s/\t/ /g;
179	# replace occurences of more than one space character by only one space
180	# character (including new line character)
181	$s =~ s/\s+/ /g;
182	# remove leading white spaces
183	$s =~ s/^\s+//g;
184	# remove trailing white spaces
185	$s =~ s/\s+$//g;
186	return $s;
187	}
188
189	# creates an optional space intended to be appended to the given string
190	sub wordSepFor {
191	my $s = shift;
192	if ($s eq '') { return ""; }
193	if ($s =~ /\n$/) { return ""; }
194	return " ";
195	}
196
197	# $s = encodeXref($xref);
198	sub encodeXref {
199	my $xref = shift;
200	return trimAll($xref->body());
201	}
202
203	# $s = encodeT($t);
204	sub encodeT {
205	my $t = shift;
206	my $s = "";
207	for (my $i = 0; $t->elementNr($i); $i++) {
208	$e = $t->elementNr($i);
209	$type = $e->name();
210	if (!$type) {
211	$s .= wordSepFor($s);
212	$s .= trimAll($e->body());
213	} elsif ($type eq "t") {
214	$s .= wordSepFor($s);
215	$s .= encodeT($e);
216	} elsif ($type eq "list") {
217	$s .= wordSepFor($s);
218	$s .= encodeSection($e);
219	} elsif ($type eq "xref") {
220	$s .= wordSepFor($s);
221	$s .= encodeXref($e);
222	}
223	}
224	if (!($s =~ /\n\n$/)) { $s .= "\n\n"; }
225	return $s;
226	}
227
228	# $s = encodeSection($section);
229	sub encodeSection {
230	my $section = shift;
231	my $s = "";
232	for (my $i = 0; $section->elementNr($i); $i++) {
233	$e = $section->elementNr($i);
234	$type = $e->name();
235	if (!$type) {
236	# nothing here for now
237	} elsif ($type eq "t") {
238	$s .= wordSepFor($s);
239	$s .= encodeT($e);
240	} elsif ($type eq "list") {
241	$s .= wordSepFor($s);
242	$s .= encodeSection($e);
243	} elsif ($type eq "xref") {
244	$s .= wordSepFor($s);
245	$s .= encodeXref($e);
246	}
247	}
248	return $s;
249	}
250
251	# open and parse lscp.xml
252	my $parser = XML::Parser->new(Style => 'Tree');
253	my $doc = $parser->parsefile($YACC_FILE);
254	my $dom = MyDOM->new($doc);
255	my $middle = $dom->element("rfc")->element("middle");
256
257	# extract all sections from the document with the individual LSCP commands
258	collectCommands($middle);
259
260	# if --debug-xml-extract is supplied, just show the result of XML parsing and exit
261	if ($g_debug_xml_extract) {
262	while (my ($name, $section) = each(%$g_cmds)) {
263	print "-> " . $name . "\n";
264	print encodeSection($section);
265	}
266	exit(0);
267	}
268
269	# start generating lscp_shell_reference.cpp ...
270	open(OUT, ">", $REFERENCE_CPP_FILE) \|\| die "Can't open LSCP shell doc reference C++ file for output";
271	print OUT <<EOF_BLOCK;
272	/*****************************************************************************
273	* *
274	* LSCP documentation reference built into LSCP shell. *
275	* *
276	* Copyright (c) 2014 Christian Schoenebeck *
277	* *
278	* This program is part of LinuxSampler and released under the same terms. *
279	* *
280	* This source file is auto generated by 'generate_lscp_shell_reference.pl' *
281	* from 'lscp.xml'. Thus do not modify this C++ file directly! *
282	* *
283	*****************************************************************************/
284
285	/*
286	This C++ file should automatically be re-generated if lscp.xml was
287	modified, if not, you may call "make parser" explicitly.
288	*/
289
290	#include "lscp_shell_reference.h"
291	#include <string.h>
292
293	static lscp_ref_entry_t lscp_reference[] = {
294	EOF_BLOCK
295	while (my ($name, $section) = each(%$g_cmds)) {
296	# convert reference string block into C-style string format
297	my $s = encodeSection($section);
298	$s =~ s/\n/\\n/g;
299	$s =~ s/\"/\\\"/g;
300	# split reference string into equal length chunks, so we can distribute
301	# them over lines, in order to not let them float behind 80 chars per line
302	my @lines = unpack("(A70)*", $s);
303	my $backSlashWrap = 0;
304	print OUT " { \"$name\",\n";
305	foreach my $line (@lines) {
306	if ($backSlashWrap) { $line = "\\" . $line; }
307	$backSlashWrap = ($line =~ /\\$/);
308	if ($backSlashWrap) { chop $line; }
309	print OUT " \"$line\"\n";
310
311	}
312	print OUT " },\n";
313	}
314	print OUT <<EOF_BLOCK;
315	};
316
317	lscp_ref_entry_t* lscp_reference_for_command(const char* cmd) {
318	const int n1 = strlen(cmd);
319	if (!n1) return NULL;
320	int foundLength = 0;
321	lscp_ref_entry_t* foundEntry = NULL;
322	for (int i = 0; i < sizeof(lscp_reference) / sizeof(lscp_ref_entry_t); ++i) {
323	const int n2 = strlen(lscp_reference[i].name);
324	const int n = n1 < n2 ? n1 : n2;
325	if (!strncmp(cmd, lscp_reference[i].name, n)) {
326	if (foundEntry) {
327	if (n1 < foundLength && n1 < n2) return NULL;
328	if (n2 == foundLength) return NULL;
329	if (n2 < foundLength) continue;
330	}
331	foundEntry = &lscp_reference[i];
332	foundLength = n2;
333	}
334	}
335	return foundEntry;
336	}
337	EOF_BLOCK
338	close(OUT);
339	exit(0); # all done, success