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]) {
+ − 28 $dir = File::Spec->catdir($dir,$part);
+ − 29 mkdir $dir unless -d $dir;
+ − 30 }
+ − 31
+ − 32 open my $hPod, "<:encoding(cp1251)", $fname or die "Failed to open $fname for input: $!";
+ − 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) {
+ − 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 }
+ − 66 }
+ − 67 }
+ − 68
+ − 69 sub build_index {
+ − 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>";
66
+ − 78 print $hout "<a target='content' href='$item->{url}'>" if $item->{url};
64
+ − 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";
+ − 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%,*">
66
+ − 123 <frame name="toc" src="toc.html"/>
+ − 124 <frame name="content" src="about:blank"/>
+ − 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"
+ − 138 . $pod->content->present($self)
+ − 139 . "</body>\n</html>\n";
+ − 140 }
+ − 141 sub view_begin {
+ − 142 my ($self,$begin) = @_;
66
+ − 143 return code_highlight(join ("",$begin->content()),$begin->format);
65
+ − 144 }
+ − 145
+ − 146 sub escape_html {
+ − 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 {
+ − 159 my ($self,$text) = @_;
+ − 160
73
+ − 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;
64
+ − 168
73
+ − 169 return "<code>$text</code>";
+ − 170 }
+ − 171
+ − 172 sub mk_filelink {
+ − 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;
65
+ − 181 if (-f File::Spec->catfile($LibDir,@path).".pm") {
73
+ − 182 return '../'x($level-1) . File::Spec->catfile(@path).'.html';
65
+ − 183 }
+ − 184 }
73
+ − 185 return undef;
65
+ − 186 }
+ − 187
+ − 188 sub view_seq_code {
+ − 189 goto &view_seq_link;
+ − 190 }
66
+ − 191
+ − 192 sub view_code {
+ − 193 my ($self,$code) = @_;
+ − 194
+ − 195 return code_highlight($code);
+ − 196 }
+ − 197
+ − 198 sub code_highlight {
+ − 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, highlight => (
+ − 216 '--syntax' => $format,
+ − 217 '--html',
+ − 218 '--fragment',
+ − 219 '--inline-css',
+ − 220 '--enclose-pre'
+ − 221 )
+ − 222 ) } or return "<pre>".escape_html($text)."</pre>\n";
+ − 223
+ − 224 binmode $hout, ':encoding(utf8)';
+ − 225 binmode $hin, ':encoding(utf8)';
+ − 226
+ − 227 print $hout $text;
+ − 228
+ − 229 undef $hout;
+ − 230
+ − 231 my $fragment = <$hin>;
+ − 232
+ − 233 undef $hin;
+ − 234
+ − 235 return $fragment;
+ − 236
+ − 237 }