Subversion Repositories DevTools

Rev

Rev 5709 | Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
361 dpurdie 1 
########################################################################
2 
# Copyright (C) 1998-2011 Vix Technology, All rights reserved
3 
#
4 
# Module name   : JatsDocTools.pm
5 
# Module type   : Makefile system
6 
# Compiler(s)   : Perl
7 
# Environment(s): jats
8 
#
9 
# Description   : Create HTML documentation and release note
10 
#
11 
#......................................................................#
12 
 
13 
package JatsDocTools;
14 
 
15 
use strict;
16 
use warnings;
17 
 
18 
use Exporter;
19 
our @ISA = qw(Exporter);
20 
our @EXPORT = qw(UpdateHTML);
21 
our $VERSION = '1.0.0000';
22 
 
23 
sub WriteTOC {
24 
 
25 
    require JatsDocTools::TOC;
26 
    my $dir = $JatsDocTools::TOC::dirbase;
27 
    return unless -d $dir;
28 
 
29 
    my($file,$toc);
30 
    require JatsDocTools::TOC::HTML;
31 
    $toc = JatsDocTools::TOC::HTML->new->TOC();
32 
    $file = "$dir/JatsToc.html";
33 
 
34 
    unlink($file);
35 
    my $fh;
36 
    unless (open($fh, '>', $file)) {
37 
        warn "Can't open '$file': $!";
38 
        return;
39 
    }
40 
    print $fh $toc;
41 
    close($fh) or die "Can't write '$file': $!";
42 
    return 1;
43 
}
44 
 
45 
#-------------------------------------------------------------------------------
46 
# Function        : WriteRelease
47 
#
48 
# Description     : Create an HTML like Release note
49 
#
50 
# Inputs          : changeLog               - Path to text Change log
51 
#
52 
# Returns         :
53 
#
54 
sub WriteRelease
55 
{
56 
    my ($changeLog) = @_;
57 
    my $pre_mode = 0;
58 
 
59 
    require JatsDocTools::TOC;
60 
    my $dir = $JatsDocTools::TOC::dirbase;
61 
    return unless -d $dir;
62 
    my $file = "$dir/release.html";
63 
 
64 
    unlink($file);
65 
    my $fh;
66 
    unless (open($fh, '>', $file)) {
67 
        warn "Can't open '$file': $!";
68 
        return;
69 
    }
70 
 
71 
    my $ifile;
72 
    unless (open($ifile, '<', $changeLog)) {
73 
        warn "Can't open '$changeLog': $!";
74 
        return;
75 
    }
76 
    print $fh <<'HERE';
77 
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
78 
<html>
79 
 
80 
<head>
81 
<!-- Generated file. Edits will be lost -->
82 
<title>JATS Release Notes</title>
83 
<link rel="STYLESHEET" href="Jats.css" type="text/css">
84 
</head>
85 
 
86 
<body>
87 
<h1>Release Notes</h1>
88 
HERE
89 
 
90 
    #
91 
    #   Process release notes and try to pretty them up a bit
92 
    #       Kill -------
93 
    #       Detect Version header
94 
    #       Detect Sub Headers
95 
    #       Reset id pre-formatted
96 
    #
97 
    while ( <$ifile> )
98 
    {
99 
        my $next_pre = $pre_mode;
100 
        my $line;
101 
        $_ =~ s~\s+$~~;
102 
        if ( m~^------~ ) {
103 
            $next_pre = 0;
104 
#            $line = '<hr>';
105 
        } elsif ( m~^Version:~ ) {
106 
            $next_pre = 0;
107 
            $line = "<hr><h2>$_</h2>";
108 
        } elsif ( m~^\w+~i ) {
109 
            $next_pre = 0;
110 
            $line = "<h3>$_</h3>";
111 
        } else {
112 
            $next_pre = 1;
113 
            $line = $_;
114 
        }
115 
 
116 
        next unless ( defined $line );
117 
 
118 
        if ( $pre_mode != $next_pre )
119 
        {
120 
            if ($next_pre) {
121 
                print $fh "<pre>";
122 
            } else {
123 
                print $fh "</pre>";
124 
            }
125 
            $pre_mode = $next_pre;
126 
        }
127 
 
128 
        print $fh $line . "\n";
129 
    }
130 
    print $fh "</pre>\n" if $pre_mode;
131 
    print $fh "</body>\n";
132 
    close($fh) or die "Can't write '$file': $!";
133 
}
134 
 
135 
 
136 
sub UpdateHTML {
137 
    my %args = @_;
138 
 
139 
    require JatsDocTools::TOC;
140 
    $JatsDocTools::TOC::dirbase = $args{htmldir} || 'html';
141 
    $JatsDocTools::TOC::cacheDir = $args{cacheDir} || '';
142 
 
143 
    unless ( -d $JatsDocTools::TOC::dirbase )
144 
    {
145 
        print "Dir not found: $JatsDocTools::TOC::dirbase\n";
146 
        return;
147 
    }
148 
 
149 
    require JatsDocTools::Tree::HTML;
150 
    eval {
151 
        if ( $args{force} >= 0 ) {
152 
        JatsDocTools::Tree::HTML::Update(
153 
            verbose => $args{verbose},
154 
            force => $args{force},
155 
            htmldir => $args{htmldir},
156 
            prefix => $args{prefix},
157 
            cacheDir => $args{cacheDir},
158 
            index => $args{index},
159 
            podpath => ['TOOLS'],
160 
            );
161 
        }
162 
           WriteTOC();
163 
           WriteRelease($args{ChangeLog});
164 
    };
165 
    if ($@) {
166 
        die $@;
167 
    }
168 
}
169 
 
170 
1;