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