Subversion Repositories DevTools

########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : TOC.pm
# Module type   : Makefile system
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   : Create a table of contents
#
#......................................................................#
package JatsDocTools::TOC;

use strict;
use warnings;

use Config qw(%Config);
use File::Basename qw(fileparse);
use File::Find qw(find);
use Data::Dumper;

# This should be set by user.
our $dirbase = 'html';
our $cacheDir = '';

#
#   Categorise many known PODS
#   Used mainly by '=for htmltoc' constructs
#
my %TocCats = (
    CORE            => 'Core',
    JATS            => 'Jats',
    DEPLOY          => 'Deploy',
    MAKEUTIL        => 'mutil',
    SYSUTIL         => 'sutil',
    FAQ             => 'faq',
);

sub new {
    my($class, $options) = @_;
    my $self = $options ? $options : {};

    _ReadPodToc($self);
    _BuildHashes($self);
    return bless($self, $class);
}

#-------------------------------------------------------------------------------
# Function        : _ReadPodToc
#
# Description     : Read in the Toc data from PODS
#                   The file is maintained by the pos2html portion
#                   Conatins results of the '=for htmltoc' meta data
#                   ie: The Pod specifies the TOC category
#
# Inputs          : None
#
# Returns         : Populates $self->{Toc}
#
sub _ReadPodToc()
{
    my($self) = @_;
    if ( $cacheDir )
    {
        my $toccache = "$cacheDir/pod2htmt.tmp";
        open(CACHE, "<$toccache") ||
            die "$0: error opening(toccache) $toccache for reading: $!\n";
        $/ = "\n";

        #
        #   Skip first two lines
        #       PodPath
        #       PodRoot
        $_ = <CACHE>;
        $_ = <CACHE>;

        #
        #   Read in TOC
        #       Meta data => File Path
        #
        my %Toc;
        while (<CACHE>) {
            /(.*?) (.*)$/;
            $Toc{$1} = $2;
        }
        $self->{Toc} = \%Toc;
        close(CACHE);
    }
}



# generic structure for the website, HTML help, RDF
sub TOC {
    my($self) = @_;

    # generic header stuff
    my $output = $self->boilerplate;
    $output .= $self->header;

    # FAQ
    $output .= $self->before_faq;
    $self->preProcFaq();
    foreach my $heading ( sort keys %{$self->{Faqs}} )
    {
        $output .= $self->before_faq_section($heading);
        $output .= $self->faq_section($_, $heading) for sort {uc($a) cmp uc($b)} keys %{$self->{Faqs}{$heading}};
        $output .= $self->after_faq_section;
    }
    $output .= $self->after_faq;
    
    # Core Documentstion
    $output .= $self->before_Core;
    $output .= $self->Core($_) for sort {uc($a) cmp uc($b)} keys %{$self->{Core}};
    $output .= $self->after_Core;

    # Build and Make Documentstion
    $output .= $self->before_Jats;
    $output .= $self->Jats($_) for sort {uc($a) cmp uc($b)} keys %{$self->{Jats}};
    $output .= $self->after_Jats;

    # Make utilities
    $output .= $self->before_mutil;
    $output .= $self->mutil($_) for sort {uc($a) cmp uc($b)} keys %{$self->{mutil}};
    $output .= $self->after_mutil;
    
    # Deployment Utilities
    $output .= $self->before_Deploy;
    $output .= $self->Deploy($_) for sort {uc($a) cmp uc($b)} keys %{$self->{Deploy}};
    $output .= $self->after_Deploy;

    
    # User Utilities
    $output .= $self->before_general;
    $self->preProcGeneral();
    foreach my $heading ( sort keys %{$self->{GenSec}} )
    {
        $output .= $self->before_general_section($heading);
        $output .= $self->general_section($_, $heading) for sort {uc($a) cmp uc($b)} keys %{$self->{GenSec}{$heading}};
        $output .= $self->after_general_section;
    }
    $output .= $self->after_general;

    # System Utils
    $output .= $self->before_sutil;
    $output .= $self->sutil($_) for sort keys %{$self->{sutil}};
    $output .= $self->after_sutil;

    $output .= $self->footer;

    return $output;
}


sub _BuildHashes {
    my $self = shift;

    die "htmldir not found at: $dirbase" unless -d $dirbase;

    my @checkdirs = qw(TOOLS);
    my (%files, %General, %Local);

    my $Process = sub {
        return if -d;
        my $parsefile = $_;

        my($filename,$dir,$suffix) = fileparse($parsefile,'\.html');

        if ($suffix !~ m#\.html#) { return; }

        my $TOCdir = $dir;

        $filename =~ s/(.*)\..*/$1/;

        $TOCdir =~ s#/#::#g;
        $TOCdir =~ s#.*?::TOOLS::#TOOLS::#;
        $dir =~ s~^\Q$dirbase\E/~~;
        $dir =~ s~/*$~~;

        my $TOCName = $filename;
        $TOCName =~ s~^jats_~~;

        if ( exists $self->{Toc}{"$dir/$filename.html"} )
        {
            $TOCdir = delete $self->{Toc}{"$dir/$filename.html"};
            unless ( $TOCdir =~ m~::$~ )
            {
                $TOCdir =~ m~(.+::)(.+)$~;
                $TOCName = $2;
                $TOCdir = $1;
            }
        }
        if ($files{"$TOCdir$TOCName"}) {
            warn "$parsefile: REPEATED!\n"
                unless ( $files{"$TOCdir$TOCName"} eq "$dir/$filename.html"  );
        }
        $files{"$TOCdir$TOCName"} = "$dir/$filename.html";
        return 1;
    };

    foreach my $dir (@checkdirs) {

    next unless -d "$dirbase/$dir";
    find({ wanted => $Process, no_chdir => 1 }, "$dirbase/$dir");
    }

    #
    #   Process user specified Toc entries
    #
    foreach  ( keys %{$self->{Toc}} )
    {
        warn "Unused Toc entry: $_\n";
    }


    foreach my $file (keys %files) {
#print "$file\n";

        # Hard coded Toc categories
        $file =~ m~(.*?)::~;
        if ( exists $TocCats{uc($1)} ) {
            my $cat = $TocCats{uc($1)};
            $self->{$cat}{$file} =  delete $files{$file};
        }
        elsif ($file =~ /::LOCAL::/i ) {
            $Local{$file} =  delete $files{$file};
        }
        elsif ($file =~ /POD::FAQ::/i ) {
            my $name = $file;
            $name =~ s~_~ ~g;
            $self->{faq}{$file} {$name} =  delete $files{$file};
        }
        elsif ($file =~ /::LIB::Pod::/           ||
               $file =~ /::cvs2cl$/              ||
               $file =~ /::POD::Template$/       ||
               $file =~ /::LIB::DeployUtils::/
               ) {
            # these files are internal and support files
            delete $files{$file};
        }
        else
        {
            $General{$file} =  delete $files{$file};
        }
    }

    $self->{General} = \%General;
    $self->{Local}   = \%Local;
#print Dumper($self);
}

1;