| 
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 }
 |