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