Subversion Repositories DevTools

Rev

Rev 5709 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed 

########################################################################
# Copyright (c) VIX TECHNOLOGY (AUST) LTD
#
# Module name   : JatsDocTools.pm
# Module type   : Makefile system
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   : Create HTML documentation and release note
#
#......................................................................#

package JatsDocTools;

use strict;
use warnings;

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(UpdateHTML);
our $VERSION = '1.0.0000';

sub WriteTOC {

    require JatsDocTools::TOC;
    my $dir = $JatsDocTools::TOC::dirbase;
    return unless -d $dir;

    my($file,$toc);
    require JatsDocTools::TOC::HTML;
    $toc = JatsDocTools::TOC::HTML->new->TOC();
    $file = "$dir/JatsToc.html";

    unlink($file);
    my $fh;
    unless (open($fh, '>', $file)) {
        warn "Can't open '$file': $!";
        return;
    }
    print $fh $toc;
    close($fh) or die "Can't write '$file': $!";
    return 1;
}

#-------------------------------------------------------------------------------
# Function        : WriteRelease
#
# Description     : Create an HTML like Release note
#
# Inputs          : changeLog               - Path to text Change log
#
# Returns         : 
#
sub WriteRelease
{
    my ($changeLog) = @_;
    my $pre_mode = 0;

    require JatsDocTools::TOC;
    my $dir = $JatsDocTools::TOC::dirbase;
    return unless -d $dir;
    my $file = "$dir/release.html";

    unlink($file);
    my $fh;
    unless (open($fh, '>', $file)) {
        warn "Can't open '$file': $!";
        return;
    }

    my $ifile;
    unless (open($ifile, '<', $changeLog)) {
        warn "Can't open '$changeLog': $!";
        return;
    }
    print $fh <<'HERE';
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>

<head>
<!-- Generated file. Edits will be lost -->
<title>JATS Release Notes</title>
<link rel="STYLESHEET" href="Jats.css" type="text/css">
</head>

<body>
<h1>Release Notes</h1>
HERE

    #
    #   Process release notes and try to pretty them up a bit
    #       Kill -------
    #       Detect Version header
    #       Detect Sub Headers
    #       Reset id pre-formatted
    #
    while ( <$ifile> )
    {
        my $next_pre = $pre_mode;
        my $line;
        $_ =~ s~\s+$~~;
        if ( m~^------~ ) {
            $next_pre = 0;
#            $line = '<hr>';
        } elsif ( m~^Version:~ ) {
            $next_pre = 0;
            $line = "<hr><h2>$_</h2>";
        } elsif ( m~^\w+~i ) {
            $next_pre = 0;
            $line = "<h3>$_</h3>";
        } else {
            $next_pre = 1;
            $line = $_;
        }

        next unless ( defined $line );

        if ( $pre_mode != $next_pre )
        {
            if ($next_pre) {
                print $fh "<pre>";
            } else {
                print $fh "</pre>";
            }
            $pre_mode = $next_pre;
        }

        print $fh $line . "\n";
    }
    print $fh "</pre>\n" if $pre_mode;
    print $fh "</body>\n";
    close($fh) or die "Can't write '$file': $!";
}


sub UpdateHTML {
    my %args = @_;

    require JatsDocTools::TOC;
    $JatsDocTools::TOC::dirbase = $args{htmldir} || 'html';
    $JatsDocTools::TOC::cacheDir = $args{cacheDir} || '';

    unless ( -d $JatsDocTools::TOC::dirbase )
    {
        print "Dir not found: $JatsDocTools::TOC::dirbase\n";
        return;
    }

    require JatsDocTools::Tree::HTML;
    eval {
        if ( $args{force} >= 0 ) {
        JatsDocTools::Tree::HTML::Update(
            verbose => $args{verbose},
            force => $args{force},
            htmldir => $args{htmldir},
            prefix => $args{prefix},
            cacheDir => $args{cacheDir},
            index => $args{index},
            podpath => ['TOOLS'],
            );
        }
           WriteTOC();
           WriteRelease($args{ChangeLog});
    };
    if ($@) {
        die $@;
    }
}

1;