view _doc/make.pl @ 86:52eeec77504b

TAP fixes
author wizard
date Mon, 19 Apr 2010 02:38:18 +0400
parents 84aa8c395fce
children 6ce1f052b90a
line wrap: on
line source

#!/usr/bin/perl -w
use strict;

use Pod::POM;
use Pod::POM::View::HTML;
use File::Spec;

our $LibDir = '../Lib/IMPL';
our $OutDir = 'html';
our $level = 0;

our $index = { name => 'root' };

sub process_file {
    my ($fname,@path) = @_;
    
    (my $name = $path[$#path]) =~ s/\.pm$//;
    
    (my $fileUrl = File::Spec->catfile(@path)) =~ s/\.pm$/.html/i;
    
    $index->{items}{$name}{name} = $name;
    $index->{items}{$name}{url} = $fileUrl;
    
    (my $fnameOut = File::Spec->catfile($OutDir,@path)) =~ s/\.pm$/.html/i;
    
    my $dir =$OutDir;
    foreach my $part (@path[0..$#path-1]) {
    	$dir = File::Spec->catdir($dir,$part);
    	mkdir $dir unless -d $dir;
    }
    
    open my $hPod, "<:encoding(cp1251)", $fname or die "Failed to open $fname for input: $!";
    open my $hOut, ">:encoding(utf-8)", $fnameOut or die "Failed to open $fnameOut for output: $!";
    
    my $parser = Pod::POM->new();
    
    my $pom = $parser->parse_file($hPod);
    
    $level = @path;
    
    print $hOut PodViewHTML->print($pom);
}

sub process_dir {
    my ($dirname,@dirs) = @_;
    
    opendir my $hdir, $dirname or die "faield to open dir $dirname: $!";
    
    foreach my $entry (readdir $hdir) {
		next if grep $_ eq $entry, '.','..';
		
		my $path = "$dirname/$entry";
		
		print "$path";
		
		if (-d $path) {
		    print "\n";
		    local $index = exists $index->{items}{$entry} ? $index->{items}{$entry} : ($index->{items}{$entry} = {name => $entry});
		    process_dir($path,@dirs,$entry);
		} elsif ($entry =~ /\.(pm|pod)$/) {
		    print "\tprocessed\n";
		    process_file($path,@dirs,$entry);
		} else {
		    print "\tskipped\n";
	    }
    }
}

sub build_index {
	my ($hout,$index) = @_;
	
	print $hout "\n<ul>\n";
	
	if ($index->{items}) {
		foreach my $itemKey (sort keys %{$index->{items}}) {
			my $item = $index->{items}{$itemKey};
			print $hout "<li>";
			print $hout "<a target='content' href='$item->{url}'>" if $item->{url};
			print $hout $item->{name};
			print $hout "</a>" if $item->{url};
			build_index($hout,$item) if $item->{items};
			print $hout "</li>\n";
		}
	}
	
	print $hout "</ul>\n";
}

`rm -r html`;
mkdir 'html' unless -d 'html';

process_dir($LibDir);

open my $hout, ">:encoding(utf-8)", "$OutDir/toc.html" or die "failed to open toc.html for output: $!";

print $hout <<HEADER;
<html>
<head>
<meta http-equiv="Content-type" content="text/html; charset=UTF-8"/>
<title>IMPL reference</title>
</head>
<body>
HEADER

build_index($hout,$index);

print $hout <<FOOTER;
</body>
</html>
FOOTER

undef $hout;

open $hout, ">:encoding(utf-8)","$OutDir/index.html" or die "failed to open index.html for output: $!";

print $hout <<FRAMES;
<html>
<head>
<meta http-equiv="Content-type" content="text/html; charset=UTF-8"/>
<title>IMPL reference</title>
</head>
<frameset cols="20%,*">
	<frame name="toc" src="toc.html"/>
	<frame name="content" src="about:blank"/>
</frameset>
</html>
FRAMES

package PodViewHTML;
use base qw(Pod::POM::View::HTML);

use IPC::Open2;

sub view_pod {
    my ($self, $pod) = @_;
    return "<html>\n<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\" />
    \n<body bgcolor=\"#ffffff\">\n"
 	. $pod->content->present($self)
        . "</body>\n</html>\n";
}
sub view_begin {
	my ($self,$begin) = @_;
	return code_highlight(join ("",$begin->content()),$begin->format);
}

sub escape_html {
	my %esc = (
		'&' => '&amp;',
		'>' => '&gt;',
		'<' => '&lt;'
	);
	
	(my $text = shift) =~ s/([&><])/$esc{$1}/gex;
	
	return $text;
}

sub view_seq_link {
	my ($self,$text) = @_;
	
	$text =~ s/(\w+(?:\:\:\w+)+)/
		if (my $url = $self->mk_filelink($1)) {
			"<a href='$url'>$1<\/a>";
		} else {
			$1;
		}
	/gex;
	
	return "<code>$text</code>";
}

sub mk_filelink {
	my ($self,$package) = @_;
	
	return undef unless $package; 
	
	my @path = split /::/, $package;
	
	if ($path[0] eq 'IMPL') {
		shift @path;
		if (-f File::Spec->catfile($LibDir,@path).".pm") {
			return '../'x($level-1) . File::Spec->catfile(@path).'.html';
		}
	}
	return undef;	
}

sub view_seq_code {
	goto &view_seq_link;
}

sub view_code {
	my ($self,$code) = @_;
	
	return code_highlight($code);
}

sub code_highlight {
	my ($text,$format) = @_;
	
	if ($format) {
		$format =~ s/code//i;
		$format =~ s/\s+//g;
	}
	
	$format ||= 'perl';
	
	return "<pre>".escape_html($text)."</pre>\n" if $format =~ /^text$/i;
	
	
	
	my ($hin,$hout);
	local $/ = undef;
	my $pid = eval { open2(
		$hin, $hout, highlight => (
			'--syntax' => $format,
			'--html',
			'--fragment',
			'--inline-css',
			'--enclose-pre'
		)
	) } or return "<pre>".escape_html($text)."</pre>\n";
	
	binmode $hout, ':encoding(utf8)';
	binmode $hin, ':encoding(utf8)';
	
	print $hout $text;
	
	undef $hout;
	
	my $fragment = <$hin>;
	
	undef $hin;
	
	return $fragment;
	
}