Subversion Repositories DevTools

########################################################################

# Copyright (C) 1998-2011 Vix Technology, 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;