#!/usr/local/bin/perl -w

# $Id: prest 4870 2007-01-08 22:02:23Z mnodine $

=pod
=begin reST
=begin Id
Id: ${TOOL_ID}.
Copyright (C) 2002-2005 Freescale Semiconductor
Distributed under terms of the Perl license, which is the disjunction of
the GNU General Public License (GPL) and the Artistic License.
=end Id

=begin Description
Description of ${TOOL_NAME}
===========================
This program converts the DocUtils reStructuredText or
Document Object Model (DOM) (aka pseudo-XML) formats into an output
format.  The default output format is HTML, but different formats can
be specified by using different writer schemas.

=end Description
=begin Usage
Usage: ${TOOL_NAME} [options] file(s)

Options:
  -d            Print debugging info on STDERR.  May be used multiple
                times to get more information.
  -h            Print full usage help
  -w <writer>   Process the writer schema from <writer>.wrt (default 'html')
  -D var[=val]  Define a variable that affects parsing (may be multiple)
  -W var[=val]  Define a variable that affects a writer (may be multiple)
  -V            Print version info

Available writers: ${\WriterList()}.
=end Usage
=end reST
=cut

# See comments in DOM.pm for DOM structure.
#
# Data structures:
#   _`Handler`: Hash reference with the following 
#     keys:
#       ``tag``:  Regular expression for tag matching
#       ``line``: Line number where function is defined
#       ``text``: Textual representation of the code to run on tag match
#       ``code``: Code reference for the code to run on tag match.
#                 The code is a subroutine with two arguments:
#
#                   the matching DOM object
#
#                   the string returned recursively from the content
#                   of this DOM.
#
#                 It needs to return a string.  Any string returned by the
#                 top level is printed to STDOUT.
#   _`Handler array`:    Reference to array of handler objects.

# Global variables:
#   ``$main::TOP_FILE``: Name of the top-level file being processed.
#   ``$main::opt_d``:    Debug mode
#   ``$main::opt_w``:    The writer schema to be used.
#   ``%main::opt_D``:    Hash whose keys are names of variables whose
#                        defines are specified on the command line
#                        with -D and whose values are the associated
#                        value (or 1 if no value is supplied)
#   ``%main::opt_W``:    Hash whose keys are names of variables whose
#                        defines are specified on the command line
#                        with -W and whose values are the associated
#                        value (or 1 if no value is supplied)
#   ``$main::MY_DIR``:   The real directory in which the prest script lives
#   ``$main::TOOL_ID``:  The tool name and release number
#   ``$main::VERSION``:  The prest version

use strict;

use vars qw($opt_V $opt_h $opt_d $opt_w %opt_W %opt_D);
use vars qw($TOOL_NAME $YEAR $TOP_FILE $SVNID $SVNNAME $VERSION
	    $TOOL_ID);

main();

BEGIN {
    use Text::Restructured::PrestConfig;
    $SVNID = '$Id: prest 4870 2007-01-08 22:02:23Z mnodine $ ';
    $SVNNAME = '$URL: https://mnodine@svn.berlios.de/svnroot/repos/docutils/trunk/prest/prest $ ';
    my $version = $Text::Restructured::PrestConfig::VERSION;
    $version =~ s/(\d\d\d)(?=\d)/$1./g;
    $version =~ s/(\d+)/$1+0/ge;
    $VERSION = $version;
    $SVNID =~ /Id: (\S+?) \S+ (\d+)/;
    $TOOL_ID = "$1 release $VERSION";
    $YEAR = $2;
    ($TOOL_NAME = $1) =~ s/\..*//;
}

# The main entry point.  Parses command-line options, preprocesses the
# writer schema, causes the document(s) to be read, and calls the writer.
sub main {
    use Getopt::Long;
    # Set default option values
    $opt_w = "html";
    $opt_d = 0;

    # Parse options
    Getopt::Long::config('no_ignore_case');
    Usage() unless GetOptions qw(d+ h w=s D:s% W:s% V);
    # Give usage information
    Usage('Description') if $opt_h;
    Usage('Id') if $opt_V;
    Usage() unless @ARGV;

    # Set default of 1 for unspecified -W options
    foreach (keys %opt_W) {
	$opt_W{$_} = 1 if defined $opt_W{$_} && $opt_W{$_} eq '';
    }
    # Initialize defined variables
    foreach my $key (keys %opt_W) {
	(my $var = $key) =~ tr/a-zA-Z0-9/_/c;
	no strict 'refs';
	${"Eval_::$var"} = $opt_W{$key};
    }
    # Process -D variables
    %opt_D = map(do{
	my $val = $opt_D{$_};
	s/-/_/g;
	($_, $val);
    }, keys %opt_D);
    my %report_levels = (info=>1, warning=>2, error=>3, severe=>4, none=>5);
    $opt_D{report} = do {local $^W=0;  # Temporarily shut off warnings
			 main::FirstDefined($report_levels{$opt_D{report}},
					    $opt_D{report})} ;

    use Text::Restructured::Writer;
    my $writer = new Text::Restructured::Writer($opt_w);

    my $first_line = <>;
    my $dom;
    $first_line = "" if ! defined $first_line;
    my $eof = eof;
    use Text::Restructured::DOM;
    # Handle all the documents
    while (defined $first_line) {
	$TOP_FILE = $ARGV;
	if ($first_line =~ /^<document/) {
	    # We have a DOM for input, rather than an rst file
	    ($dom, $first_line) = Text::Restructured::DOM::Parse($first_line);
	}
	else {
	    use Text::Restructured;
	    ($dom, $first_line, $eof) = Text::Restructured::Parse($first_line, $eof);
	}
	# Now compute the output string
	print $writer->ProcessDOM($dom);
    }
}

