1 #!/usr/local/bin/perl -w
9 Copyright (C) 2002-2005 Freescale Semiconductor
10 Distributed under terms of the Perl license, which is the disjunction of
11 the GNU General Public License (GPL) and the Artistic License.
15 Description of ${TOOL_NAME}
16 ===========================
17 This program converts the DocUtils reStructuredText or
18 Document Object Model (DOM) (aka pseudo-XML) formats into an output
19 format. The default output format is HTML, but different formats can
20 be specified by using different writer schemas.
24 Usage: ${TOOL_NAME} [options] file(s)
27 -d Print debugging info on STDERR. May be used multiple
28 times to get more information.
29 -e <encoding> Specifies an encoding to use for I/O (default 'utf8')
30 -h Print full usage help
31 -w <writer> Process the writer schema from <writer>.wrt (default 'html')
32 -D var[=val] Define a variable that affects parsing (may be multiple)
33 -W var[=val] Define a variable that affects a writer (may be multiple)
36 Available writers: ${\WriterList()}.
37 Available encodings: ${\EncodingList()}.
42 # See comments in DOM.pm for DOM structure.
45 # _`Handler`: Hash reference with the following
47 # ``tag``: Regular expression for tag matching
48 # ``line``: Line number where function is defined
49 # ``text``: Textual representation of the code to run on tag match
50 # ``code``: Code reference for the code to run on tag match.
51 # The code is a subroutine with two arguments:
53 # the matching DOM object
55 # the string returned recursively from the content
58 # It needs to return a string. Any string returned by the
59 # top level is printed to STDOUT.
60 # _`Handler array`: Reference to array of handler objects.
63 # ``$main::TOP_FILE``: Name of the top-level file being processed.
64 # ``$main::MY_DIR``: The real directory in which the prest script lives
65 # ``$main::TOOL_ID``: The tool name and release number
66 # ``$main::VERSION``: The prest version
70 use vars
qw($TOOL_NAME $YEAR $TOP_FILE $SVNID $SVNNAME $VERSION
76 use Text::Restructured::PrestConfig;
79 my $version = $Text::Restructured::PrestConfig::VERSION;
80 $version =~ s/(\d\d\d)(?=\d)/$1./g;
81 $version =~ s/(\d+)/$1+0/ge;
83 $SVNID =~ /Id: (\S+?) \S+ (\d+)/;
84 $TOOL_ID = "$1 release $VERSION";
86 ($TOOL_NAME = $1) =~ s/\..*//;
89 # The main entry point. Parses command-line options, preprocesses the
90 # writer schema, causes the document(s) to be read, and calls the writer.
93 # Set default option values
94 my %opt = (w=>'html', d=>0, D=>{}, e=>'utf8');
97 Getopt::Long::config('no_ignore_case');
98 Usage() unless GetOptions \%opt, qw(d+ e:s h w=s D:s% W:s% V);
99 # Give usage information
100 Usage
('Description') if $opt{h
};
101 Usage
('Id') if $opt{V
};
102 Usage
() unless @ARGV;
104 # May need to specify an encoding for STDOUT
105 if (($opt{e
} || '') =~ /(.+)/) { # Sanitize for -T flag
106 binmode STDOUT
, ":encoding($1)" ;
109 use Text
::Restructured
::Writer
;
110 my $writer = new Text
::Restructured
::Writer
($opt{w
}, \
%opt);
112 use Text
::Restructured
::DOM
;
114 # Handle all the documents
116 foreach $TOP_FILE (@ARGV) {
117 # uncoverable branch true note:Bug in Devel::Cover
118 open F
,$TOP_FILE or die "Cannot open $TOP_FILE";
119 if (($opt{e
} || '') =~ /(.+)/) { # Sanitize for -T flag
120 binmode F
, ":encoding($1)" ;
123 my $doc = do { local $/; <F
> };
124 if ($doc =~ /^<document/) {
125 # We have a DOM for input rather than an reST file
126 $dom = Text
::Restructured
::DOM
::Parse
($doc, \
%opt);
129 use Text
::Restructured
;
130 $rst_parser = new Text
::Restructured
(\
%opt, $TOOL_ID)
132 $dom = $rst_parser->Parse($doc, $TOP_FILE);
134 # Now compute the output string
135 eval { print $writer->ProcessDOM($dom); };
136 print STDERR
$@
if $@
;
138 $^W
= 0; # Turn off warnings; we're done
141 # Gets list of encodings
143 # Returns: list of writers
148 @encodings = Encode
->encodings(':all');
149 return join(', ', @encodings);
152 # Gets list of writers
154 # Returns: list of writers
158 foreach $dir (@INC) {
159 push @writers, glob("$dir/Text/Restructured/Writer/*.wrt")
161 @writers = grep(! $writer_seen{$_}++,
162 grep(s
|.*/([^/]+)\
.wrt
$|$1|, @writers));
163 return join(', ', @writers);
166 # Extracts and prints usage information
167 # Arguments: type of usage, end marker for usage (optional)
170 $what = "Usage" if ! $what;
171 my $mark = $what eq 'Description' ?
"($what|Usage)" : $what;
172 # uncoverable branch false not:Assert I can open myself
175 if ((/^=begin $mark/ .. /^=end $mark/) &&
176 ! /^=(begin|end) $mark/) {
177 s/(\$\{[^\}]+\})/eval($1)/ge;
183 if ($what =~ /Description/) {
184 my @used = qw(Text/Restructured Text/Restructured/Transforms);
186 @used{@used} = (1) x
@used;
188 foreach $use (@used) {
189 my @rst_dir = grep (-r
"$_/$use.pm", @INC);
190 # uncoverable branch false note:Assert I can find my modules
193 my $file = "$rst_dir[0]/$use.pm";
194 # uncoverable branch true note:Assert I can open my modules
195 open(USE
, $file) or die "Cannot open $file";
197 print "\n" unless $newline_done++;
198 if ((/^=begin $mark/ .. /^=end $mark/) &&
199 ! /^=(begin|end) $mark/) {
200 s/(\$\{[^\}]+\}+)/eval $1/ge;
207 my (@directives, %directives);
209 foreach $dir (@INC) {
210 grep(m
|([^/]+)$| && ($directives{$1} = $_),
211 glob "$dir/Text/Restructured/Directive/*.pm");
213 @directives = map($directives{$_}, sort keys %directives);
214 # uncoverable branch false note:Assert I have directives
215 print << 'EOS' if @directives;
217 Descriptions of Plug
-in Directives
218 ==================================
220 foreach my $directive (@directives) {
221 $directive =~ m
|([^/]+)\
.pm
|;
223 # uncoverable branch true note:Assert directive unique/readable
224 next if $used{$fname} || ! -r
$directive;
226 # uncoverable branch true note:Assert I can open directives
227 open(DIRECTIVE
, $directive) or die "Cannot open $directive";
228 while (<DIRECTIVE
>) {
229 if ((/^=begin $mark/ .. /^=end $mark/) &&
230 ! /^=(begin|end) $mark/) {
232 my $title = "Documentation for plug-in directive '$fname'";
233 print "\n$title\n",('-' x
length($title)),"\n";
235 s/(\$\{[^\}]+\})/eval $1/ge;
243 foreach $dir (@INC) {
244 push(@writers, glob("$dir/Text/Restructured/Writer/*.wrt"));
247 # uncoverable branch false note:Assert I have writers
248 print << 'EOS' if @writers;
250 Descriptions of Writers
251 =======================
255 foreach $writer (@writers) {
256 my ($writer_name) = $writer =~ m
|([^/]+)\
.wrt
$|;
257 next if $done_writer{$writer_name}++;
259 # uncoverable branch true note:Assert I can open writers
260 open(WRITER
, $writer) or die "Cannot open $writer";
262 if ((/^=begin $mark/ .. /^=end $mark/) &&
263 ! /^=(begin|end) $mark/) {
266 "Documentation for writer '$writer_name'";
267 print "\n$title\n",('-' x
length($title)),"\n";
269 s/(\$\{[^\}]+\})/eval $1/ge;
278 # uncoverable statement note:Defensive programming
279 print STDERR
"Usage not available.\n";