annotate _doc/make.pl @ 73:2f31ecabe9ea

doc security
author wizard
date Mon, 29 Mar 2010 06:56:05 +0400
parents f47f93534005
children 84aa8c395fce
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
64
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
1 #!/usr/bin/perl -w
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
2 use strict;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
3
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
4 use Pod::POM;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
5 use Pod::POM::View::HTML;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
6 use File::Spec;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
7
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
8 our $LibDir = '../Lib/IMPL';
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
9 our $OutDir = 'html';
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
10 our $level = 0;
64
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
11
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
12 our $index = { name => 'root' };
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
13
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
14 sub process_file {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
15 my ($fname,@path) = @_;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
16
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
17 (my $name = $path[$#path]) =~ s/\.pm$//;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
18
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
19 (my $fileUrl = File::Spec->catfile(@path)) =~ s/\.pm$/.html/i;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
20
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
21 $index->{items}{$name}{name} = $name;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
22 $index->{items}{$name}{url} = $fileUrl;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
23
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
24 (my $fnameOut = File::Spec->catfile($OutDir,@path)) =~ s/\.pm$/.html/i;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
25
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
26 my $dir =$OutDir;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
27 foreach my $part (@path[0..$#path-1]) {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
28 $dir = File::Spec->catdir($dir,$part);
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
29 mkdir $dir unless -d $dir;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
30 }
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
31
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
32 open my $hPod, "<:encoding(cp1251)", $fname or die "Failed to open $fname for input: $!";
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
33 open my $hOut, ">:encoding(utf-8)", $fnameOut or die "Failed to open $fnameOut for output: $!";
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
34
66
f47f93534005 Documentation
wizard
parents: 65
diff changeset
35 my $parser = Pod::POM->new();
64
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
36
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
37 my $pom = $parser->parse_file($hPod);
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
38
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
39 $level = @path;
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
40
64
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
41 print $hOut PodViewHTML->print($pom);
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
42 }
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
43
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
44 sub process_dir {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
45 my ($dirname,@dirs) = @_;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
46
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
47 opendir my $hdir, $dirname or die "faield to open dir $dirname: $!";
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
48
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
49 foreach my $entry (readdir $hdir) {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
50 next if grep $_ eq $entry, '.','..';
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
51
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
52 my $path = "$dirname/$entry";
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
53
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
54 print "$path";
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
55
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
56 if (-d $path) {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
57 print "\n";
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
58 local $index = exists $index->{items}{$entry} ? $index->{items}{$entry} : ($index->{items}{$entry} = {name => $entry});
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
59 process_dir($path,@dirs,$entry);
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
60 } elsif ($entry =~ /\.(pm|pod)$/) {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
61 print "\tprocessed\n";
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
62 process_file($path,@dirs,$entry);
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
63 } else {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
64 print "\tskipped\n";
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
65 }
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
66 }
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
67 }
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
68
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
69 sub build_index {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
70 my ($hout,$index) = @_;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
71
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
72 print $hout "\n<ul>\n";
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
73
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
74 if ($index->{items}) {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
75 foreach my $itemKey (sort keys %{$index->{items}}) {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
76 my $item = $index->{items}{$itemKey};
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
77 print $hout "<li>";
66
f47f93534005 Documentation
wizard
parents: 65
diff changeset
78 print $hout "<a target='content' href='$item->{url}'>" if $item->{url};
64
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
79 print $hout $item->{name};
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
80 print $hout "</a>" if $item->{url};
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
81 build_index($hout,$item) if $item->{items};
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
82 print $hout "</li>\n";
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
83 }
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
84 }
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
85
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
86 print $hout "</ul>\n";
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
87 }
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
88
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
89 `rm -r html`;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
90 mkdir 'html' unless -d 'html';
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
91
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
92 process_dir($LibDir);
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
93
66
f47f93534005 Documentation
wizard
parents: 65
diff changeset
94 open my $hout, ">:encoding(utf-8)", "$OutDir/toc.html" or die "failed to open toc.html for output: $!";
64
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
95
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
96 print $hout <<HEADER;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
97 <html>
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
98 <head>
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
99 <meta http-equiv="Content-type" content="text/html; charset=UTF-8"/>
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
100 <title>IMPL reference</title>
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
101 </head>
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
102 <body>
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
103 HEADER
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
104
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
105 build_index($hout,$index);
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
106
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
107 print $hout <<FOOTER;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
108 </body>
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
109 </html>
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
110 FOOTER
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
111
66
f47f93534005 Documentation
wizard
parents: 65
diff changeset
112 undef $hout;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
113
f47f93534005 Documentation
wizard
parents: 65
diff changeset
114 open $hout, ">:encoding(utf-8)","$OutDir/index.html" or die "failed to open index.html for output: $!";
f47f93534005 Documentation
wizard
parents: 65
diff changeset
115
f47f93534005 Documentation
wizard
parents: 65
diff changeset
116 print $hout <<FRAMES;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
117 <html>
f47f93534005 Documentation
wizard
parents: 65
diff changeset
118 <head>
f47f93534005 Documentation
wizard
parents: 65
diff changeset
119 <meta http-equiv="Content-type" content="text/html; charset=UTF-8"/>
f47f93534005 Documentation
wizard
parents: 65
diff changeset
120 <title>IMPL reference</title>
f47f93534005 Documentation
wizard
parents: 65
diff changeset
121 </head>
f47f93534005 Documentation
wizard
parents: 65
diff changeset
122 <frameset cols="30%,*">
f47f93534005 Documentation
wizard
parents: 65
diff changeset
123 <frame name="toc" src="toc.html"/>
f47f93534005 Documentation
wizard
parents: 65
diff changeset
124 <frame name="content" src="about:blank"/>
f47f93534005 Documentation
wizard
parents: 65
diff changeset
125 </frameset>
f47f93534005 Documentation
wizard
parents: 65
diff changeset
126 </html>
f47f93534005 Documentation
wizard
parents: 65
diff changeset
127 FRAMES
f47f93534005 Documentation
wizard
parents: 65
diff changeset
128
64
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
129 package PodViewHTML;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
130 use base qw(Pod::POM::View::HTML);
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
131
66
f47f93534005 Documentation
wizard
parents: 65
diff changeset
132 use IPC::Open2;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
133
64
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
134 sub view_pod {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
135 my ($self, $pod) = @_;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
136 return "<html>\n<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\" />
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
137 \n<body bgcolor=\"#ffffff\">\n"
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
138 . $pod->content->present($self)
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
139 . "</body>\n</html>\n";
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
140 }
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
141 sub view_begin {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
142 my ($self,$begin) = @_;
66
f47f93534005 Documentation
wizard
parents: 65
diff changeset
143 return code_highlight(join ("",$begin->content()),$begin->format);
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
144 }
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
145
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
146 sub escape_html {
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
147 my %esc = (
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
148 '&' => '&amp;',
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
149 '>' => '&gt;',
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
150 '<' => '&lt;'
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
151 );
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
152
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
153 (my $text = shift) =~ s/([&><])/$esc{$1}/gex;
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
154
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
155 return $text;
64
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
156 }
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
157
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
158 sub view_seq_link {
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
159 my ($self,$text) = @_;
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
160
73
wizard
parents: 66
diff changeset
161 $text =~ s/(\w+(?:\:\:\w+)+)/
wizard
parents: 66
diff changeset
162 if (my $url = $self->mk_filelink($1)) {
wizard
parents: 66
diff changeset
163 "<a href='$url'>$1<\/a>";
wizard
parents: 66
diff changeset
164 } else {
wizard
parents: 66
diff changeset
165 $1;
wizard
parents: 66
diff changeset
166 }
wizard
parents: 66
diff changeset
167 /gex;
64
259cd3df6e53 Doc generation
wizard
parents:
diff changeset
168
73
wizard
parents: 66
diff changeset
169 return "<code>$text</code>";
wizard
parents: 66
diff changeset
170 }
wizard
parents: 66
diff changeset
171
wizard
parents: 66
diff changeset
172 sub mk_filelink {
wizard
parents: 66
diff changeset
173 my ($self,$package) = @_;
wizard
parents: 66
diff changeset
174
wizard
parents: 66
diff changeset
175 return undef unless $package;
wizard
parents: 66
diff changeset
176
wizard
parents: 66
diff changeset
177 my @path = split /::/, $package;
wizard
parents: 66
diff changeset
178
wizard
parents: 66
diff changeset
179 if ($path[0] eq 'IMPL') {
wizard
parents: 66
diff changeset
180 shift @path;
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
181 if (-f File::Spec->catfile($LibDir,@path).".pm") {
73
wizard
parents: 66
diff changeset
182 return '../'x($level-1) . File::Spec->catfile(@path).'.html';
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
183 }
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
184 }
73
wizard
parents: 66
diff changeset
185 return undef;
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
186 }
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
187
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
188 sub view_seq_code {
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
189 goto &view_seq_link;
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
190 }
66
f47f93534005 Documentation
wizard
parents: 65
diff changeset
191
f47f93534005 Documentation
wizard
parents: 65
diff changeset
192 sub view_code {
f47f93534005 Documentation
wizard
parents: 65
diff changeset
193 my ($self,$code) = @_;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
194
f47f93534005 Documentation
wizard
parents: 65
diff changeset
195 return code_highlight($code);
f47f93534005 Documentation
wizard
parents: 65
diff changeset
196 }
f47f93534005 Documentation
wizard
parents: 65
diff changeset
197
f47f93534005 Documentation
wizard
parents: 65
diff changeset
198 sub code_highlight {
f47f93534005 Documentation
wizard
parents: 65
diff changeset
199 my ($text,$format) = @_;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
200
f47f93534005 Documentation
wizard
parents: 65
diff changeset
201 if ($format) {
f47f93534005 Documentation
wizard
parents: 65
diff changeset
202 $format =~ s/code//i;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
203 $format =~ s/\s+//g;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
204 }
f47f93534005 Documentation
wizard
parents: 65
diff changeset
205
f47f93534005 Documentation
wizard
parents: 65
diff changeset
206 $format ||= 'perl';
f47f93534005 Documentation
wizard
parents: 65
diff changeset
207
f47f93534005 Documentation
wizard
parents: 65
diff changeset
208 return "<pre>".escape_html($text)."</pre>\n" if $format =~ /^text$/i;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
209
f47f93534005 Documentation
wizard
parents: 65
diff changeset
210
f47f93534005 Documentation
wizard
parents: 65
diff changeset
211
f47f93534005 Documentation
wizard
parents: 65
diff changeset
212 my ($hin,$hout);
f47f93534005 Documentation
wizard
parents: 65
diff changeset
213 local $/ = undef;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
214 my $pid = eval { open2(
f47f93534005 Documentation
wizard
parents: 65
diff changeset
215 $hin, $hout, highlight => (
f47f93534005 Documentation
wizard
parents: 65
diff changeset
216 '--syntax' => $format,
f47f93534005 Documentation
wizard
parents: 65
diff changeset
217 '--html',
f47f93534005 Documentation
wizard
parents: 65
diff changeset
218 '--fragment',
f47f93534005 Documentation
wizard
parents: 65
diff changeset
219 '--inline-css',
f47f93534005 Documentation
wizard
parents: 65
diff changeset
220 '--enclose-pre'
f47f93534005 Documentation
wizard
parents: 65
diff changeset
221 )
f47f93534005 Documentation
wizard
parents: 65
diff changeset
222 ) } or return "<pre>".escape_html($text)."</pre>\n";
f47f93534005 Documentation
wizard
parents: 65
diff changeset
223
f47f93534005 Documentation
wizard
parents: 65
diff changeset
224 binmode $hout, ':encoding(utf8)';
f47f93534005 Documentation
wizard
parents: 65
diff changeset
225 binmode $hin, ':encoding(utf8)';
f47f93534005 Documentation
wizard
parents: 65
diff changeset
226
f47f93534005 Documentation
wizard
parents: 65
diff changeset
227 print $hout $text;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
228
f47f93534005 Documentation
wizard
parents: 65
diff changeset
229 undef $hout;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
230
f47f93534005 Documentation
wizard
parents: 65
diff changeset
231 my $fragment = <$hin>;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
232
f47f93534005 Documentation
wizard
parents: 65
diff changeset
233 undef $hin;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
234
f47f93534005 Documentation
wizard
parents: 65
diff changeset
235 return $fragment;
f47f93534005 Documentation
wizard
parents: 65
diff changeset
236
f47f93534005 Documentation
wizard
parents: 65
diff changeset
237 }