| 361 |
dpurdie |
1 |
########################################################################
|
|
|
2 |
# Copyright (C) 1998-2011 Vix Technology, All rights reserved
|
|
|
3 |
#
|
|
|
4 |
# Module name : TOC.pm
|
|
|
5 |
# Module type : Makefile system
|
|
|
6 |
# Compiler(s) : Perl
|
|
|
7 |
# Environment(s): jats
|
|
|
8 |
#
|
|
|
9 |
# Description : Create a table of contents
|
|
|
10 |
#
|
|
|
11 |
#......................................................................#
|
|
|
12 |
package JatsDocTools::TOC;
|
|
|
13 |
|
|
|
14 |
use strict;
|
|
|
15 |
use warnings;
|
|
|
16 |
|
|
|
17 |
use Config qw(%Config);
|
|
|
18 |
use File::Basename qw(fileparse);
|
|
|
19 |
use File::Find qw(find);
|
|
|
20 |
use Data::Dumper;
|
|
|
21 |
|
|
|
22 |
# This should be set by user.
|
|
|
23 |
our $dirbase = 'html';
|
|
|
24 |
our $cacheDir = '';
|
|
|
25 |
|
|
|
26 |
#
|
|
|
27 |
# Categorise many known PODS
|
|
|
28 |
# Used mainly by '=for htmltoc' constructs
|
|
|
29 |
#
|
|
|
30 |
my %TocCats = (
|
|
|
31 |
CORE => 'Core',
|
|
|
32 |
JATS => 'Jats',
|
|
|
33 |
DEPLOY => 'Deploy',
|
|
|
34 |
MAKEUTIL => 'mutil',
|
|
|
35 |
SYSUTIL => 'sutil',
|
|
|
36 |
FAQ => 'faq',
|
|
|
37 |
);
|
|
|
38 |
|
|
|
39 |
sub new {
|
|
|
40 |
my($class, $options) = @_;
|
|
|
41 |
my $self = $options ? $options : {};
|
|
|
42 |
|
|
|
43 |
_ReadPodToc($self);
|
|
|
44 |
_BuildHashes($self);
|
|
|
45 |
return bless($self, $class);
|
|
|
46 |
}
|
|
|
47 |
|
|
|
48 |
#-------------------------------------------------------------------------------
|
|
|
49 |
# Function : _ReadPodToc
|
|
|
50 |
#
|
|
|
51 |
# Description : Read in the Toc data from PODS
|
|
|
52 |
# The file is maintained by the pos2html portion
|
|
|
53 |
# Conatins results of the '=for htmltoc' meta data
|
|
|
54 |
# ie: The Pod specifies the TOC category
|
|
|
55 |
#
|
|
|
56 |
# Inputs : None
|
|
|
57 |
#
|
|
|
58 |
# Returns : Populates $self->{Toc}
|
|
|
59 |
#
|
|
|
60 |
sub _ReadPodToc()
|
|
|
61 |
{
|
|
|
62 |
my($self) = @_;
|
|
|
63 |
if ( $cacheDir )
|
|
|
64 |
{
|
|
|
65 |
my $toccache = "$cacheDir/pod2htmt.tmp";
|
|
|
66 |
open(CACHE, "<$toccache") ||
|
|
|
67 |
die "$0: error opening $toccache for reading: $!\n";
|
|
|
68 |
$/ = "\n";
|
|
|
69 |
|
|
|
70 |
#
|
|
|
71 |
# Skip first two lines
|
|
|
72 |
# PodPath
|
|
|
73 |
# PodRoot
|
|
|
74 |
$_ = <CACHE>;
|
|
|
75 |
$_ = <CACHE>;
|
|
|
76 |
|
|
|
77 |
#
|
|
|
78 |
# Read in TOC
|
|
|
79 |
# Meta data => File Path
|
|
|
80 |
#
|
|
|
81 |
my %Toc;
|
|
|
82 |
while (<CACHE>) {
|
|
|
83 |
/(.*?) (.*)$/;
|
|
|
84 |
$Toc{$1} = $2;
|
|
|
85 |
}
|
|
|
86 |
$self->{Toc} = \%Toc;
|
|
|
87 |
close(CACHE);
|
|
|
88 |
}
|
|
|
89 |
}
|
|
|
90 |
|
|
|
91 |
|
|
|
92 |
|
|
|
93 |
# generic structure for the website, HTML help, RDF
|
|
|
94 |
sub TOC {
|
|
|
95 |
my($self) = @_;
|
|
|
96 |
|
|
|
97 |
# generic header stuff
|
|
|
98 |
my $output = $self->boilerplate;
|
|
|
99 |
$output .= $self->header;
|
|
|
100 |
|
|
|
101 |
# FAQ
|
|
|
102 |
$output .= $self->before_faq;
|
|
|
103 |
$self->preProcFaq();
|
|
|
104 |
foreach my $heading ( sort keys %{$self->{Faqs}} )
|
|
|
105 |
{
|
|
|
106 |
$output .= $self->before_faq_section($heading);
|
|
|
107 |
$output .= $self->faq_section($_, $heading) for sort {uc($a) cmp uc($b)} keys %{$self->{Faqs}{$heading}};
|
|
|
108 |
$output .= $self->after_faq_section;
|
|
|
109 |
}
|
|
|
110 |
$output .= $self->after_faq;
|
|
|
111 |
|
|
|
112 |
# Core Documentstion
|
|
|
113 |
$output .= $self->before_Core;
|
|
|
114 |
$output .= $self->Core($_) for sort {uc($a) cmp uc($b)} keys %{$self->{Core}};
|
|
|
115 |
$output .= $self->after_Core;
|
|
|
116 |
|
|
|
117 |
# Build and Make Documentstion
|
|
|
118 |
$output .= $self->before_Jats;
|
|
|
119 |
$output .= $self->Jats($_) for sort {uc($a) cmp uc($b)} keys %{$self->{Jats}};
|
|
|
120 |
$output .= $self->after_Jats;
|
|
|
121 |
|
|
|
122 |
# Make utilities
|
|
|
123 |
$output .= $self->before_mutil;
|
|
|
124 |
$output .= $self->mutil($_) for sort {uc($a) cmp uc($b)} keys %{$self->{mutil}};
|
|
|
125 |
$output .= $self->after_mutil;
|
|
|
126 |
|
|
|
127 |
# Deployment Utilities
|
|
|
128 |
$output .= $self->before_Deploy;
|
|
|
129 |
$output .= $self->Deploy($_) for sort {uc($a) cmp uc($b)} keys %{$self->{Deploy}};
|
|
|
130 |
$output .= $self->after_Deploy;
|
|
|
131 |
|
|
|
132 |
|
|
|
133 |
# User Utilities
|
|
|
134 |
$output .= $self->before_general;
|
|
|
135 |
$self->preProcGeneral();
|
|
|
136 |
foreach my $heading ( sort keys %{$self->{GenSec}} )
|
|
|
137 |
{
|
|
|
138 |
$output .= $self->before_general_section($heading);
|
|
|
139 |
$output .= $self->general_section($_, $heading) for sort {uc($a) cmp uc($b)} keys %{$self->{GenSec}{$heading}};
|
|
|
140 |
$output .= $self->after_general_section;
|
|
|
141 |
}
|
|
|
142 |
# $output .= $self->General($_) for sort {uc($a) cmp uc($b)} keys %{$self->{General}};
|
|
|
143 |
$output .= $self->after_general;
|
|
|
144 |
|
|
|
145 |
# System Utils
|
|
|
146 |
$output .= $self->before_sutil;
|
|
|
147 |
$output .= $self->sutil($_) for sort keys %{$self->{sutil}};
|
|
|
148 |
$output .= $self->after_sutil;
|
|
|
149 |
|
|
|
150 |
$output .= $self->footer;
|
|
|
151 |
|
|
|
152 |
return $output;
|
|
|
153 |
}
|
|
|
154 |
|
|
|
155 |
|
|
|
156 |
sub _BuildHashes {
|
|
|
157 |
my $self = shift;
|
|
|
158 |
|
|
|
159 |
die "htmldir not found at: $dirbase" unless -d $dirbase;
|
|
|
160 |
|
|
|
161 |
my @checkdirs = qw(TOOLS);
|
|
|
162 |
my (%files, %General, %Local);
|
|
|
163 |
|
|
|
164 |
my $Process = sub {
|
|
|
165 |
return if -d;
|
|
|
166 |
my $parsefile = $_;
|
|
|
167 |
|
|
|
168 |
my($filename,$dir,$suffix) = fileparse($parsefile,'\.html');
|
|
|
169 |
|
|
|
170 |
if ($suffix !~ m#\.html#) { return; }
|
|
|
171 |
|
|
|
172 |
my $TOCdir = $dir;
|
|
|
173 |
|
|
|
174 |
$filename =~ s/(.*)\..*/$1/;
|
|
|
175 |
|
|
|
176 |
$TOCdir =~ s#/#::#g;
|
|
|
177 |
$TOCdir =~ s#.*?::TOOLS::#TOOLS::#;
|
|
|
178 |
$dir =~ s~^\Q$dirbase\E/~~;
|
|
|
179 |
$dir =~ s~/*$~~;
|
|
|
180 |
|
|
|
181 |
my $TOCName = $filename;
|
|
|
182 |
$TOCName =~ s~^jats_~~;
|
|
|
183 |
|
|
|
184 |
if ( exists $self->{Toc}{"$dir/$filename.html"} )
|
|
|
185 |
{
|
|
|
186 |
$TOCdir = delete $self->{Toc}{"$dir/$filename.html"};
|
|
|
187 |
unless ( $TOCdir =~ m~::$~ )
|
|
|
188 |
{
|
|
|
189 |
$TOCdir =~ m~(.+::)(.+)$~;
|
|
|
190 |
$TOCName = $2;
|
|
|
191 |
$TOCdir = $1;
|
|
|
192 |
}
|
|
|
193 |
}
|
|
|
194 |
if ($files{"$TOCdir$TOCName"}) {
|
|
|
195 |
warn "$parsefile: REPEATED!\n"
|
|
|
196 |
unless ( $files{"$TOCdir$TOCName"} eq "$dir/$filename.html" );
|
|
|
197 |
}
|
|
|
198 |
$files{"$TOCdir$TOCName"} = "$dir/$filename.html";
|
|
|
199 |
return 1;
|
|
|
200 |
};
|
|
|
201 |
|
|
|
202 |
foreach my $dir (@checkdirs) {
|
|
|
203 |
|
|
|
204 |
next unless -d "$dirbase/$dir";
|
|
|
205 |
find({ wanted => $Process, no_chdir => 1 }, "$dirbase/$dir");
|
|
|
206 |
}
|
|
|
207 |
|
|
|
208 |
#
|
|
|
209 |
# Process user specified Toc entries
|
|
|
210 |
#
|
|
|
211 |
foreach ( keys %{$self->{Toc}} )
|
|
|
212 |
{
|
|
|
213 |
warn "Unused Toc entry: $_\n";
|
|
|
214 |
}
|
|
|
215 |
|
|
|
216 |
|
|
|
217 |
foreach my $file (keys %files) {
|
|
|
218 |
#print "$file\n";
|
|
|
219 |
|
|
|
220 |
# Hard coded Toc categories
|
|
|
221 |
$file =~ m~(.*?)::~;
|
|
|
222 |
if ( exists $TocCats{uc($1)} ) {
|
|
|
223 |
my $cat = $TocCats{uc($1)};
|
|
|
224 |
$self->{$cat}{$file} = delete $files{$file};
|
|
|
225 |
}
|
|
|
226 |
elsif ($file =~ /::LOCAL::/i ) {
|
|
|
227 |
$Local{$file} = delete $files{$file};
|
|
|
228 |
}
|
|
|
229 |
elsif ($file =~ /POD::FAQ::/i ) {
|
|
|
230 |
my $name = $file;
|
|
|
231 |
$name =~ s~_~ ~g;
|
|
|
232 |
$self->{faq}{$file} {$name} = delete $files{$file};
|
|
|
233 |
}
|
|
|
234 |
elsif ($file =~ /::LIB::Pod::/ ||
|
|
|
235 |
$file =~ /::cvs2cl$/ ||
|
|
|
236 |
$file =~ /::POD::Template$/ ||
|
|
|
237 |
$file =~ /::LIB::DeployUtils::/
|
|
|
238 |
) {
|
|
|
239 |
# these files are internal and support files
|
|
|
240 |
delete $files{$file};
|
|
|
241 |
}
|
|
|
242 |
else
|
|
|
243 |
{
|
|
|
244 |
$General{$file} = delete $files{$file};
|
|
|
245 |
}
|
|
|
246 |
}
|
|
|
247 |
|
|
|
248 |
$self->{General} = \%General;
|
|
|
249 |
$self->{Local} = \%Local;
|
|
|
250 |
#print Dumper($self);
|
|
|
251 |
}
|
|
|
252 |
|
|
|
253 |
1;
|