Menu
▾
▴
[Docutils-checkins] r5063 - in trunk/prest: MANIFEST MANIFEST.SKIP Makefile.PL ReleaseNotes.txt lib/Text/Restructured/PrestConfig.pm.PL lib/Text/Restructured/Writer/dom.wrt lib/Text/Restructured/Writer/html.wrt lib/Text/Restructured/Writer/index.wrt lib/Text/Restructured/Writer/latex.wrt lib/Text/Restructured/Writer/toc.wrt lib/Text/Restructured/Writer/xml.wrt lib/Text/Restructured/Writer/xref.wrt lib/Text/Restructured.pm lib/Text/Restructured.pm.PL t/Common.smak
Author: mnodine
Date: 2007-05-03 20:19:53 +0200 (Thu, 03 May 2007)
New Revision: 5063
Added:
trunk/prest/lib/Text/Restructured.pm.PL
Removed:
trunk/prest/lib/Text/Restructured.pm
Modified:
trunk/prest/MANIFEST
trunk/prest/MANIFEST.SKIP
trunk/prest/Makefile.PL
trunk/prest/ReleaseNotes.txt
trunk/prest/lib/Text/Restructured/PrestConfig.pm.PL
trunk/prest/lib/Text/Restructured/Writer/dom.wrt
trunk/prest/lib/Text/Restructured/Writer/html.wrt
trunk/prest/lib/Text/Restructured/Writer/index.wrt
trunk/prest/lib/Text/Restructured/Writer/latex.wrt
trunk/prest/lib/Text/Restructured/Writer/toc.wrt
trunk/prest/lib/Text/Restructured/Writer/xml.wrt
trunk/prest/lib/Text/Restructured/Writer/xref.wrt
trunk/prest/t/Common.smak
Log:
* Create lib/Text/Restructured.pm from lib/Text/Restructured.pm.PL so
we can insert the versio number in to allow CPAN to index it
correctly.
* Fixed a problem with creating regular-expression expects for tests.
Modified: trunk/prest/MANIFEST
===================================================================
--- trunk/prest/MANIFEST 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/MANIFEST 2007-05-03 18:19:53 UTC (rev 5063)
@@ -21,7 +21,7 @@
doc/tools/perlsynopsis.prl
GPL.txt
insertperl.pl
-lib/Text/Restructured.pm
+lib/Text/Restructured.pm.PL
lib/Text/Restructured/default.css
lib/Text/Restructured/Directive/code_block.pm
lib/Text/Restructured/Directive/if.pm
Modified: trunk/prest/MANIFEST.SKIP
===================================================================
--- trunk/prest/MANIFEST.SKIP 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/MANIFEST.SKIP 2007-05-03 18:19:53 UTC (rev 5063)
@@ -16,6 +16,7 @@
^MANIFEST\.SKIP$
^pm_to_blib$
^t/Common\.mk$
+^lib/Text/Restructured.pm$
^lib/Text/Restructured/PrestConfig\.pm$
^t/.uncoverable$
Modified: trunk/prest/Makefile.PL
===================================================================
--- trunk/prest/Makefile.PL 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/Makefile.PL 2007-05-03 18:19:53 UTC (rev 5063)
@@ -5,6 +5,8 @@
use ExtUtils::MakeMaker;
+# $Id$
+
# Usage: perl Makefile.PL [options]
# Options:
# -f file Use file for default configuration values (default is config.log)
@@ -13,7 +15,7 @@
## Note: The version number for the entire release is specified here and
## propagated. Be sure to edit for every release.
-my $Version = "0.003027";
+my $Version = "0.003028";
use vars qw($opt_f $opt_h $opt_k);
my $OUTPUT_CFG_FILE = $opt_f = 'config.log';
@@ -158,12 +160,14 @@
PREREQ_PM => { 'Text::ASCIIMathML'=>0,
'Slay::Makefile'=>0,
}, # e.g., Module::Name => 1.1
- PL_FILES => {'lib/Text/Restructured/PrestConfig.pm.PL' =>
- "lib/Text/Restructured/PrestConfig.pm"},
+ PL_FILES => {'lib/Text/Restructured.pm.PL' =>
+ 'lib/Text/Restructured.pm',
+ 'lib/Text/Restructured/PrestConfig.pm.PL' =>
+ 'lib/Text/Restructured/PrestConfig.pm'},
PM => {'lib/Text/Restructured/PrestConfig.pm' =>
'blib/lib/Text/Restructured/PrestConfig.pm',
%pm_files},
- PM_FILTER => qq($^X -pe "END{print qq{our \\044VERSION=$Version\\;\\n}}"),
+# PM_FILTER => qq($^X -pe "END{print qq{our \\044VERSION=$Version\\;\\n}}"),
# FIXIN => 'cp',
test => { TESTS => join ' ',@TESTS },
clean => { FILES =>(join(' ', (@TESTS, map(/(.*)\.t$/ && "$1.dir",
Modified: trunk/prest/ReleaseNotes.txt
===================================================================
--- trunk/prest/ReleaseNotes.txt 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/ReleaseNotes.txt 2007-05-03 18:19:53 UTC (rev 5063)
@@ -5,6 +5,13 @@
.. contents::
+Release 0.3.28
+--------------
+* Create lib/Text/Restructured.pm from lib/Text/Restructured.pm.PL so
+ we can insert the versio number in to allow CPAN to index it
+ correctly.
+* Fixed a problem with creating regular-expression expects for tests.
+
Release 0.3.27
--------------
Fixed problem with CPAN indexing of versions.
Modified: trunk/prest/lib/Text/Restructured/PrestConfig.pm.PL
===================================================================
--- trunk/prest/lib/Text/Restructured/PrestConfig.pm.PL 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/lib/Text/Restructured/PrestConfig.pm.PL 2007-05-03 18:19:53 UTC (rev 5063)
@@ -11,7 +11,12 @@
open OUT, ">$file" or die "Cannot write to $file";
# My output
-my $output = << 'EOS';
+my $output = join '',<DATA>;
+# Substitute in for ${perlvar} references
+$output =~ s/(\$ \{ \S+ \})/my $v = eval "qq($1)"; $v || $1/gex;
+print OUT $output;
+close OUT;
+__END__
package Text::Restructured::PrestConfig;
$DEFAULTCSS = "${CONFIG{defaultcss}}";
@@ -21,8 +26,3 @@
$DOCURL = "${CONFIG{docurl}}";
1;
-EOS
-# Substitute in for ${perlvar} references
-$output =~ s/(\$ \{ \S+ \})/eval "qq($1)"/gex;
-print OUT $output;
-close OUT;
Modified: trunk/prest/lib/Text/Restructured/Writer/dom.wrt
===================================================================
--- trunk/prest/lib/Text/Restructured/Writer/dom.wrt 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/lib/Text/Restructured/Writer/dom.wrt 2007-05-03 18:19:53 UTC (rev 5063)
@@ -1,5 +1,5 @@
# -*-perl-*-
-# $Id: dom.wrt 768 2006-01-28 03:33:28Z marknodine $
+# $Id$
# Copyright (C) 2002-2005 Freescale Semiconductor, Inc.
# Distributed under terms of the Perl license, which is the disjunction of
# the GNU General Public License (GPL) and the Artistic License.
Property changes on: trunk/prest/lib/Text/Restructured/Writer/dom.wrt
___________________________________________________________________
Name: svn:keywords
+ Date Id HeadURL
Modified: trunk/prest/lib/Text/Restructured/Writer/html.wrt
===================================================================
--- trunk/prest/lib/Text/Restructured/Writer/html.wrt 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/lib/Text/Restructured/Writer/html.wrt 2007-05-03 18:19:53 UTC (rev 5063)
@@ -1,5 +1,5 @@
# -*-perl-*-
-# $Id: html.wrt 772 2006-01-29 22:15:11Z marknodine $
+# $Id$
# Copyright (C) 2002-2005 Freescale Semiconductor, Inc.
# Distributed under terms of the Perl license, which is the disjunction of
# the GNU General Public License (GPL) and the Artistic License.
Property changes on: trunk/prest/lib/Text/Restructured/Writer/html.wrt
___________________________________________________________________
Name: svn:keywords
+ Date Id HeadURL
Modified: trunk/prest/lib/Text/Restructured/Writer/index.wrt
===================================================================
--- trunk/prest/lib/Text/Restructured/Writer/index.wrt 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/lib/Text/Restructured/Writer/index.wrt 2007-05-03 18:19:53 UTC (rev 5063)
@@ -1,5 +1,5 @@
# -*-perl-*-
-# $Id: index.wrt 768 2006-01-28 03:33:28Z marknodine $
+# $Id$
# Copyright (C) 2002-2005 Freescale Semiconductor, Inc.
# Distributed under terms of the Perl license, which is the disjunction of
# the GNU General Public License (GPL) and the Artistic License.
Property changes on: trunk/prest/lib/Text/Restructured/Writer/index.wrt
___________________________________________________________________
Name: svn:keywords
+ Date Id HeadURL
Modified: trunk/prest/lib/Text/Restructured/Writer/latex.wrt
===================================================================
--- trunk/prest/lib/Text/Restructured/Writer/latex.wrt 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/lib/Text/Restructured/Writer/latex.wrt 2007-05-03 18:19:53 UTC (rev 5063)
@@ -1,5 +1,5 @@
# -*-perl-*-
-# $Id: latex.wrt 768 2006-01-28 03:33:28Z marknodine $
+# $Id$
# Copyright (C) 2002-2005 Freescale Semiconductor, Inc.
# Distributed under terms of the Perl license, which is the disjunction of
# the GNU General Public License (GPL) and the Artistic License.
Property changes on: trunk/prest/lib/Text/Restructured/Writer/latex.wrt
___________________________________________________________________
Name: svn:keywords
+ Date Id HeadURL
Modified: trunk/prest/lib/Text/Restructured/Writer/toc.wrt
===================================================================
--- trunk/prest/lib/Text/Restructured/Writer/toc.wrt 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/lib/Text/Restructured/Writer/toc.wrt 2007-05-03 18:19:53 UTC (rev 5063)
@@ -1,5 +1,5 @@
# -*-perl-*-
-# $Id: toc.wrt 768 2006-01-28 03:33:28Z marknodine $
+# $Id$
# Copyright (C) 2002-2005 Freescale Semiconductor, Inc.
# Distributed under terms of the Perl license, which is the disjunction of
# the GNU General Public License (GPL) and the Artistic License.
Property changes on: trunk/prest/lib/Text/Restructured/Writer/toc.wrt
___________________________________________________________________
Name: svn:keywords
+ Date Id HeadURL
Modified: trunk/prest/lib/Text/Restructured/Writer/xml.wrt
===================================================================
--- trunk/prest/lib/Text/Restructured/Writer/xml.wrt 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/lib/Text/Restructured/Writer/xml.wrt 2007-05-03 18:19:53 UTC (rev 5063)
@@ -1,5 +1,5 @@
# -*-perl-*-
-# $Id: xml.wrt 591 2005-06-28 20:21:28Z nodine $
+# $Id$
# Copyright (C) 2002-2005 Freescale Semiconductor, Inc.
# Distributed under terms of the Perl license, which is the disjunction of
# the GNU General Public License (GPL) and the Artistic License.
Property changes on: trunk/prest/lib/Text/Restructured/Writer/xml.wrt
___________________________________________________________________
Name: svn:keywords
+ Date Id HeadURL
Modified: trunk/prest/lib/Text/Restructured/Writer/xref.wrt
===================================================================
--- trunk/prest/lib/Text/Restructured/Writer/xref.wrt 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/lib/Text/Restructured/Writer/xref.wrt 2007-05-03 18:19:53 UTC (rev 5063)
@@ -1,5 +1,5 @@
# -*-perl-*-
-# $Id: xref.wrt 768 2006-01-28 03:33:28Z marknodine $
+# $Id$
# Copyright (C) 2002-2005 Freescale Semiconductor, Inc.
# Distributed under terms of the Perl license, which is the disjunction of
# the GNU General Public License (GPL) and the Artistic License.
Property changes on: trunk/prest/lib/Text/Restructured/Writer/xref.wrt
___________________________________________________________________
Name: svn:keywords
+ Date Id HeadURL
Deleted: trunk/prest/lib/Text/Restructured.pm
Copied: trunk/prest/lib/Text/Restructured.pm.PL (from rev 5062, trunk/prest/lib/Text/Restructured.pm)
===================================================================
--- trunk/prest/lib/Text/Restructured.pm 2007-04-27 20:57:35 UTC (rev 5062)
+++ trunk/prest/lib/Text/Restructured.pm.PL 2007-05-03 18:19:53 UTC (rev 5063)
@@ -0,0 +1,4737 @@
+#!/usr/local/bin/perl -w
+use strict;
+
+my $file = shift;
+
+# Read the config file (if it exists)
+my $cf = 'config.log';
+open CF, $cf or die "Cannot open $cf; rerun 'perl Makefile.PL'";
+my %CONFIG = eval(join('',<CF>));
+close CF;
+
+open OUT, ">$file" or die "Cannot write to $file";
+# My output
+my $output = join '',<DATA>;
+# Substitute in for ${perlvar} references
+{
+ no warnings;
+ $output =~ s/(\$ \{ \S+ \})/my $v = eval "qq($1)"; $v || $1/gex;
+}
+print OUT "# DO NOT EDIT THIS FILE; it was produced from $0\n";
+print OUT $output;
+close OUT;
+__END__
+# $Id$
+# Copyright (C) 2002-2005 Freescale Semiconductor, Inc.
+
+# Distributed under terms of the Perl license, which is the disjunction of
+# the GNU General Public License (GPL) and the Artistic License.
+
+package Text::Restructured;
+
+$VERSION = ${CONFIG{version}};
+
+# This package does parsing of reStructuredText files
+
+=pod
+
+=head1 NAME
+
+Text::Restructured - Perl implementation of reStructuredText parser
+
+=head1 DOCUMENTATION
+
+The documentation is in reST format. You can build it with C<make doc>
+or visit L<http://www.prest.de/doc/>.
+
+=begin reST
+=begin Usage
+Defines for reStructuredText parser
+-----------------------------------
+-D align=<0|1> Allow inferring right/center alignment in
+ single line simple table cells (default is 1).
+-D entry-attr=<text>
+ Specifies attributes to be passed to table entry
+ (default is ''). Note: this option can be
+ changed on the fly within a table by using a perl
+ directive to set $main::opt_D{entry_attr}.
+-D file-insertion-enabled[=<0|1>]
+ Allows include directives to include files, which may
+ be a potential security hole. Default is 1.
+-D ignore-include-errs[=<0|1>]
+ Specifies that no error should be generated for
+ missing include files. Default is 0.
+-D image-exts=<ext-list>
+ A comma-separated list of "ext1=ext2" pairs where
+ any URI with extension ext1 has it mapped to ext2.
+ This option allows using a single document
+ source with multiple writers by using whatever
+ figure extension is appropriate for a given writer.
+-D include-ext=<text>
+ A colon-separated list of extensions to check for
+ included files. Default is ":.rst:.txt".
+-D include-path=<text>
+ A colon-separated list of directories for the
+ include directive to search. The special token
+ "<.>" represents the directory of the file
+ containing the directive (which may not be the
+ same as the directory in which trip is invoked, ".".
+ Default is "<.>".
+-D mstyle=<comma-separated-attr-val-list>
+ A comma-separated set of attribute=value pairs to
+ be used for the <mstyle> elements of MathML
+ markup. Default is displaystyle=true for
+ ascii-mathml directive.
+-D nest-inline[=<0|1>]
+ Specify whether to allow nesting of inline markup.
+ There are some limitations, like strong cannot be
+ nested within emphasis.
+ Default is 1 (1 if specified with no value).
+-D perl-path=<text>
+ A colon-separated list of directories to search
+ for Perl modules. The special token "<INC>"
+ represents the default Perl include path.
+ Default is "<INC>".
+-D raw-enabled[=<0|1>]
+ Allows raw directives to be processed, which may
+ be a potential security hole. Default is 1.
+-D report=<level> Set verbosity threshold; report system messages
+ at or higher than <level> (by name or number:
+ "info" or "1", warning/2, error/3, severe/4;
+ also, "none" or 5). Default is 2 (warning).
+-D row-attr=<text>
+ Specifies attributes to be passed to table rows
+ (default is ''). Note: this option can be
+ changed on the fly within a table by using a perl
+ directive to set $main::opt_D{row_attr}.
+-D source=<text> Overrides the file name as the source.
+-D table-attr=<text>
+ Specifies attributes to be passed to tables (default
+ is '${Text::Restructured::DEFAULTS{table_attr}}').
+ Note: this option can be changed on the fly to
+ have tables with different characteristics by
+ using a perl directive to set
+ $main::opt_D{table_attr}.
+-D tabstops=<num> Specifies that tab characters are assumed to tab
+ out to every <num> characters (default is 8).
+-D xformoff=<regexp>
+ Turns off default transforms matching regexp.
+ (Used for internal testing.)
+=end Usage
+=end reST
+=cut
+
+# Global variables:
+# Many static (read-only) variables defined in BEGIN blocks (not documented).
+
+# Data structures:
+# _`Text::Restructured`: reStructuredText _`parser` hash reference with
+# the following keys:
+# ``next_id``: The next id to be returned by Id() method;
+# ``SEC_LEVEL``: Hash reference whose keys are header styles and whose
+# value (if defined) indicates the level of
+# sections encoded with that header style.
+# ``SEC_DOM``: Array reference whose index is the section level and
+# whose value is the section DOM object at that level.
+# ``SEC_STYLE``: Array reference whose index is the section level and
+# whose value is the section style at that level.
+# ``ANONYMOUS_TARGETS``: Array reference of references to anonymous
+# target DOMs in file order.
+# ``REFERENCE_DOM``: Hash reference whose keys are tags and whose values
+# are references to a hash with names or ids as
+# keys and the associated target DOM object as
+# value.
+# ``TARGET_NAME``: Hash reference whose keys are namespace ids and whose
+# values are references to a hash whose keys
+# are names and whose value is a reference to
+# an array of all the DOM objects having that
+# name in that name space.
+# ``ALL_TARGET_IDS``: Hash reference whose keys are ids and whose value
+# is a reference to an array of all the DOM
+# objects having that id.
+# ``ALL_TARGET_NAMES``: Hash reference whose keys are names and whose
+# value is a reference to an array of all the
+# DOM objects having that name.
+# ``MY_ROLES``: Hash reference whose keys are the role names that are
+# currently defined for the current document
+# (it gets reset between documents) and whose
+# values are Role definition hash references.
+# ``MY_DEFAULT_ROLE``: The current name of the default role
+# for the current document. Initially
+# ``title_reference``.
+
+use strict;
+
+# Initialized (read-only) global variables
+use vars qw($BULLETS $EMAIL $ENUM $ENUM_INDEX $FIELD_LIST $LINE_BLOCK
+ $MARK_END_TRAILER $MARK_START $MIN_SEC_LEN $OPTION
+ $OPTION_LIST $SECTION_HEADER $SEC_CHARS %DIRECTIVES
+ %ERROR_LEVELS %IMPLICIT_SCHEME %LEFT_BRACE %MARK_END
+ %MARK_TAG %MARK_TAG_START %MATCH_BRACE %ROLES
+ $DEFAULT_ROLE %XML_SPACE %DEFAULTS
+ %CITSPACE %NAMESPACE @UNITS $DOM);
+
+BEGIN {
+ use Text::Restructured::URIre;
+ # Note: all of scalars are read-only
+ *DOM = \"Text::Restructured::DOM"; #";/
+ *SEC_CHARS = \'[^a-zA-Z0-9\s]'; #';
+ *SECTION_HEADER = \"(((?!$SEC_CHARS+\\n(?:\\n|\\Z))(?!::\\n|(?:(?:\\.\\.|__)\\n(?: |\\.\\.[ \\n]|__[ \\n]|\\n)))($SEC_CHARS)\\3+)\\n(.*\\n)?(($SEC_CHARS)\\6+\\n)?|^(?!(?:\\.\\.|__)(?: .*)?\\n(?:\.\.|__)[ \\n])(\\S.*\\n)(($SEC_CHARS)\\9+)\\n)"; #";
+ *BULLETS = \'[-*+]'; #';
+ *LINE_BLOCK = \'\|'; #';
+ *MIN_SEC_LEN = \4;
+ my $rst_low_roman = 'm{0,4}(?:dc{0,3}|c[dm]|c{0,3})?(?:lx{0,3}|x[lc]|x{0,3})?(?:vi{0,3}|i[vx]|i{0,3})?';
+ (my $rst_upp_roman = $rst_low_roman) =~ tr/a-z/A-Z/;
+ *ENUM_INDEX = \"\\d+|[a-zA-Z]|$rst_low_roman|$rst_upp_roman|\#"; #";
+ *ENUM = \"(\\()?($ENUM_INDEX)([\\).])"; #";
+ *FIELD_LIST = \':(?! )[^:\n]*[^:\n ]:(?!\`[^\`]*?\`)'; #';
+ *OPTION = \'[+-][\w](?: [^ ,]+| ?<[^>]+>)?|(?:--?[\w][\w-]*|/[A-Z]+)(?:=[^ ,=]+| [^ ,]+|=<[^>]+>)?'; #';
+ *OPTION_LIST = \"(?:$OPTION)(?:, (?:$OPTION))*(?: |\\s*\\n )"; #";
+ %ERROR_LEVELS = (1=>"INFO", 2=>"WARNING", 3=>"ERROR", 4=>"SEVERE");
+ *EMAIL = \'[\w.-]+\@[\w.-]*[\w-]'; #';
+ *MARK_START = \'\*\*?|\`\`?|\||_\`|\['; #';
+ %MARK_END = ('*'=>'\*', '**'=>'\*\*', '`'=>'\`_?_?', '``'=>'\`\`',
+ '|'=>'\|_?_?', '_`'=>'\`', '['=>'\]__?',
+ ''=>"__?|$Text::Restructured::URIre::absoluteURI|$EMAIL");
+ *MARK_END_TRAILER = \'[-\'\"\)\]\}\\\\>/:.,;!? ]|\Z'; #';
+ %MARK_TAG = ('**'=>'emphasis', '****'=>'strong', '``'=>'interpreted',
+ '````'=>'literal', '||'=>'substitution_reference',
+ '||_'=>'substitution_reference',
+ '||__'=>'substitution_reference',
+ '_``'=>'target', '[]_'=>'footnote_reference',
+ '``_'=>'reference',
+ '_'=>'reference', '``__'=>'reference',
+ '__'=>'reference');
+ %MARK_TAG_START = ('*'=>'emphasis', '**'=>'strong',
+ '`'=>'interpreted text or phrase reference', '``'=>'literal',
+ '|'=>'substitution_reference', '_`'=>'target',
+ '['=>'footnote', ''=>'reference');
+ %MATCH_BRACE = ('"'=>'"', "'"=>"'", '('=>')', '['=>']', '{'=>'}',
+ '<'=>'>', ''=>'impossible', '_`'=>'`');
+ %LEFT_BRACE = ('>'=>'<', ')'=>'(', ']'=>'[', '}'=>'{');
+ my @implicit_schemes = qw(acap afs cid data dav fax file ftp go
+ gopher h323 http https im imap ipp ldap
+ mailserver mailto mid modem mupdate news
+ nfs nntp opaquelocktoken pop pres
+ prospero rtsp service sip sips soap.beep
+ soap.beeps tel telnet tftp tip tn3270
+ urn vemmi wais xmlrpc.beep xmlrpc.beeps
+ z39.50r z39.50s
+ );
+ @IMPLICIT_SCHEME{@implicit_schemes} = (1) x @implicit_schemes;
+ %DIRECTIVES = (admonition=> \&Text::Restructured::Directive::admonition,
+ attention => \&Text::Restructured::Directive::admonition,
+ caution => \&Text::Restructured::Directive::admonition,
+ danger => \&Text::Restructured::Directive::admonition,
+ error => \&Text::Restructured::Directive::admonition,
+ hint => \&Text::Restructured::Directive::admonition,
+ important => \&Text::Restructured::Directive::admonition,
+ note => \&Text::Restructured::Directive::admonition,
+ tip => \&Text::Restructured::Directive::admonition,
+ warning => \&Text::Restructured::Directive::admonition,
+ footer => \&Text::Restructured::Directive::decoration,
+ header => \&Text::Restructured::Directive::decoration,
+ section_numbering
+ => \&Text::Restructured::Directive::sectnum,
+ section_autonumbering
+ => \&Text::Restructured::Directive::sectnum,
+ csv_table => \&Text::Restructured::Directive::table,
+ list_table=> \&Text::Restructured::Directive::table,
+ restructuredtext_test_directive
+ => \&Text::Restructured::Directive::test_directive,
+ ascii_mathml
+ => \&Text::Restructured::Directive::ascii_mathml,
+ mathml => \&Text::Restructured::Directive::ascii_mathml,
+ );
+ %ROLES = (emphasis =>{tag=>'emphasis'},
+ strong =>{tag=>'strong'},
+ literal =>{tag=>'literal'},
+ subscript =>{tag=>'subscript'},
+ sub =>{alias=>'subscript'},
+ superscript=>{tag=>'superscript'},
+ sup =>{alias=>'superscript'},
+ ab =>{tag=>'abbreviation'},
+ ac =>{tag=>'acronym'},
+ inline =>{tag=>'inline'},
+ raw =>{tag=>'raw', attr=>{'xml:space'=>'preserve'},
+ check=>\&Text::Restructured::Role::raw},
+ 'raw-formatting'=>{tag=>'inline'},
+ 'pep-reference' =>{alias=>'PEP'},
+ PEP =>{
+ tag =>'reference',
+ attr =>{refuri=>"http://www.python.org/peps/pep-%04d.html"},
+ text =>"PEP %s",
+ check=>\&Text::Restructured::Role::PEP,
+ },
+ 'rfc-reference'=>{alias=>'RFC'},
+ RFC =>{
+ tag =>'reference',
+ attr =>{refuri=>"http://www.faqs.org/rfcs/rfc%04d.html"},
+ text =>"RFC %s",
+ check=>\&Text::Restructured::Role::RFC,
+ },
+ 'title-reference'=>{tag=>'title_reference'},
+ title =>{alias=>'title-reference'},
+ t =>{alias=>'title-reference'},
+ 'ascii-mathml'=>{alias=>'mathml'},
+ mathml =>{
+ tag =>'mathml',
+ attr=>{mathml=>sub {
+ my ($parser, $attr, $text) = @_;
+ if (! $parser->{_MathML}) {
+ eval "use Text::ASCIIMathML";
+ $parser->{_MathML} = new Text::ASCIIMathML
+ unless $@;
+ }
+ return $parser->{_MathML} ?
+ $parser->{_MathML}->TextToMathMLTree
+ ($text, [title=>$text, xmlns=>"&mathml;"],
+ [$parser->{opt}{D}{mstyle} ?
+ @{$parser->{opt}{D}{mstyle}} : ()]) :
+ '';
+
+ },
+ 'raw'=>1},
+ },
+ );
+ *DEFAULT_ROLE = \'title-reference'; #';
+ @UNITS = (qw(em ex px in cm mm pt pc), '');
+ %XML_SPACE = ('xml:space'=>'preserve');
+ %DEFAULTS = (align=>1,
+ file_insertion_enabled=>1,
+ include_ext=>':.rst:.txt',
+ include_path=>'<.>',
+ nest_inline=>1,
+ perl_path=>'<INC>',
+ raw_enabled=>1,
+ report=>2,
+ table_attr=>'border="1" class="docutils"',
+ tabstops=>8);
+}
+
+use Text::Restructured::DOM;
+
+# Creates a new Parser object
+# Arguments: hash to reference of options, tool identifier
+sub new {
+ my ($class, $opt, $tool_id) = @_;
+ my $self = { opt => { %$opt }, TOOL_ID => $tool_id };
+ bless $self, $class;
+ $self->{opt}{d} ||= 0;
+ $self->{opt}{w} = 'html' unless $self->{opt}{w};
+ $self->{opt}{D} = {} unless $self->{opt}{D};
+ $self->init();
+ $self;
+}
+
+# Processes defaults for -D defines and resets object variables
+# between documents.
+# Arguments: document DOM object, file name
+# Returns: None
+# Sets instance vars: SEC_LEVEL, SEC_DOM, TOPDOM SEC_STYLE,
+# ANONYMOUS_TARGETS, REFERENCE_DOM, TARGET_NAME,
+# ALL_TARGET_IDS, ALL_TARGET_NAMES MY_ROLES,
+# MY_DEFAULT_ROLE
+sub init : method {
+ my ($self, $doc, $filename) = @_;
+
+ # Process -D variables
+ %{$self->{opt}{D}} = map(do{
+ my $val = $self->{opt}{D}{$_};
+ s/-/_/g;
+ ($_, $val);
+ }, keys %{$self->{opt}{D}});
+ foreach (keys %DEFAULTS) {
+ $self->{opt}{D}{$_} = $DEFAULTS{$_} unless defined $self->{opt}{D}{$_};
+ }
+ foreach (keys %{$self->{opt}{D}}) {
+ # Force any defines with no values specified to be 1
+ $self->{opt}{D}{$_} = 1
+ if defined $self->{opt}{D}{$_} && $self->{opt}{D}{$_} eq '';
+ }
+ my %report_levels = (info=>1, warning=>2, error=>3, severe=>4, none=>5);
+ $self->{opt}{D}{report} =
+ do { local $^W=0; # Temporarily shut off warnings
+ $report_levels{$self->{opt}{D}{report}} ||
+ $self->{opt}{D}{report} };
+
+ delete $self->{NEXT_ID};
+ delete $self->{SEC_LEVEL};
+ $self->{SEC_DOM} = [$doc];
+ $self->{SEC_STYLE} = [''];
+ delete $self->{ANONYMOUS_TARGETS};
+ delete $self->{REFERENCE_DOM};
+ delete $self->{TARGET_NAME};
+ delete $self->{ALL_TARGET_IDS};
+ delete $self->{ALL_TARGET_NAMES};
+ $self->{TOPDOM} = $doc;
+ $self->{TOP_FILE} = $filename;
+
+ # Handle the Perl include path
+ my $perl_inc = join(':', @INC);
+ my $new_inc = $self->{opt}{D}{perl_path};
+ $new_inc =~ s/<inc>/$perl_inc/gi;
+ @INC = split(/:/, $new_inc);
+ delete $self->{opt}{D}{perl_path};
+
+ # Preprocess the mstyle define
+ if ($self->{opt}{D}{mstyle} && ref($self->{opt}{D}{mstyle}) ne 'ARRAY') {
+ my %attr = map((/(\w+)=(.*)/g), split(/\s*,\s*/,
+ $self->{opt}{D}{mstyle}));
+ $self->{opt}{D}{mstyle} = [ map(($_,$attr{$_}), sort keys %attr) ] ;
+ }
+
+ $self->{MY_DEFAULT_ROLE} = $DEFAULT_ROLE;
+ $self->{MY_ROLES} = { %ROLES };
+ $self->{ANONYMOUS_TARGETS} = [ ];
+}
+
+# Returns a DOM object for a problematic with its ids.
+# Arguments: message, reference id (optional), id (optional)
+# Returns: DOM object, reference id, id
+sub problematic : method {
+ my ($self, $text, $refid, $id) = @_;
+
+ $refid = $self->Id() unless defined $refid;
+ $id = $self->Id() unless defined $id;
+ my $dom = $DOM->new ('problematic', refid=>$refid, ids=>[ $id ]);
+ $dom->append($DOM->newPCDATA($text));
+ return ($dom, $refid, $id);
+}
+
+# Returns a DOM object for a system message.
+# Arguments: severity level, source, line number, message, literal text,
+# key/value pairs for additional attributes
+sub system_message : method {
+ my ($self, $level, $source, $lineno, $msg, $lit, %attr) = @_;
+ my $dom = $DOM->new("system_message", level=>$level, line=>$lineno,
+ source=>$source,
+ type=>$ERROR_LEVELS{$level}, %attr);
+ my $para = $DOM->new('paragraph');
+ $para->append($DOM->newPCDATA("$msg\n"));
+ $dom->append($para);
+ if (defined $lit && $lit ne '') {
+ my $lb = $DOM->new('literal_block', %XML_SPACE);
+ $lb->append($DOM->newPCDATA($lit));
+ $dom->append($lb);
+ }
+ my $line = $lineno ? ":$lineno" : '';
+ print STDERR "$source$line ($ERROR_LEVELS{$level}/$level) $msg\n"
+ if $level >= $self->{opt}{D}{report} && $source !~ 'test data';
+ return $dom;
+}
+
+# Processes a bulleted list paragraph.
+# Arguments: paragraph, source, line number
+# Returns: processed paragraph, list of DOM objects and unprocessed paragraphs
+sub BulletList : method {
+ my($self, $para, $source, $lineno) = @_;
+
+ my @err;
+ my $lines = 0;
+ my ($processed, @unp);
+ $para =~ /^($BULLETS)(?: |\n)/o;
+ my $dom = $DOM->new('bullet_list', bullet=>$1);
+ my $bullet = "\\$1";
+ (undef, my @paras) = split /^($bullet(?: +|\n))/m, $para;
+ while (my ($bull, $p) = splice @paras, 0, 2) {
+ $p = '' unless defined $p;
+ my $li = $DOM->new('list_item');
+ $dom->append($li);
+ my $para = "$bull$p";
+ $para =~ s/^$bullet *//;
+ $para =~ s/^ //mg;
+ $self->Paragraphs($li, $para, $source, $lineno+$lines);
+ $lines += $para =~ tr/\n//;
+ $processed .= $para;
+ }
+ return ($processed, @err, $dom, @unp);
+}
+
+# Coalesces a series of similar paragraphs and divides initial
+# paragraph for unexpected indents.
+# Argument: reference to array of paragraphs
+# Returns: None (but modifies the paragraphs referenced by the argument)
+sub Coalesce : method {
+ my ($self, $paras) = @_;
+ # Note: consecutive paragraphs are two indices apart in the array, with
+ # any blank lines between them in the intermediate index. We also use
+ # the intermediate index to store error sentinels, which begin with a
+ # newline and have a non-blank character in the second line.
+ my $p;
+ my ($enumtype, $enumval, $enumprefix, $enumsuffix) = ('') x 4;
+ for ($p=0; $p <= 2 && $p < @$paras; $p++) {
+#print STDERR "[",join("][",@{$paras}[0..2]),"]\n";
+ # Pull out the part of the paragraph prior to a blank line
+ my @split = split /^(\s*\n)/, $paras->[$p], 2;
+ my ($pre_p, $post_p) = @split > 1 ? @split :
+ ($paras->[$p], '');
+ # May need to split the first paragraph
+ if ($pre_p =~ /^($BULLETS)(?: |\n)/so) {
+ # Bulleted list
+ if ((my @s = split /^(?![$1]| )(.)/m, $pre_p, 2) > 1) {
+ # Bulleted list has unexpected unindent
+ splice(@$paras, $p, 1,($s[0],
+ # This is a sentinel that an error occurred
+ "\n" . q($self->system_message(2, $source, $lineno, "Bullet list ends without a blank line; unexpected unindent.")),
+ "$s[1]$s[-1]$post_p"));
+ }
+ }
+ elsif ($pre_p =~ /^($LINE_BLOCK)(?: |\n)/so) {
+ # Line block
+ if ((my @s = split /^(?!$LINE_BLOCK(?:\s+\S|\n)| )(.)/m,
+ $pre_p, 2) > 1) {
+ # Line block has unexpected unindent
+ splice(@$paras, $p, 1,($s[0],
+ # This is a sentinel that an error occurred
+ "\n" . q($self->system_message(2, $source, $lineno, "Line block ends without a blank line.")),
+ "$s[1]$s[-1]$post_p"));
+ }
+ }
+ elsif ($pre_p =~ /^$SECTION_HEADER/om) {
+ }
+ elsif ($pre_p =~ /^((\.\.|__)( |\n))/) {
+ # A comment or anonymous target
+ $pre_p =~ s/^(.*\n?)//;
+ my $first = $1;
+ if ((my @s = split /^((?:\.\.|__)(?: |\n))/m, $pre_p, 2) > 1){
+ splice(@$paras, $p, 1, "$first$s[0]", "", "$s[1]$s[-1]");
+ }
+ }
+ elsif ($pre_p =~ /^( |\n)/) {
+ # These get dealt with elsewhere
+ }
+ elsif ($pre_p =~ /^$ENUM .*\n(?=\Z|\n| |$ENUM)/o) {
+ # An enumerated list
+ my ($prefix,$index,$suffix) = map(defined $_ ? $_ : '',
+ ($1,$2,$3));
+ my $type = $self->EnumType($index);
+ $type = 'arabic' if $type eq '#';
+ my $val = $self->EnumVal($index, $type);
+ $pre_p =~ s/^(.*\n)//;
+ my $first = $1;
+ my @enum_list;
+ while ($pre_p ne '') {
+ if ((my @s = split /^($ENUM .*\n(?=\Z|\n| |$ENUM))/mo,
+ $pre_p, 2) > 1) {
+ # Check for out-of-sequence enumerated list item
+ my ($pf,$in,$sf) = map(defined $_ ? $_ : '',
+ @s[2..4]);
+ my $v = $self->EnumVal($in, $type);
+ if ($pf ne $prefix || $sf ne $suffix ||
+ ($v ne '#' && $v != $val+1)) {
+ my $enum_list = join('',@enum_list);
+ splice(@$paras, $p, 1, "$enum_list$first$s[0]",
+ "\n" . q($self->system_message(2, $source, $lineno, "Enumerated list ends without a blank line; unexpected unindent.")),
+ "$s[1]$s[-1]$post_p");
+ last;
+ }
+ else {
+ push(@enum_list, "$first$s[0]");
+ $first = $s[1];
+ $pre_p = "$s[-1]";
+ $val++;
+ }
+ }
+ else {
+ push(@enum_list, "$first$pre_p");
+ $first = "";
+ $pre_p = "";
+ }
+ }
+ push (@enum_list, $first) if $first ne '';
+#print "$p: {\n",map("[$_]\n", @enum_list),"}\n";
+ # Check any enumerated lists for unexpected indent
+ my $prev_paras = '';
+ my $enum;
+ while ($enum = shift @enum_list) {
+ my $para = $enum;
+ $para =~ /^($ENUM )/o;
+ my $spaces = " " x length($1);
+ $para =~ s/^(.*\n)//;
+ my $first = $1;
+ if ((my @s = split /^(?!$spaces)(.)/m, $para, 2) > 1) {
+ my $rest = join('',@enum_list);
+ my @items =
+ (
+ # This is a sentinel that an error occurred
+ "\n" . q($self->system_message(2, $source, $lineno, "Enumerated list ends without a blank line; unexpected unindent.")),
+ "$s[1]$s[-1]$rest$post_p");
+ # Enumerated list has unexpected indent
+ splice(@$paras, $p, 1, "$prev_paras$first$s[0]",
+ @items);
+ last;
+ }
+ $prev_paras .= "$first$para";
+ }
+ }
+ elsif ($pre_p =~ /^$FIELD_LIST/) {
+ # A field list
+ if ((my @s = split /^(?! |$FIELD_LIST)(.)/m, $pre_p, 2) > 1) {
+ # Field list has unexpected indent
+ splice(@$paras, $p, 1,($s[0],
+ # This is a sentinel that an error occurred
+ "\n" . q($self->system_message(2, $source, $lineno, "Field list ends without a blank line; unexpected unindent.")),
+ "$s[1]$s[-1]$post_p"));
+ }
+ }
+ elsif ($pre_p =~ /^$OPTION_LIST/) {
+ # An option list
+ if ((my @s = split /^(?! |$OPTION_LIST)(.)/m, $pre_p, 2) > 1){
+ # Field list has unexpected indent
+ splice(@$paras, $p, 1,($s[0],
+ # This is a sentinel that an error occurred
+ "\n" . q($self->system_message(2, $source, $lineno, "Option list ends without a blank line; unexpected unindent.")),
+ "$s[1]$s[-1]$post_p"));
+ }
+ }
+ elsif ($self->IsTable($pre_p)) {
+ # It's a table
+ if ($pre_p =~ /^[+][+-]+[+] *\n/ &&
+ (my @s = split /^([^|+])/m, $pre_p, 2) > 1) {
+ my $after = "$s[1]$s[-1]$post_p";
+ # Table is missing blank line
+ splice(@$paras, $p, 1, ($s[0],
+ # This is a sentinel that an error occurred
+ "\n" . q($self->system_message(2, $source, $lineno, "Blank line required after table.")),
+ $after));
+ if ($after =~ /^ /) {
+ splice(@$paras, $p+1, 0,
+ # This is a sentinel that an error occurred
+ "\n" . q($self->system_message(3, $source, $lineno, "Unexpected indentation.")),
+ "");
+
+ }
+ }
+ }
+ elsif ($pre_p =~ /^\S.*\n /) {
+ # A definition list
+ if (#$pre_p =~ /^\S.*\n\S/m ||
+ (my @s = split /^(\S.*\n)$/m, $pre_p, 2) > 1) {
+ # Definition list has unexpected indent
+ splice(@$paras, $p, 1,($s[0],
+ # This is a sentinel that an error occurred
+ "\n" . q($self->system_message(2, $source, $lineno, "Definition list ends without a blank line; unexpected unindent.")),
+ "$s[1]$post_p"));
+ }
+ }
+ else {
+ # A standard paragraph
+ if ((my @s = split /^( )/m, $pre_p, 2) > 1
+ && $pre_p !~ /:: *$/) {
+ # This "paragraph" has indentation or other problems
+ splice(@$paras, $p, 1,($s[0],
+ # This is a sentinel that an error occurred
+ "\n" . q($self->system_message(3, $source, $lineno, "Unexpected indentation.")),
+ "$s[1]$s[-1]$post_p"));
+ }
+ }
+ # Or may need to join consecutive paragraphs
+ if ($p >= 2 &&
+ # Don't consolidate paragraphs with errors in the middle
+ (defined $paras->[$p-1] && $paras->[$p-1] !~ /^\n\S/s &&
+ (
+ # Consecutive block quotes
+ (substr($paras->[$p-2],0,1) eq ' ' &&
+ substr($paras->[$p],0,1) eq ' ')
+ ||
+ # Comments followed by indented text
+ ($paras->[$p-2] =~ /^((\.\. )|(__( |\n)))/ &&
+ $paras->[$p]=~ /^ /)
+ ||
+ # Consecutive bulleted lists
+ ($paras->[$p-2] =~ /^($BULLETS)(?: |\n)/o &&
+ $paras->[$p] =~ /^(?:[$1]| )/)
+ ||
+ # Consecutive enumerated lists
+ ($paras->[$p-2] =~ /^$ENUM .*\n(?=\Z|\n| |$ENUM)/o &&
+#do {print "$p: $paras->[$p-2]~~~~~~$paras->[$p]========"; 1; } &&
+ do {
+ my ($prefix, $index, $suffix) =
+ map defined $_ ? $_ : '', ($1, $2, $3);
+ my $type = $self->EnumType($index);
+ if (($type ne $enumtype && $type ne '#') ||
+ $prefix ne $enumprefix ||
+ $suffix ne $enumsuffix) {
+ $enumtype = $type;
+ $enumtype = 'arabic' if $enumtype eq '#';
+ $enumprefix = $prefix;
+ $enumsuffix = $suffix;
+ $enumval = $self->EnumVal($index, $type);
+ $enumval = 1 if $enumval eq '#';
+ }
+ ($paras->[$p] =~ /^ / ||
+ $paras->[$p] =~ /^$ENUM .*\n(?=\Z|\n| |$ENUM)/o &&
+#do { print "$prefix-$enumtype-$enumval-$suffix vs $1-$enumtype-$2-$3\n"; 1; } &&
+ do {
+ my $val = $self->EnumVal($2, $enumtype);
+ $val = $enumval + 1 if $val eq '#';
+ my $oldval = $enumval;
+ $enumval = $val;
+ $val == $oldval+1;
+ }
+ && ($1 || '') eq $enumprefix && ($3 || '') eq $enumsuffix)
+ })
+ ||
+ # Incomplete simple table
+ ($paras->[$p-2] =~ /^=+( +=+)+ *\n/ &&
+ $paras->[$p] =~ /^\001/)
+ ||
+ # Consecutive field lists
+ ($paras->[$p-2] =~ /^$FIELD_LIST/o &&
+ $paras->[$p]=~ /^($FIELD_LIST| )/o)
+ ||
+ # Consecutive definition lists
+ ($paras->[$p-2] =~ /^(?!\.\.|__( |\n)|$OPTION_LIST)\S.*\n /o &&
+ $paras->[$p]=~ /^(?!\.\.|__( |\n)|$OPTION_LIST|$FIELD_LIST|$BULLETS( |\n)|$ENUM )(\S.*\n)? /o)
+ ||
+ # Consecutive option lists
+ ($paras->[$p-2] =~ /^$OPTION_LIST/o &&
+ $paras->[$p]=~ /^(($OPTION_LIST)| )/o)
+ ))) {
+#print STDERR "Coalescing: [$paras->[$p-2]]\n[$paras->[$p-1]]\n[$paras->[$p]]\n";
+ splice(@$paras, $p-2, 3, "$paras->[$p-2]$paras->[$p-1]$paras->[$p]");
+ $p--;
+ }
+ }
+}
+
+# Defines a new role, optionally based upon an existing role
+# Arguments: new role name, optional old role name, optional option key/values
+# Returns: possible error message
+sub DefineRole : method {
+ my ($self, $role, $tag, %options) = @_;
+
+ $tag = 'inline' unless defined $tag;
+ return qq(cannot make "$role" into a class name.)
+ unless $role =~ /[a-z][-\w\.]*/i;
+ my $class = defined $options{class} ? $options{class} : $role;
+ return qq(invalid option value: (option: "class"; value: '$class')\ncannot make "$class" into a class name.)
+ unless $class =~ /[a-z][-\w\.]*/i;
+ # Default all options, etc. from the base tag
+ $self->{MY_ROLES}{$role} = DeepCopy($self->{MY_ROLES}{$tag});
+ $self->{MY_ROLES}{$role}{tag} = $self->{MY_ROLES}{$tag}{tag};
+ $self->{MY_ROLES}{$role}{attr}{classes} = [ $class ];
+ # Process format, prefix and suffix options
+ if (defined $options{format}) {
+ $self->{MY_ROLES}{$role}{attr}{format} = $options{format};
+ delete $options{format};
+ }
+ $options{prefix} = $self->HashifyFieldList($options{prefix})
+ if $options{prefix};
+ $options{suffix} = $self->HashifyFieldList($options{suffix})
+ if $options{suffix};
+ # Merge any local options with the options of the underlying class
+ @{$self->{MY_ROLES}{$role}{options}}{keys %options} =
+ values %options if %options;
+ return;
+}
+
+# Processes a definition list paragraph.
+# Arguments: paragraph, source, line number
+# Returns: processed paragraph, list of DOM objects and unprocessed paragraphs
+sub DefinitionList : method {
+ my($self, $para, $source, $lineno) = @_;
+
+ my $dom = $DOM->new('definition_list');
+ my ($processed, @unp);
+
+ (undef, my @paras) = split /^((?:\S.*)\n(?: +))/m, $para;
+ while (@paras > 1 && (my ($item, $def) = splice @paras, 0, 2)) {
+ my $para = "$item$def";
+ $para =~ /^(\S.*)\n( +)/;
+ my ($term, $spaces) = ($1, $2);
+ my $dli = $DOM->new('definition_list_item');
+ $dom->append($dli);
+ my $classifiers = '';
+ my @errs;
+ if ($term =~ /:: *$/) {
+ push (@errs, $self->system_message
+ (1, $source, $lineno+1,
+ qq(Blank line missing before literal block (after the "::")? Interpreted as a definition list item.)));
+ }
+ # We have to handle the case where the ' : ' is
+ # within a literal quote.
+ # Get rid of all literal quotes
+ my %strings;
+ $term =~ s/(\A| )(``((?!``).)*``)/
+ my $v = $2; my $s = \$v; bless $s,"STR"; $strings{$s}=$2; "$1$s"/ge;
+ if ($term !~ /^``((?!``).)*``/ && $term =~ /(.*?) : (.*)/) {
+ $term = $1;
+ $classifiers = $2;
+ }
+ # Put the literal quotes back
+ $term =~ s/(STR=SCALAR\(0x[0-9a-f]+\))/$strings{$1} || $1/ge;
+ my $def = $DOM->new('definition');
+ my $t = $DOM->new('term');
+ push(@errs, $self->Inline($t, $term, $source, $lineno));
+ $dli->append($t);
+ if ($classifiers ne '') {
+ my @classifiers = split / +: +/, $classifiers;
+ foreach (@classifiers) {
+ s/(STR=SCALAR\(0x[0-9a-f]+\))/$strings{$1} || $1/ge;
+ my $classifier = $DOM->new('classifier');
+ push(@errs, $self->Inline($classifier, $_, $source, $lineno));
+ $dli->append($classifier);
+ }
+ }
+ $def->append(@errs);
+ $dli->append($def);
+ $para =~ s/^(.*\n)//;
+ my $first = $1;
+ if ((my @s = split /\n(\S)/, $para, 2) > 1) {
+ # Check for unexpected unindents
+ $para = (shift @s) . "\n";
+ @paras = join '', @s, @paras;
+ }
+ $para =~ s/^$spaces//mg;
+ $self->Paragraphs($def, $para, $source, $lineno+1);
+ $para = "$first$para";
+ $lineno += $para =~ tr/\n//;
+ $processed .= $para;
+ }
+ my $unp = join('',@paras);
+ if ($unp !~ /^$/) {
+ push @unp, $self->system_message
+ (2, $source, $lineno,
+ "Definition list ends without a blank line; unexpected unindent.");
+ push @unp, $unp;
+ }
+ return ($processed, $dom, @unp);
+}
+
+# Parses a directive and attaches it to a DOM if successful.
+# Arguments: DOM object, source, line number, error message id,
+# directive text, paragraph literal
+# Returns: error flag,
+# reference to array of DOM objects (possibly including input DOM),
+# reference to array of unparsed paragraphs.
+sub Directive : method {
+ my ($self, $parent, $source, $lineno, $errmsgid, $dtext, $lit) = @_;
+#print STDERR "Directive(",join(',',@_),")\n";
+
+ my @dom;
+ my @unprocessed;
+ my $error = 1;
+ $dtext =~ /(\s*)([\w.-]+)\s*:: *(.*)/s;
+ my ($pre, $directive, $body) = map defined $_ ? $_ : '',($1, $2, $3);
+ my $dname = $directive;
+ $directive =~ tr/[A-Z].-/[a-z]__/;
+#print STDERR "[$pre][$directive][$body]\n";
+ my $subst = $parent->{tag} eq 'substitution_definition' ?
+ $parent->{attr}{names}[0] : '';
+
+ if ($dtext eq "\n") {
+ push(@dom, $self->system_message
+ (2, $source, $lineno, qq($errmsgid "$subst" missing contents.),
+ $lit));
+ }
+ elsif ($directive eq '') {
+ push(@dom, $self->system_message
+ (2, $source, $lineno, qq($errmsgid "$subst" empty or invalid.),
+ $lit));
+ }
+ else {
+ if (! defined $DIRECTIVES{$directive}) {
+ # First see if there's a routine defined for it
+ my $d = "Text::Restructured::Directive::$directive";
+ $DIRECTIVES{$directive} = \&$d if defined &$d;
+ }
+ if (! defined $DIRECTIVES{$directive}) {
+ push(@dom, $self->system_message
+ (1, $source, $lineno,
+ qq(No directive entry for "$dname" in module "Text::Restructured::Directive".\nTrying "$dname" as canonical directive name.)));
+ eval("use Text::Restructured::Directive::$directive");
+ if ($@ && $@ !~ /in \@INC/) {
+ push(@dom, $self->system_message
+ (4, $source, $lineno,
+ qq(Error compiling "$directive": $@)));
+ return 1, \@dom, [];
+ }
+ return 1, \@dom, [$lit] if defined $DIRECTIVES{$directive};
+ }
+ if ( defined $DIRECTIVES{$directive}) {
+ my $mylit = $parent->{tag} eq 'substitution_definition' ? $dtext :
+ $lit;
+ my @dir = eval {
+ &{$DIRECTIVES{$directive}}
+ ($self, $dname, $parent, $source, $lineno, $dtext, $mylit); };
+ push(@dom, $self->system_message
+ (4, $source, $lineno,
+ qq(Error processing directive "$dname": $@), $lit))
+ if $@;
+ my @doms = grep(ref($_) eq $DOM, @dir);
+ push(@unprocessed,
+ map(split(/^(\s*\n)+/m, $_),grep(ref($_) ne $DOM, @dir)));
+ if (@doms >= 1 && $doms[0]{tag} eq 'system_message' || @dir == 0)
+ {
+ push(@dom, @doms);
+ push(@dom, $self->system_message
+ (2, $source, $lineno,
+ qq($errmsgid "$subst" empty or invalid.), $lit))
+ if $subst ne '';
+ }
+ else {
+ $parent->append(@doms);
+ if ($parent->{tag} eq 'substitution_definition') {
+ my $err = $self->RegisterName($parent, $source, $lineno);
+ push (@dom, $err) if $err;
+ }
+ $error = 0;
+ }
+ }
+ else {
+ push(@dom, $self->system_message
+ (3, $source, $lineno,
+ qq(Unknown directive type "$dname".),
+ $subst eq '' ? $lit : $dtext));
+ push(@dom, $self->system_message
+ (2, $source, $lineno,
+ qq($errmsgid "$subst" empty or invalid.), $lit))
+ if $subst ne '';
+ }
+ }
+#print STDERR "Directive -> [",join(',',@dom),"][",join(',',@unprocessed),"]\n";
+ return ($error, \@dom, \@unprocessed);
+}
+
+# Processes a enumerated list paragraph.
+# Arguments: paragraph, source, line number
+# Returns: processed paragraph, list of DOM objects and unprocessed paragraphs
+sub EnumList : method {
+ my($self, $para, $source, $lineno) = @_;
+
+ my $lines = 0;
+ my ($processed, @unp, @err);
+ $para =~ /^$ENUM .*\n(?=\Z|\n| |$ENUM)/o;
+ my ($prefix, $index, $suffix) = map defined $_ ? $_ : '', ($1, $2, $3);
+ my $type = $self->EnumType($index);
+ $type = 'arabic' if $type eq '#';
+ my $dom = $DOM->new('enumerated_list', enumtype=>$type,
+ prefix=>"$prefix", suffix=>$suffix);
+ my $val = $self->EnumVal($index, $type);
+ $val = 1 if $val eq '#';
+ if ($val != 1) {
+ $dom->{attr}{start} = $val;
+ push(@err,
+ $self->system_message
+ (1, $source, $lineno,
+ qq(Enumerated list start value not ordinal-1: "$index" (ordinal $val))));
+ }
+
+ while ($para =~ /^$ENUM .*\n(?=\Z|\n| |$ENUM)/o) {
+ my $next = '';
+ my $li = $DOM->new('list_item');
+ $dom->append($li);
+ $para =~ s/^($ENUM )\s*//o;
+ my $marker = $1;
+ my $spaces = " " x length($marker);
+ # See if there are any subsequent enumerated lists
+ if ((my @s = split /^((?!\A)$ENUM .*\n(?=\Z|\n| |$ENUM))/om, $para, 2)
+ > 1) {
+ $para = $s[0];
+ $next = "$s[1]$s[-1]";
+ }
+
+ $para =~ s/^$spaces//mg;
+ $self->Paragraphs($li, $para, $source, $lineno+$lines);
+ $lines += $para =~ tr/\n//;
+ $processed .= $para;
+ $para = $next;
+ }
+
+ return ($processed, $dom, @err, @unp);
+}
+
+# Create a closure with a "static" variable in it
+BEGIN {
+my @ENUM_STRINGS = ('arabic', 'loweralpha', 'upperalpha',
+ 'lowerroman', 'upperroman', '#');
+
+# Given the initial index of an enumerated list, returns the enumeration type.
+# Arguments: Initial index
+# Returns: one of "arabic", "loweralpha", "upperalpha", "lowerroman",
+# "upperroman" or "#" (for auto-enumerated)
+sub EnumType : method {
+ my ($self, $index) = @_;
+ my @matches =
+ $index=~/^(?:([0-9]+)|([a-hj-z])|([A-HJ-Z])|([ivxlcdm]+)|([IVXLCDM]+))|(\#)$/;
+ my @defs = grep(defined $matches[$_], 0 .. 5);
+ # Devel::Cover branch 0 1 assert defined $defs[0]
+ my $type = defined $defs[0] ? $ENUM_STRINGS[$defs[0]] : 'error';
+ return $type;
+}
+}
+
+# Create a closure with some "static" variables
+BEGIN {
+my %ALPHA_INDEX;
+@ALPHA_INDEX{'a' .. 'z'} = (1 .. 26);
+my %ROMAN_VALS = (i=>1, v=>5, x=>10, l=>50, c=>100, d=>500, m=>1000);
+
+# Given an index of an enumerated and the enumeration type, returns the
+# index value.
+# Arguments: Index, enumerated type
+# Returns: number or -1 (for badly formatted Roman numerals/arabic)
+sub EnumVal : method {
+ my ($self, $index, $enumtype) = @_;
+ # Handle autonumber
+ return $index if $index eq '#';
+ # First handle arabic
+ return $index =~ /^\d+$/ ? $index : -1 if $enumtype eq 'arabic';
+ # Deal with alpha types
+ $index =~ tr/A-Z/a-z/;
+ return defined $ALPHA_INDEX{$index} ? $ALPHA_INDEX{$index} : -1
+ if $enumtype =~ /alpha/;
+ # Now left with roman numerals
+ return -1 if $index !~ /^m{0,4}(?:dc{0,3}|c[dm]|c{0,3})?(?:lx{0,3}|x[lc]|x{0,3})?(?:vi{0,3}|i[vx]|i{0,3})?$/;
+ my $val = 0;
+ my @chars = split(//, $index);
+ while (@chars) {
+ my $charval = $ROMAN_VALS{shift @chars};
+ if (@chars == 0 || $charval >= $ROMAN_VALS{$chars[0]}) {
+ $val += $charval;
+ }
+ else {
+ $val += $ROMAN_VALS{shift @chars} - $charval;
+ }
+ }
+ return $val;
+}
+}
+
+# Processes an explicit markup paragraph.
+# Arguments: parent, paragraph, source, line number
+# Returns: processed paragraph, new parent,
+# list of DOM objects and unprocessed paragraphs
+sub Explicit : method {
+ my($self, $parent, $para, $source, $lineno) = @_;
+
+ my $new_parent = $parent;
+ my $lines = 0;
+ my ($processed, @unp, @err, @dom);
+
+ # Check for the end of the explicit markup block
+ my $badindent = 0;
+ if ((my @s = split /^(?!\A|\n|\Z| )/m, $para, 2) > 1) {
+ push(@unp, $s[1]);
+ $para = $s[0];
+ $badindent = 1;
+ }
+ $processed = $para;
+
+ $para =~ /^(?:\.\.|(__))(?: (?:\[((?:[\#*])?[\w.-]*)\] *|\|(?! )([^\|]*\S)\| *|(_.*:.*)|([\w\.-]+\s*::.*))?)?(.*)/s;
+ my ($anon, $footnote, $subst, $target, $dir, $next) =
+ ($1, $2, $3, $4, $5, $6);
+ my $btext = $next
+ if defined $footnote || defined $subst || defined $dir;
+ if (substr($para,0,3) eq "..\n") {
+ my $undef;
+ ($anon, $footnote, $target) = ($undef) x 3;
+ }
+ if ($anon) {
+ $target = "$anon:$next";
+ }
+ if (defined $footnote) {
+ # It's a footnote or citation
+ my %attr;
+ my $tag = 'footnote';
+ if ($footnote =~ /^([\#*])(.*)/) {
+ my ($auto, $name) = ($1, $2);
+ $attr{auto} = $auto eq '#' ? 1 : $auto;
+ if ($name ne '') {
+ $attr{names} = [ $self->NormalizeName($name) ];
+ $attr{ids} = [ $self->NormalizeId($name) ];
+ }
+ }
+ elsif ($footnote !~ /^\d+$/) {
+ $tag = 'citation';
+ $attr{names} = [ $self->NormalizeName($footnote) ];
+ $attr{ids} = [ $self->NormalizeId($footnote) ];
+ }
+ else {
+ $attr{names} = [ $footnote ];
+ }
+ $attr{ids} = [ $self->Id() ] unless defined $attr{ids} ;
+ my $dom = $DOM->new($tag, %attr);
+ if ($footnote !~ /^[\#*]/) {
+ my $label = $DOM->new('label');
+ $label->append($DOM->newPCDATA($footnote));
+ $dom->append($label);
+ }
+ my $err = $self->RegisterName($dom, $source, $lineno);
+ $dom->append($err) if $err;
+ # Get rid of indentation spaces
+ $btext =~ /^(?!\A)( +)/m;
+ my $spaces = $1 || '';
+ $btext =~ s/^$spaces//mg;
+ my @redo;
+ $self->Paragraphs($dom, $btext, $source, $lineno);
+ push(@dom, $dom);
+ }
+ elsif (defined $subst) {
+ # It's a substitution definition
+ my $dom = $DOM->new('substitution_definition',
+ names=>[$self->NormalizeName($subst, 'keepcase')]);
+ my ($err, $doms, $unp) =
+ $self->Directive($dom, $source, $lineno, 'Substitution definition',
+ $btext, $para);
+ push(@dom, @$doms);
+ push(@dom, $dom) unless $err;
+ $processed = '' if @$unp && $unp->[0] eq $para;
+ unshift(@unp, @$unp);
+ }
+ elsif (defined $target) {
+ # It's a hyperlink target
+ my %attr;
+ my $dom;
+ my %char_class = ('`'=>'.', ''=>"[^:]");
+ $target =~ /^(_((?:\\:|[^:])+): *)(.*)/s
+ unless $target =~ /^(_\`((?:.|\n)+)\`: *)(.*)/s;
+ my ($id, $uri) = ($2 || '', $3);
+ if ($id eq '_') {
+ $attr{anonymous} = 1;
+ $id = $self->Id();
+ }
+ my $t = $1;
+ my $indent = $anon ? 3 :
+ $uri =~ /^./ ? length($t) + 3 :
+ do { $uri =~ /\n( +)/; length($1 || '') };
+ my $spaces = ' ' x $indent;
+ if ($uri =~ /^(?:\`((?:.|\n)*)\`|([\w.-]+))_$/) {
+ my $name = defined $1 ? $1 : $2;
+ # Get rid of newline-indents
+ $name =~ s/\n$spaces/ /g;
+ $attr{refname} = $self->NormalizeName($name);
+ }
+ else {
+ # Get rid of newline-indents
+ $uri =~ s/\n$spaces//g;
+ $uri =~ s/\n //g;
+ chomp $uri;
+ $uri =~ s/ *//g;
+ $uri =~ s/\\(.)/$1/g;
+ if ($uri ne '') {
+ $uri = "mailto:$uri"
+ if $uri !~ /^$Text::Restructured::URIre::scheme:/o &&
+ $uri =~ /\@/ && $uri !~ /^\`.*\`$/;
+ $attr{refuri} = $uri;
+ }
+ }
+ $attr{names} = [ $self->NormalizeName($id) ]
+ unless $attr{anonymous};
+ $dom = $DOM->new('target', ids=>[ $self->NormalizeId($id) ], %attr);
+ my $err = $self->RegisterName($dom, $source, $lineno);
+ push (@dom, $err) if $err;
+ push (@dom, $dom);
+ }
+ elsif (defined $dir) {
+ # It's a directive
+ my ($err, $doms, $unp) =
+ $self->Directive($parent, $source, $lineno, 'Directive',
+ "$dir$btext", $para);
+ push(@dom, @$doms);
+ unshift(@unp, @$unp);
+ $processed = '' if @$unp && $unp->[0] eq $para;
+ $new_parent = $self->{SEC_DOM}[-1]
+ if $parent->{tag} =~ /^(document|section)$/;
+ }
+ else {
+ # It's a comment
+ $para =~ s/^(\.\.\s*)//;
+ my $first = $1;
+ if ($para =~ /^( +)/m) {
+ my $spaces = $1;
+ $para =~ s/^$spaces//mg;
+ }
+ my $dom = $DOM->new('comment', %XML_SPACE);
+ $dom->append($DOM->newPCDATA($para))
+ if $para ne '';
+ $para = "$first$para";
+ push(@dom, $dom);
+ }
+
+ if ($badindent) {
+ push(@dom,
+ $self->system_message
+ (2, $source, $lineno + ($para =~ tr/\n//),
+ "Explicit markup ends without a blank line; unexpected unindent."))
+ unless substr($unp[-1], 0, 2) eq "..";
+ }
+ # Annote the dom object with source, lineno, and lit
+ foreach (@dom) {
+ if ($_->{tag} ne 'system_message') {
+ $_->{source} = $source;
+ $_->{lineno} = $lineno;
+ $_->{lit} = $processed;
+ chomp $_->{lit};
+ }
+ }
+ return ($processed, $new_parent, @err, @dom, @unp);
+}
+
+# Processes a field list paragraph.
+# Arguments: paragraph, source, line number
+# Returns: processed paragraph, list of DOM objects and unprocessed paragraphs
+sub FieldList : method {
+ my($self, $para, $source, $lineno) = @_;
+
+ my $dom = $DOM->new('field_list');
+ my $lines = 0;
+ my ($processed, @unp);
+ (undef, my @paras) = split /^($FIELD_LIST)/om, $para;
+ while (my ($fl, $b) = splice @paras, 0, 2) {
+ my ($name, $para) = "$fl$b" =~ /^:([^:\n]+): *(.*)/s;
+ my $field = $DOM->new('field');
+ $field->{source} = $source;
+ $field->{lineno} = $lineno+$lines;
+ $dom->append($field);
+ my $n = $DOM->new('field_name');
+ my $body = $DOM->new('field_body');
+ $field->append($n, $body);
+ $body->append($self->Inline($n, $name, $source, $lineno+$lines));
+ $para = $self->RemoveMinIndent($para, '(?!\A)');
+ $self->Paragraphs($body, $para, $source, $lineno+$lines);
+ $lines += $para =~ tr/\n//;
+ $processed .= $para;
+ }
+
+ return ($processed, $dom, @unp);
+}
+
+# Takes a field list and turns it into a hash
+# Arguments: text of field list
+# Returns: hash reference
+sub HashifyFieldList : method {
+ my ($self, $text) = @_;
+
+ my %hash;
+ my @fields = split /^(?=:)/m, $text;
+ foreach my $field (@fields) {
+ next unless $field =~ /^:([^:\n]*): *(.*)/s;
+ my ($fname,$val) = ($1, $2);
+ chomp $val;
+ $hash{$fname} = $val;
+ }
+
+ return \%hash;
+}
+
+# Returns the next identifier.
+# Arguments: None
+sub Id : method {
+ my ($self) = @_;
+ return "id" . ++$self->{next_id};
+}
+
+# Parses inline markup.
+# Arguments: DOM object of parent, text to parse, source, line number
+# Returns: list of system_message DOMs if errors
+sub Inline : method {
+ my ($self, $parent, $text, $source, $lineno) = @_;
+#print STDERR "Inline($parent,$text)\n";
+
+ my @problems;
+
+ my ($is_start, $pre, $start, $next, $pending, $processed);
+
+ ($is_start, $pre, $start, $next) = $self->InlineStart($text);
+ while ($is_start) {
+ $pending .= $pre;
+ $text = $next;
+
+ # Is there an end for this start?
+ my ($is_end, $mid, $end, $next1) = $self->InlineEnd($text, $start);
+ if (! $is_end) {
+ # We don't have an end
+ if ($start =~ /^(\[|)$/) {
+ last if $start eq '' && $mid eq '';
+ $pending .= "$start$mid";
+ $text = $next1;
+ }
+ else {
+ $lineno += $pending =~ tr/\n//;
+ $pending =
+ RemoveBackslashes($pending);
+ $parent->append($DOM->newPCDATA($pending))
+ if $pending ne '';
+ $pending = "";
+ # We have something problematic here
+ my ($dom,$refid,$id) = $self->problematic($start);
+ $parent->append($dom);
+ my $err = $self->system_message
+ (2, $source, $lineno,
+ "Inline $MARK_TAG_START{$start} start-string without end-string.",
+ "", backrefs=>[ $id ], ids=>[ $refid ]);
+ push (@problems, $err);
+ }
+ }
+ else {
+ my $lit = "$start$mid$end";
+ my %attr;
+ if ($MARK_TAG_START{$start} =~ /interpreted/ &&
+ $pending =~ s/:([-\w\.]+):$//) {
+ $attr{role} = $1;
+ $attr{position} = 'prefix';
+ }
+
+ $lineno += $pending =~ tr/\n//;
+ $pending = RemoveBackslashes($pending);
+ $parent->append($DOM->newPCDATA($pending))
+ if $pending ne '';
+ $pending = '';
+ $text = $next1;
+ my @content;
+ my @errs;
+ my $tag = $MARK_TAG{"$start$end"};
+ my $implicit;
+ if (! defined $tag && $start eq '') {
+ # This must be an implicit markup
+ $mid = "$mid$end";
+ $end = "_";
+ $tag = 'reference';
+ $implicit = 1;
+ }
+ if ($tag eq 'interpreted' && $text =~ s/^:([-\w\.]+)://) {
+ my $role = $1;
+ if (defined $attr{role}) {
+ # We have something problematic here
+ my ($dom,$refid,$id) =
+ $self->problematic(":$attr{role}:`$mid`:$role:");
+ $parent->append($dom);
+ my $err = $self->system_message
+ (2, $source, $lineno,
+ "Multiple roles in interpreted text (both prefix and suffix present; only one allowed).",
+ "", backrefs=>[ $id ], ids=>[ $refid ]);
+ push (@problems, $err);
+ last;
+ }
+ elsif ($text =~ s/^(__?)//) {
+ # We have something problematic here
+ my ($dom,$refid,$id) = $self->problematic("`$mid`:$role:$1");
+ $parent->append($dom);
+ my $err = $self->system_message
+ (2, $source, $lineno,
+ "Mismatch: both interpreted text role suffix and reference suffix.",
+ "", backrefs=>[ $id ], ids=>[ $refid ]);
+ push (@problems, $err);
+ last;
+ }
+ else {
+ $attr{role} = $role;
+ $attr{position} = 'suffix';
+ }
+ }
+ elsif ($tag =~ /reference/) {
+ if (defined $attr{role}) {
+ # We have something problematic here
+ my ($dom,$refid,$id) =
+ $self->problematic(":$attr{role}:`$mid$end");
+ $parent->append($dom);
+ my $err = $self->system_message
+ (2, $source, $lineno,
+ "Mismatch: both interpreted text role prefix and reference suffix.",
+ "", backrefs=>[ $id ], ids=>[ $refid ]);
+ push (@problems, $err);
+ last;
+ }
+
+ my $name = $mid;
+ $name =~ s/\n/ /g;
+ my $uri;
+
+ if ($tag eq 'substitution_reference' && $end =~ /_$/) {
+ # Need to create a new level of reference
+ my $dom = $DOM->new
+ ($tag, refname=>
+ $self->NormalizeName($name, 'keepcase'));
+ $dom->append($DOM->newPCDATA($mid));
+ $dom->{source} = $source;
+ $dom->{lineno} = $lineno;
+ $dom->{lit} = $lit;
+ push (@content, $dom);
+ $tag = 'reference';
+ $mid = "";
+ }
+ $mid =~ /((?:\s|\A)<([^ <][^<]*[^ ])>)$/;
+ my $embeduri = $2;
+ if ((defined $embeduri || $implicit) &&
+ do {$uri = $implicit ? $mid : $embeduri;
+ $uri =~ s/\s//g;
+ $uri =~ /^($Text::Restructured::URIre::URI_reference(\#\S+)?|(\#\S+)|$EMAIL)$/o}) {
+ ...
[truncated message content] |
