Commits

Anonymous committed d169528

Now checking for leading whitespace and erroring.

Comments (0)

Files changed (5)

perl/modules/XML-Grammar-Fiction/MANIFEST

 t/data/docbook/with-internal-description.docbook.xml
 t/data/proto-text/dialogue-with-several-paragraphs.txt
 t/data/proto-text-invalid/inner-desc-inside-char-addressing.txt
+t/data/proto-text-invalid/leading-space.txt
 t/data/proto-text-invalid/no-right-angle.txt
 t/data/proto-text-invalid/not-start-with-tag.txt
 t/data/proto-text-invalid/wrong-close-tag.txt

perl/modules/XML-Grammar-Fiction/lib/XML/Grammar/Fiction/Err.pm

             isa => "XML::Grammar::Fiction::Err::Base",
             fields => [qw(line)],
         },
+        "XML::Grammar::Fiction::Err::Parse::LeadingSpace" =>
+        {
+            isa => "XML::Grammar::Fiction::Err::Parse::LineError",
+        },        
         "XML::Grammar::Fiction::Err::Parse::CannotMatchOpeningTag" =>
         {
             isa => "XML::Grammar::Fiction::Err::Parse::LineError",

perl/modules/XML-Grammar-Fiction/lib/XML/Grammar/Fiction/FromProto/Parser/QnD.pm

     return $self->_curr_line_ref();
 }
 
+sub _check_if_line_starts_with_whitespace
+{
+    my $self = shift;
+
+    if (${$self->_curr_line_ref()} =~ m{\A[ \t]})
+    {
+        XML::Grammar::Fiction::Err::Parse::LeadingSpace->throw(
+            error => "Leading space detected in the text.",
+            'line' => $self->_get_line_num(),
+        );
+    }
+}
+
 sub _init
 {
     my $self = shift;
 {
     my $self = shift;
 
-    $self->_consume(qr{\s});
+    $self->_consume(qr{[ \t]});
 }
 
 my $id_regex = '[a-zA-Z_\-]+';
 
     my $l = $self->_curr_line_ref();
 
-    if (pos($$l) < length($$l))
+    my $text = $self->_consume_up_to(qr{(?:\<|^\n?$)}ms);
+
+    $l = $self->_curr_line_ref();
+
+    my $ret_elem = $self->_new_text([$text]);
+    my $is_para_end = 0;
+
+    # Demote the cursor to before the < of the tag.
+    #
+    if (pos($$l) > 0)
     {
-        my $text = $self->_consume_up_to(qr{(?:\<|^\n?$)}ms);
-
-        $l = $self->_curr_line_ref();
-
-        my $ret_elem = $self->_new_text([$text]);
-        my $is_para_end = 0;
-
-        # Demote the cursor to before the < of the tag.
-        #
-        if (pos($$l) > 0)
-        {
-            pos($$l)--;
-            if (substr($$l, pos($$l), 1) eq "\n")
-            {
-                $is_para_end = 1;
-            }
-        }
-        else
+        pos($$l)--;
+        if (substr($$l, pos($$l), 1) eq "\n")
         {
             $is_para_end = 1;
         }
-
-        return
-        {
-            elem => $ret_elem,
-            para_end => $is_para_end,
-        };
     }
     else
     {
-        Carp::confess ("Line " . $self->_get_line_num() . 
-            " has leading whitespace."
-            );
+        $is_para_end = 1;
     }
+
+    return
+    {
+        elem => $ret_elem,
+        para_end => $is_para_end,
+    };
 }
 
 sub _parse_text_unit
     continue
     {
         $l = $self->_next_line_ref();
+        $self->_check_if_line_starts_with_whitespace();
     }
 
     if (defined($$l) && ($$l =~ m[\G(${match_regex}*)]cg))
     continue
     {
         $l = $self->_next_line_ref();
+        $self->_check_if_line_starts_with_whitespace();
     }
 
     return $return_value;

perl/modules/XML-Grammar-Fiction/t/data/proto-text-invalid/leading-space.txt

+<body id="index">
+
+<title>David vs. Goliath - Part I</title>
+
+<s id="top">
+
+<title>The Top Section</title>
+
+David and Goliath were standing by each other.    
+
+David said unto Goliath: "I will shoot you. I <b>swear</b> I will". You shall
+    feel my wrath!
+
+<s id="goliath">
+
+<title>Goliath's Response</title>
+
+Goliath was not amused.
+
+</s>
+
+</s>
+
+</body>
+

perl/modules/XML-Grammar-Fiction/t/proto-text-invalid.t

 use strict;
 use warnings;
 
-use Test::More tests => 20;
+use Test::More tests => 23;
 
 use XML::LibXML;
 
     );
 }
 
+{
+    my $grammar = XML::Grammar::Fiction::FromProto->new({});
+
+    my $got_xml;
+
+    eval {
+        $got_xml = $grammar->convert(
+        {
+            source =>
+            {
+                file => "t/data/proto-text-invalid/leading-space.txt",
+            },
+        }
+    );
+    };
+
+    my $err_proto = $@;
+
+    my $err = Exception::Class->caught(
+        "XML::Grammar::Fiction::Err::Parse::LeadingSpace"
+    );
+
+    # TEST
+    ok ($err, "LeadingSpace was matched.");
+
+    # TEST
+    like(
+        $err->error(),
+        qr{\ALeading space},
+        "Cannot match closing tag."
+    );
+
+    # TEST
+    is (
+        $err->line(),
+        12,
+        "Line is 1 as expected."
+    );
+}
+
 1;