1#!/usr/bin/env perl
2
3use strict;
4
5my $outfile;
6if ($ARGV[0] eq "-o") {
7    die "Missing filename after -o.\n" unless ($#ARGV >= 1);
8    shift;
9    $outfile = $ARGV[0];
10    shift;
11}
12
13die "Must specify product.\n" unless ($#ARGV >= 0);
14my $product = $ARGV[0];
15
16# Figure out the version name.
17my $version;
18open VERSION, "<version.txt" or die "No version.txt file.\n";
19while (<VERSION>) {
20    chomp;
21    if (/^version="(.*)"/) { $version=$1 }
22}
23close VERSION;
24
25# Sort out the product, and %approd.
26my %approd;
27$approd{'a'} = 1;
28
29if ($product eq "x3270") {
30    $approd{'u'} = 1;
31} elsif ($product eq "c3270") {
32    $approd{'C'} = 1;
33    $approd{'u'} = 1;
34} elsif ($product eq "s3270") {
35    $approd{'S'} = 1;
36    $approd{'u'} = 1;
37} elsif ($product eq "b3270") {
38    $approd{'B'} = 1;
39    $approd{'u'} = 1;
40} elsif ($product eq "wc3270") {
41    $approd{'C'} = 1;
42    $approd{'w'} = 1;
43} elsif ($product eq "ws3270") {
44    $approd{'S'} = 1;
45    $approd{'w'} = 1;
46} elsif ($product eq "wb3270") {
47    $approd{'B'} = 1;
48    $approd{'w'} = 1;
49} else {
50    die "Unknown product '$product'.\n";
51}
52my $prefix = $product;
53$prefix =~ s/3270//;
54$approd{$prefix} = 1;
55# Dump out %approd.
56#foreach my $k (keys %approd) {
57#    print STDERR "$k: $approd{$k}\n"
58#}
59my %types = (
60    i => 'Integer',
61    b => 'Boolean',
62    s => 'String'
63);
64
65# Set up output file.
66my $out;
67my $tmpfile;
68if ($outfile) {
69    $tmpfile = "/tmp/mkr" . $$;
70    unlink $tmpfile;
71    open TMPFILE, ">", $tmpfile or die "Can't open $tmpfile.\n";
72    $out = *TMPFILE;
73} else {
74    $out = *STDOUT;
75}
76
77# From here on out, unlink the tempfile if we bail.
78END {
79    unlink $tmpfile if ($tmpfile);
80}
81
82# Unlink the tempfile if we get a termination signal.
83sub sighandler
84{
85    unlink $tmpfile if ($tmpfile);
86    exit(0);
87}
88$SIG{'INT'} = \&sighandler;
89$SIG{'QUIT'} = \&sighandler;
90$SIG{'HUP'} = \&sighandler;
91$SIG{'TERM'} = \&sighandler;
92
93# Remove HTML attributes from a resource name.
94sub nix
95{
96    my $txt = shift(@_);
97    $txt =~ s/<\/?[\w.]+>//g;
98    return $txt;
99}
100
101# The indices.
102my @index;	# overall index
103my @c_index;	# configuration index
104my @a_index;	# appearance index
105my @n_index;	# NVT-mode index
106my @p_index;	# protocol index
107my @i_index;	# interaction index
108my @s_index;	# security index
109my @t_index;	# tracing index
110my @o_index;	# other index
111my @d_index;	# deprecated index
112my @indices = (
113    \@c_index,
114    \@a_index,
115    \@n_index,
116    \@p_index,
117    \@i_index,
118    \@s_index,
119    \@t_index,
120    \@o_index,
121    \@d_index
122);
123my @index_name = (
124    "Basic Configuration",
125    "Appearance",
126    "NVT-Mode",
127    "Protocol",
128    "Terminal Interaction",
129    "Security",
130    "Tracing",
131    "Other",
132    "Deprecated"
133);
134
135# The elements of an entry.
136my $name;
137my @names;
138my $applies;
139my $type;
140my $default;
141my @switch;
142my @option;
143my $description;
144my $groups;
145
146sub dump {
147    if ($name && $applies) {
148	# The minimum set of required attributes are type and description.
149	die "$name missing type\n" if (!$type);
150	die "$name missing description\n" if (!$description);
151	foreach my $n (@names) {
152	    # Add this name to the general index.
153	    push @index, $n;
154	    # Add this name to the specified indices...
155	    if (defined($groups)) {
156		foreach (split /\s+/, $groups) {
157		    if ($_ eq "c") {
158			push @c_index, $n;
159		    } elsif ($_ eq "a") {
160			push @a_index, $n;
161		    } elsif ($_ eq "n") {
162			push @n_index, $n;
163		    } elsif ($_ eq "p") {
164			push @p_index, $n;
165		    } elsif ($_ eq "i") {
166			push @i_index, $n;
167		    } elsif ($_ eq "s") {
168			push @s_index, $n;
169		    } elsif ($_ eq "t") {
170			push @t_index, $n;
171		    } elsif ($_ eq "d") {
172			push @d_index, $n;
173		    } else {
174			die "Unknown group '$_'\n";
175		    }
176		}
177	    } else {
178		# ... or to the 'other' index.
179		push @o_index, $n;
180	    }
181	    my $tgt = nix($n);
182	    print $out "<a name=\"$tgt\"></a>\n<b>Name:</b> $product.$n<br>\n";
183	}
184
185	print $out "<b>Type</b>: $type<br>\n";
186	if ($default) { print $out "<b>Default</b>: $default<br>\n"; }
187	if (@switch) {
188	    my $comma;
189	    print $out "<b>Command Line</b>:";
190	    foreach my $s (@switch) {
191		print $out "$comma $s\n";
192		$comma = ",";
193	    }
194	    print $out "<br>\n";
195	}
196	if ($product eq "x3270") {
197	    foreach my $o (@option) {
198		print $out "<b>Option</b>: $o<br>\n";
199	    }
200	}
201	$description =~ s/%p%/$product/g;
202	while ($description =~ /%-([\w.<>\/*]+)%/) {
203	    my $full = $1;
204	    my $clean = nix($1);
205	    $clean =~ s/<\/?i>//g;
206	    $description =~ s/%-[\w.<>\/*]+%/<a href=#$clean>$product.$full<\/a>/;
207	}
208	#$description =~ s/%-([\w.]+)%/<a href=#\1><tt>$product.\1<\/tt><\/a>/g;
209	print $out "<b>Description</b>:<br>\n";
210	print $out "<p class=indented>$description</p>\n";
211    }
212    undef $name;
213    undef @names;
214    undef $applies;
215    undef $type;
216    undef $default;
217    undef @switch;
218    undef @option;
219    undef $description;
220    undef $groups;
221}
222
223print $out <<"EOS";
224<!DOCTYPE doctype PUBLIC "-//w3c//dtd html 4.0 transitional//en">
225<html>
226<head>
227 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
228 <title>$product Resources</title>
229 <link HREF="http://www.w3.org/StyleSheets/Core/Steely" TYPE="text/css" REL="stylesheet">
230 <style type="text/css">
231<!--
232.indented
233{
234    padding-left: 50pt;
235    padding-right: 50pt;
236}
237-->
238</style>
239</head>
240<body>
241<h1>$product Resources</h1>
242EOS
243
244my $on = 1;
245my $in_desc;
246my $in_intro;
247my @ifstack;
248while (<STDIN>) {
249    chomp;
250    # Skip blank lines.
251    next if (/^\s*$/);
252
253    # Handle if/endif.
254    if (/^if\s+(.*)/) {
255	push @ifstack, $on;
256	my $desc_applies;
257	foreach (split /\s+/, $1) {
258	    $desc_applies = 1 if ($approd{$_});
259	}
260	$on = $desc_applies if ($ifstack[$#ifstack]);
261	next;
262    } elsif (/^else/) {
263	die "dangling else\n" if ($#ifstack < 0);
264	$on = !$on if ($ifstack[$#ifstack]);
265	next;
266    } elsif (/^endif/) {
267	die "dangling endif\n" if ($#ifstack < 0);
268	$on = pop(@ifstack);
269	next;
270    }
271    next unless $on;
272
273    # Handle desc.
274    if ($in_desc) {
275	if (/^\./) {
276	    undef $in_desc;
277	} else {
278	    $description .= $_ . "\n";
279	}
280	next;
281    }
282
283    # Handle intro.
284    if (/^intro/) {
285	$in_intro = 1;
286	next;
287    } elsif ($in_intro) {
288	if (/^\./) {
289	    undef $in_intro;
290	    print $out "<h2>Alphabetical Resource List</h2>\n";
291	} else {
292	    s/%p%/$product/g;
293	    while (/%-([\w.<>\/*]+)%/) {
294		my $full = $1;
295		my $clean = nix($1);
296		$clean =~ s/<\/?i>//g;
297		$_ =~ s/%-[\w.<>\/*]+%/<a href=#$clean>$product.$full<\/a>/;
298	    }
299	    print $out "$_\n";
300	}
301	next;
302    }
303
304    # Handle normal keywords.
305    if (/name\s(.*)/) {
306	&dump;
307	@names = split /\s+/, $1;
308	$name = $names[0];
309	next;
310    }
311    if (/applies\s(.*)/) {
312	undef $applies;
313	foreach (split /\s+/, $1) {
314	    $applies = 1 if ($approd{$_});
315	}
316	next;
317    }
318    if (/groups\s(.*)/) {
319	$groups = $1;
320	next;
321    }
322    if (/type\s([^\s]*)/) {
323	$type = $types{$1};
324	next;
325    }
326    if (/default\s(.*)/) {
327	$default = $1;
328	next;
329    }
330    if (/switch\s(.*)/) {
331	push @switch, $1;
332	next;
333    }
334    if (/option\s(.*)/) {
335	push @option, $1;
336	next;
337    }
338    if (/^desc/) {
339	$in_desc = 1;
340	next;
341    }
342    last if (/^EOF$/);
343    die "Unknown keyword '$_'.\n";
344}
345
346&dump;
347
348print $out <<EOT;
349<h2>Index of All Resources</h2>
350<table border cols=4 width="75%">
351EOT
352my $ix = 0;
353foreach my $i (@index) {
354    if (!($ix % 4)) {
355	if ($ix) { print $out " </tr>\n"; }
356	print $out "<tr>";
357    }
358    my $clean = nix($i);
359    print $out " <td><a href=\"#$clean\">$i</a></td>";
360    $ix++;
361}
362print $out " </tr>\n</table>\n";
363
364my $q = 0;
365foreach my $j (@indices) {
366    my @arr = @$j;
367    if ($#arr >= 0) {
368	print $out "<h2>$index_name[$q] Resources</h2>\n";
369	print $out "<table border cols=4 width=\"75%\">\n";
370	my $ix = 0;
371	foreach my $i (@arr) {
372	    if (!($ix % 4)) {
373		if ($ix) { print $out " </tr>\n"; }
374		print $out "<tr>";
375	    }
376	    my $clean = nix($i);
377	    print $out " <td><a href=\"#$clean\">$i</a></td>";
378	    $ix++;
379	}
380	print $out " </tr>\n</table>\n";
381    }
382    $q = $q + 1;
383}
384
385print $out "<p><i>$product version $version ", `date`, "\n";
386
387print $out "</body>\n";
388
389#  Wrap up the outfile.
390if ($outfile) {
391    close TMPFILE;
392    system("mv $tmpfile $outfile") == 0
393	or die "Can't rename $tmpfile to $outfile.\n";
394}
395