annotate _doc/make.pl @ 134:44977efed303

Significant performance optimizations Fixed recursion problems due converting objects to JSON Added cache support for the templates Added discovery feature for the web methods
author wizard
date Mon, 21 Jun 2010 02:39:53 +0400
parents 84aa8c395fce
children 6ce1f052b90a
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>
74
wizard
parents: 73
diff changeset
122 <frameset cols="20%,*">
66
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 }