HTML-Menu-TreeView
view release on metacpan or search on metacpan
examples/module2treeview.pl view on Meta::CPAN
#!/usr/bin/perl -w
use Pod::Usage;
use HTML::Menu::TreeView qw(:all);
use Getopt::Long;
use strict;
my $htdocs = documentRoot();
my $outpath = undef;
my $style = 'Crystal';
my $size = 32;
my ($mod, $recursive, @modules, @r, $p, $root);
my $help = 0;
my $sort = 0;
my $pre = undef;
my $Changeroot = 1;
my $result = GetOptions(
'module=s' => \$mod,
'htdocs=s' => \$htdocs,
'style=s' => \$style,
'size=s' => \$size,
'recursive|' => \$recursive,
'help|?' => \$help,
'sort' => \$sort,
'prefix=s' => \$pre,
'store=s' => \$outpath
);
$help = 1 if ((not defined $mod) && (not defined $recursive));
pod2usage(1) if $help;
sortTree(1) if $sort;
prefix($pre) if defined $pre;
$pre = defined $pre ? $pre : '';
$outpath = defined $outpath ? $outpath : $htdocs;
my %Paths;
if ($recursive) {
foreach my $key (@INC) {
if (-d $key) {
$Changeroot = 1;
$root = $key;
@r = split "", $root;
$Paths{$key} = $key;
push @modules, &recursive($key);
}
}
documentRoot($htdocs);
Style($style);
size(48);
sortTree(1);
folderFirst(1);
my $css = css();
my $tree = Tree(\@modules);
open OUT, ">$outpath/index.html" or warn "$!";
print OUT qq(<?xml version="1.0" encoding="iso-8859-1"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<title>Perldoc Navigation</title>
<meta name="description" content="module2treeview"/>
<meta name="author" content="Dirk Lindner"/>
<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/>
<meta name="robots" content="index"/>
<meta name="revisit-after" content="30 days"/>
<link href="$pre/style/$style/48/html-menu-treeview/$style.css" rel="stylesheet" type="text/css"/>
<script language="JavaScript1.5" type="text/javascript" src="$pre/style/treeview.js"></script>
<script language="JavaScript1.5" type="text/javascript" src="$pre/style/$style/48/html-menu-treeview/preload.js"></script>
</head>
<body>
<table align="left" class="mainborder" cellpadding="0" cellspacing="0" summary="mainLayout" width="100%" >
<tr>
<td align="center">$tree</td>
</tr>
</table>
</body>
</html>);
close(OUT);
} else {
my $pref = $mod;
$pref =~ s/(.+)::[^:]+$/$1/;
$pref =~ s?::?/?g;
&module2treeview($mod, $mod, $pref);
}
sub module2treeview {
my $module = shift;
my $modulname = shift;
my $ddir = shift;
recursiveMkDir("$outpath/$ddir");
my $module2path = $module;
$module2path =~ s?::?/?g;
my $module2html = $modulname ? $modulname : $module;
$module2html =~ s?::?-?g;
$module2html =~ s?/([^/])$?$1?g;
my $infile = undef;
if (-e $module) {
$infile = $module;
$module =~ s?.*/([^/]+)$?$1?;
}
foreach my $key (@INC) {
if (-e $key . "/" . $module2path . ".pm") {
$infile = $key . "/" . $module2path . ".pm";
last;
}
}
$module =~ s/\.pm//;
my $ffsrc = "$ddir/$module" . 'frame.html';
my @t = (
{
text => $module,
href => $ffsrc,
target => 'rightFrame',
subtree => [openTree($module, $infile, $module2html, $ddir),],
},
);
if ($recursive) {
push @t,
{
text => 'Index',
href => "/index.html",
target => '_parent',
};
}
documentRoot($htdocs);
Style($style);
size($size);
my $nsrc = "$outpath/$ddir/$module" . 'navi.html';
my $nnsrc = "$ddir/$module" . 'navi.html';
open OUT, ">$nsrc" or warn "$!";
prefix($pre) if defined $pre;
my $tree = Tree(\@t);
print OUT qq(<?xml version="1.0" encoding="iso-8859-1"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<title>$module2html</title>
<meta name="description" content="$module2html"/>
<meta name="author" content="Dirk Lindner"/>
<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/>
<meta name="robots" content="index"/>
<meta name="revisit-after" content="30 days"/>
<link href="$pre/style/$style/$size/html-menu-treeview/$style.css" rel="stylesheet" type="text/css"/>
<script language="JavaScript1.5" type="text/javascript" src="$pre/style/treeview.js"></script>
<script language="JavaScript1.5" type="text/javascript" src="$pre/style/$style/$size/html-menu-treeview/preload.js"></script>
<script language="JavaScript1.5" type="text/javascript">
if (parent.frames.length == 0){
location.href = "$ddir/$module.html";
}
</script>
</head>
<body>
<table align="left" class="mainborder" cellpadding="0" cellspacing="0" summary="mainLayout" width="100%" >
<tr>
<td align="left" >$tree</td>
</tr>
</table>
</body>
</html>);
close(OUT);
my $fsrc = "$outpath/$ddir/$module" . '.html';
open FRAME, ">$fsrc" or warn $!;
print FRAME
qq(<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">
<html>
<head>
<title>$module</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<meta name="robots" content="index">
</head>
<frameset cols="300,*">
<frame src="$nnsrc" name="navi">
<frame src="$ffsrc" name="rightFrame">
</frameset>
</html>);
close(FRAME);
}
sub recursive {
my $d = shift;
my @DIR;
chomp($d);
opendir(IN, $d) or warn "$d $!:$/";
my @files = readdir(IN);
closedir(IN);
for (my $i = 0 ; $i <= $#files ; $i++) {
my $newFile = "$d/$files[$i]";
unless ($files[$i] =~ /^\./) {
my $prefix = "";
my @fields = split "", $d;
for (my $j = 0 ; $j <= $#fields ; $j++) {
$prefix .= $fields[$j] if not defined $r[$j];
}
my $module2html = "$prefix/$files[$i]";
( run in 1.815 second using v1.01-cache-2.11-cpan-119454b85a5 )