1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
#!/usr/bin/perl
use strict;
use warnings;
sub read_xml($);
sub read_xml($) {
my ($xml_dir) = @_;
my @xml = ();
my @sub = ();
opendir(DIR,$xml_dir) || die "Failed to read '$xml_dir' (Reason: $!)";
foreach (readdir(DIR)) {
if ($_ ne '.' and $_ ne '..') {
my $full = $xml_dir.'/'.$_;
if (-d $full) {
push @sub, $_;
}
elsif (/\.xml$/o) {
push @xml, $_;
}
}
}
closedir(DIR);
foreach my $sub (@sub) {
my @subxml = read_xml($xml_dir.'/'.$sub);
foreach (@subxml) {
push @xml, $sub.'/'.$_;
}
}
return @xml;
}
sub print_index(\@) {
my ($xml_r) = @_;
my $header=<<HEADER;
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!DOCTYPE PAGE SYSTEM 'arb_help.dtd' [
<!ENTITY nbsp " ">
<!ENTITY acute "´">
<!ENTITY eacute "é">
<!ENTITY apostr "'">
<!ENTITY semi ";">
]>
<!-- This file has been generated by ../generate_index.pl -->
<PAGE name="help_index" edit_warning="devel">
<TITLE>ARB help index</TITLE>
<SECTION name="List of existing helpfiles">
<LIST>
HEADER
my $footer=<<FOOTER;
</LIST>
</SECTION>
</PAGE>
FOOTER
print $header;
foreach my $xml (@$xml_r) {
my $hlp = $xml;
$hlp =~ s/\.xml$/\.hlp/o;
my $link = ' <T><LINK dest="'.$hlp.'" type="hlp" quoted="0"/></T>';
print $link."\n";
}
print $footer;
}
sub find_indexed_xmls($$) {
my ($index_name,$xml_dir) = @_;
my @xml = read_xml($xml_dir);
@xml = sort map {
if ($_ eq $index_name) { ; } # dont index the index
else { $_; }
} @xml;
return @xml;
}
my %title_line = (); # key=xml-filename, value=lineno of <TITLE>..
sub parse_titles($\@\%) {
my ($xml_dir,$xml_r, $title_r) = @_;
foreach my $name (@$xml_r) {
my $xml = $xml_dir.'/'.$name;
open(FILE,'<'.$xml) || die "can't read '$xml' (Reason: $!)";
my $line;
LINE: while (defined($line=<FILE>)) {
if ($line =~ /<TITLE>(.*)<\/TITLE>/) {
$$title_r{$name} = $1;
$title_line{$name} = $.;
last LINE;
}
}
close(FILE);
if (not defined $$title_r{$name}) {
die "$xml:1: Failed to parse title\n ";
}
}
}
sub warn_duplicate_titles($\%) {
my ($xml_dir,$title_r) = @_;
my $hlpdir = $xml_dir;
my %seen = ();
foreach my $file (keys %$title_r) {
my $title = $$title_r{$file};
if (defined $seen{$title}) {
my $firstFile = $seen{$title};
my $thisLine = $title_line{$file};
my $firstLine = $title_line{$firstFile};
print STDERR "${xml_dir}/${file}:${thisLine}: Warning: duplicated title '$title' ..\n";
print STDERR "${xml_dir}/${firstFile}:${firstLine}: Warning: .. first seen here.\n";
}
else {
$seen{$title} = $file;
}
}
}
sub generate_index($$) {
my ($index_name,$xml_dir) = @_;
my @xml = find_indexed_xmls($index_name,$xml_dir);
my %title = ();
parse_titles($xml_dir,@xml,%title);
warn_duplicate_titles($xml_dir,%title);
@xml = sort { $title{$a} cmp $title{$b}; } @xml;
print_index(@xml);
}
sub main() {
my $args = scalar(@ARGV);
if ($args != 2) { die "Usage: generate_index.pl NAME_OF_INDEX.xml XMLDIRECTORY\n "; }
my $index_name = $ARGV[0];
my $xml_dir = $ARGV[1];
if (not -d $xml_dir) { die "No such directory '$xml_dir'"; }
generate_index($index_name,$xml_dir);
}
main();
|
