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