#!/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 ) {
#           my $key = "/var/www/html/admin/cgi-bin/lib/";
	  $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]";
            $module2html =~ s/\.pm$//;
            if (-d $newFile && ((not defined $Paths{$newFile})) && ($files[$i] ne 'auto') && !(is_empty($newFile))) {
                my $node = {
                            text    => $files[$i],
                            subtree => [&recursive($newFile)]
                };
                $node->{href} = "$module2html.html" if (-e "$newFile.pm");
                push @DIR, $node;
            } else {
                if ($files[$i] =~ /^.*\.pm$/ && has_pod($newFile)) {
                    my $m = "$prefix/$files[$i]";
                    $m =~ s?(\w)/?$1::?g;
                    $m =~ s/\///g;
                    $m =~ s/\.pm$//;
                    module2treeview($newFile, $m, $prefix);
                    push @DIR,
                      {
                        text => $m,
                        href => "$module2html.html",
                      } unless -d $m
                          && !-e "$outpath/$module2html.html";
                }
            }
        }
    }
    return @DIR;
}

sub has_pod
{
    my $m = shift;
    use Fcntl qw(:flock);
    use Symbol;
    my $fh = gensym;
    open $fh, $m or warn "$!: $m";
    seek $fh, 0, 0;
    my @lines = <$fh>;
    close $fh;

    for (@lines) {
        return 1 if ($_ =~ /^=head1/);
    }
    return 0;
}

sub openTree
{
    my ($module, $infile, $m2, $ddir) = @_;
    my @TREEVIEW;
    $module =~ s/\.pm$//;
    my $fsrc = "$outpath/$ddir/$module" . 'frame.html';
    system("pod2html --quiet --noindex --title=$module --infile=$infile  --outfile=$fsrc");
    use Fcntl qw(:flock);
    use Symbol;
    my $fh = gensym;
    open $fh, $fsrc or warn "$!: $fsrc";
    seek $fh, 0, 0;
    my @lines = <$fh>;
    close $fh;

    for (@lines) {
        if ($_ =~ /<h\d id="([^"]+)">(.+)<\/h\d>/){
            my $href  = $1;
            my $title = $2;
            push @TREEVIEW,
	    {
	      text   => $title,
	      href   => "$ddir/$module" . "frame.html#$href",
	      target => 'rightFrame',
	    };
        }
        $_ =~ s/<body([^>]+)>/<body $1 onload="if (parent.frames.length == 0){location.href = '$ddir\/$module.html';}">/;
        $_ =~ s/<a/<a target="_parent" /gi;
    }
    open OUT, ">$fsrc" or warn "$!: $fsrc";
    print OUT @lines;
    close OUT;
    return @TREEVIEW;
}

sub is_empty
{
    my ($path) = @_;
    opendir DIR, $path;
    while (my $entry = readdir DIR) {
        next if ($entry =~ /^\.\.?$/);
        closedir DIR;
        return 0;
    }
    closedir DIR;
    return 1;
}

sub recursiveMkDir
{
    my $d = shift;
    my @dirs = split "/", $d;
    my $x;
    for (my $i = 0; $i <= $#dirs; $i++) {
        $x = '/' if $i == 0;
        $x .= $dirs[$i] . '/' if $dirs[$i];
        mkdir $x unless -d $x;
    }
}
 __END__

=head1 NAME

module2treeview.pl

=head1 SYNOPSIS

./module2treeview.pl --recursive --htdocs=/path/to/your/document/root/  --store=/srv/www/vhosts/perldoc


module2treeview.pl --module --htdocs --style --size --recursive --help

--module=HTML::Menu::TreeView the name of the modul that should be converted.

--htdocs=/path/to/your/document/root/

--size=16|32|48|64|128 #size of the treeview images

--style=$style|simple

--sort sort the TreeView.

--recursive=1  build documentation for all Perl modules found in your path.

Be carefull with this option it will write a lot of output.

--store /path/to store/Dokumentation

dafault: htdocs path

--prefix=localpath/

--help print this message


=head1 DESCRIPTION

modul2treeview converts the pod from a Perl modul to a frame based html Documentation

which makes usage of HTML::Menu::TreeView.

=head1 Changes

0.2.4

Fixed pod parser

=head1 AUTHOR

Dirk Lindner <dirk.lze@gmail.com>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007-2015 by Hr. Dirk Lindner

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public License
as published by the Free Software Foundation;
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser General Public License for more details.

=cut