# Returns the first defined value in an array.
# Argument: array
# Returns: value
sub FirstDefined {
    foreach (@_) {
	return $_ if defined $_;
    }
    return;
}

# Gets list of writers
# Arguments: none
# Returns: list of writers
sub WriterList {
    my ($dir,@writers);
    foreach $dir (@INC) {
	push(@writers, glob("$dir/Text/Restructured/Writer/*.wrt"));
    }
    grep(s|.*/([^/]+)\.wrt$|$1|, @writers);
    return join(', ', @writers);
}

# Extracts and prints usage information
# Arguments: type of usage, end marker for usage (optional)
sub Usage {
    my ($what) = @_;
    $what = "Usage" if ! $what;
    my $mark = $what eq 'Description' ? "($what|Usage)" : $what;
    # Devel::Cover branch 0 1 Assert I can open myself
    if (open(ME,$0)) {
	while (<ME>) {
	    if ((/^=begin $mark/ .. /^=end $mark/) &&
		! /^=(begin|end) $mark/) {
		s/(\$\{[^\}]+\})/eval($1)/ge;
		print;
	    }
	}
	close(ME);

	if ($what =~ /Description/) {
	    my @used = qw(Text/Restructured Text/Restructured/Transforms);
	    my %used;
	    @used{@used} = (1) x @used;
	    my $use;
	    foreach $use (@used) {
		my @rst_dir = grep (-r "$_/$use.pm", @INC);
		# Devel::Cover branch 0 1 Assert I can find my modules
		if (@rst_dir) {
		    my $newline_done;
		    my $file = "$rst_dir[0]/$use.pm";
		    # Devel::Cover branch 0 0 Assert I can open my modules
		    open(USE, $file) or die "Cannot open $file";
		    while (<USE>) {
			print "\n" unless $newline_done++;
			if ((/^=begin $mark/ .. /^=end $mark/) &&
			    ! /^=(begin|end) $mark/) {
			    s/(\$\{[^\}]+\}+)/eval $1/ge;
			    print;
			}
		    }
		    close USE;
		}
	    }
	    my (@directives, %directives);
	    my $dir;
	    foreach $dir (@INC) {
		grep(m|([^/]+)$| && ($directives{$1} = $_),
		     glob "$dir/Text/Restructured/Directive/*.pm");
	    }
	    @directives = map($directives{$_}, sort keys %directives);
	    # Devel::Cover branch 0 1 Assert I have directives
	    print << 'EOS' if @directives;

Descriptions of Plug-in Directives
==================================
EOS
	    foreach my $directive (@directives) {
		$directive =~ m|([^/]+)\.pm|;
		my $fname = $1;
		# Devel::Cover branch 0 0 Assert directive unique/readable
		next if $used{$fname} || ! -r $directive;
		my $output = 0;
		# Devel::Cover branch 0 0 Assert I can open directives
		open(DIRECTIVE, $directive) or die "Cannot open $directive";
		while (<DIRECTIVE>) {
		    if ((/^=begin $mark/ .. /^=end $mark/) &&
			    ! /^=(begin|end) $mark/) {
			if (! $output++) {
			    my $title = "Documentation for plug-in directive '$fname'";
			    print "\n$title\n",('-' x length($title)),"\n";
			}
			s/(\$\{[^\}]+\})/eval $1/ge;
			print;
		    }
		}
		close DIRECTIVE;
	    }

	    my @writers;
	    foreach $dir (@INC) {
		push(@writers, glob("$dir/Text/Restructured/Writer/*.wrt"));
	    }
	    my $writer;
	    # Devel::Cover branch 0 1 Assert I have writers
	    print << 'EOS' if @writers;

Descriptions of Writers
=======================
EOS
	;
	    my %done_writer;
	    foreach $writer (@writers) {
		my ($writer_name) = $writer =~ m|([^/]+)\.wrt$|;
		next if $done_writer{$writer_name}++;
		my $output = 0;
		# Devel::Cover branch 0 0 Assert I can open writers
		open(WRITER, $writer) or die "Cannot open $writer";
		while (<WRITER>) {
		    if ((/^=begin $mark/ .. /^=end $mark/) &&
			    ! /^=(begin|end) $mark/) {
			if (! $output++) {
			    my $title =
				"Documentation for writer '$writer_name'";
			    print "\n$title\n",('-' x length($title)),"\n";
			}
			s/(\$\{[^\}]+\})/eval $1/ge;
			print;
		    }
		}
		close WRITER;
	    }
	}
    }
    else {
	# Devel::Cover statement 0 0 guards internal error
	print STDERR "Usage not available.\n";
    }
    exit (1);
}
