Commits

shl...@52c325ad-5fd0-0310-8a0f-c43feede02cc  committed 5fa2350

[XML-G-Fiction] Got the proto-text sections-and-paras example to render.

  • Participants
  • Parent commits 9954f87

Comments (0)

Files changed (7)

File perl/modules/XML-Grammar-Fiction/MANIFEST

 t/data/proto-text-invalid/inner-desc-inside-char-addressing.txt
 t/data/proto-text/nested-s.txt
 t/data/proto-text/scenes-with-titles.txt
+t/data/proto-text/sections-and-paras.txt
 t/data/proto-text/two-nested-s.txt
 t/data/proto-text/with-brs.txt
 t/data/proto-text/with-comments.txt

File perl/modules/XML-Grammar-Fiction/lib/XML/Grammar/Fiction/FromProto.pm

 
 use Moose;
 
+use List::Util (qw(first));
+
 has "_parser" => ('isa' => "XML::Grammar::Fiction::FromProto::Parser", 'is' => "rw");
 has "_writer" => ('isa' => "XML::Writer", 'is' => "rw");
 
-my $screenplay_ns = q{http://web-cpan.berlios.de/modules/XML-Grammar-Screenplay/screenplay-xml-0.2/};
+my $fiction_ns = q{http://web-cpan.berlios.de/modules/XML-Grammar-Fortune/fiction-xml-0.2/};
+my $xml_ns = "http://www.w3.org/XML/1998/namespace";
 
 =head1 NAME
 
     my ($self, $args) = @_;
 
     my @start = @{$args->{start}};
-    $self->_writer->startTag([$screenplay_ns,$start[0]], @start[1..$#start]);
+    $self->_writer->startTag([$fiction_ns,$start[0]], @start[1..$#start]);
 
     $args->{in}->($self, $args);
 
     {
         $self->_output_tag_with_childs(
             {
-               start => ["para"],
+               start => ["p"],
                 elem => $elem,
             },
         );
     }
+    elsif ($elem->isa("XML::Grammar::Fiction::FromProto::Node::List"))
+    {
+        foreach my $child (@{$elem->contents()})
+        {
+            $self->_write_elem({elem => $child, });
+        }
+    }
     elsif ($elem->isa("XML::Grammar::Fiction::FromProto::Node::Element"))
     {
-        if (($elem->name() eq "s") || ($elem->name() eq "section"))
+        if ($elem->name() eq "title")
+        {
+            my $list = $elem->_get_childs()->[0];
+            my $p = $list->contents()->[0];
+            $self->_output_tag(
+                {
+                    start => ["title"],
+                    in => sub {
+                        $self->_write_elem(
+                            {
+                                elem => $p->_get_childs()->[0],
+                            }                            
+                        ),
+                    },
+                },
+            );
+        }
+        elsif ($elem->name() eq "s")
         {
             $self->_write_scene({scene => $elem});
         }
             Carp::confess("Unspecified id for scene!");
         }
 
-        my $title = $scene->lookup_attr("title");
-        my @t = (defined($title) ? (title => $title) : ());
-
         $self->_output_tag_with_childs(
             {
-                'start' => ["scene", id => $id, @t],
+                'start' => ["section", [$xml_ns, "id"] => $id],
                 elem => $scene,
             }
         );
     return $self->_parser->process_text($self->_read_file($filename));
 }
 
+sub _write_body
+{
+    my $self = shift;
+    my $args = shift;
+
+    my $body = $args->{'body'};
+
+    my $tag = $body->name;
+    if ($tag ne "body")
+    {
+        confess "Improper body tag - should be '<body>'!";
+    }
+
+    my $id = $body->lookup_attr("id");
+
+=begin foo
+    my $title =
+        first
+        { $_->name() eq "title" }
+        @{$body->_get_childs()}
+        ;
+
+    my @t = 
+    (
+          defined($title)
+        ? (title => $title->_get_childs()->[0])
+        : ()
+    );
+=end foo
+
+=cut
+
+    $self->_output_tag_with_childs(
+        {
+            'start' => ["body", [$xml_ns, "id"] => $id],
+            elem => $body,
+        }
+    );
+
+    return;
+}
+
 sub convert
 {
     my ($self, $args) = @_;
         NAMESPACES => 1,
         PREFIX_MAP =>
         {
-             $screenplay_ns => "",
+             $fiction_ns => "",
+             $xml_ns => "xml",
         }
     );
 
     $writer->xmlDecl("utf-8");
     $writer->doctype("document", undef, "screenplay-xml.dtd");
-    $writer->startTag([$screenplay_ns, "document"]);
-    $writer->startTag([$screenplay_ns, "head"]);
+    $writer->startTag([$fiction_ns, "document"]);
+    $writer->startTag([$fiction_ns, "head"]);
     $writer->endTag();
-    $writer->startTag([$screenplay_ns, "body"], "id" => "index",);
 
     # Now we're inside the body.
     $self->_writer($writer);
 
-    $self->_write_scene({scene => $tree});
-
-    # Ending the body
-    $writer->endTag();
+    $self->_write_body({body => $tree});
 
     $writer->endTag();
     

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

             # line
             my $l = shift;
 
-            if ($$l !~ m{\G<($id_regex)}g)
+            my $p = pos($$l);
+            if ($$l !~ m{\G<($id_regex)}cg)
             {
+                print "Before : " . substr($$l, 0, $p) . "\n";
                 Carp::confess("Cannot match opening tag at line " . $self->_get_line_num());
             }
             my $id = $1;
             return
             {
                 name => $1,
+                line => $self->_get_line_num(),
             };
         }
     );
 {
     my $self = shift;
 
-    my $start_line = $self->_get_line_num();
+    my $start_line = $self->_curr_line_idx();
 
     # Skip the [
     $self->_with_curr_line(
             if ($$l !~ m{\G\]}g)
             {
                 Carp::confess (
-                      "Inner description that started on line $start_line did "
-                    . "not terminate with a \"]\"!"
+                      "Inner description that started on line "
+                      . ($start_line+1) 
+                      . " did not terminate with a \"]\"!"
                 );
             }
         }
     {
         if (!defined(${$self->_next_line_ref()}))
         {
-            Carp::confess "End of file in an addressing paragraph starting at $start_line";
+            Carp::confess 
+            (
+                "End of file in an addressing paragraph starting at "
+                . ($start_line+1)
+            );
         }
     }
 
 
     if ($is_end)
     {
-        Carp::confess (qq{Description ("[ ... ]") that started on line $start_line does not terminate anywhere.});
+        Carp::confess (
+            qq{Description ("[ ... ]") that started on line }
+            . ($start_line+1) . 
+            qq{does not terminate anywhere.}
+        );
     }
 
     return $self->_new_node({
 {
     my $self = shift;
 
-    if (pos(${$self->_curr_line_ref()}) == 0)
+    my $l = $self->_curr_line_ref();
+
+    if (pos($$l) < length($$l))
     {
-        return $self->_with_curr_line(
-            sub {
-                my $l = shift;
-                if (substr($$l, 0, 1) eq "[")
-                {
-                    return $self->_parse_desc_unit();
-                }
-                elsif ($$l =~ m{\A[^:]+:})
-                {
-                    return $self->_parse_speech_unit();
-                }
-                else
-                {
-                    Carp::confess ("Line " . $self->_curr_line_idx() . 
-                        " is not a description or a saying."
-                    );
-                }
-            }
+        my $text = $self->_consume_up_to(qr{\<}ms);
+
+        $l = $self->_curr_line_ref();
+        if (pos($$l) > 0)
+        {
+            pos($$l)--;
+        }
+
+        my @paras = split(/\n{2,}/, $text);
+        return $self->_new_list(
+            [ map { $self->_new_para([$_]) } @paras]
         );
     }
     else
     {
-        Carp::confess ("Line " . $self->_curr_line_idx() . 
+        Carp::confess ("Line " . $self->_get_line_num() . 
             " has leading whitespace."
             );
     }
     my $self = shift;
     my $space = $self->_consume(qr{\s});
 
-    if ($self->_curr_line() =~ m{\G<})
+    my $l = $self->_curr_line_ref();
+    my $orig_pos = pos($$l);
+
+    if ($$l =~ m{\G<}cg)
     {
         # If it's a tag.
 
         # TODO : implement the comment handling.
         # We have a tag.
 
+        my $is_closing_tag = ($$l =~ m{\G/}cg);
+        pos($$l) = $orig_pos;
+
         # If it's a closing tag - then backtrack.
-        if ($self->_curr_line() =~ m{\G</})
+        if ($is_closing_tag)
         {
             return undef;
         }
     }
     continue
     {
-        $self->_next_line_ref();
-        $l = $self->_curr_line_ref();
+        $l = $self->_next_line_ref();
     }
 
     if (defined($$l) && ($$l =~ m[\G(${match_regex}*)]cg))
     }
     continue
     {
-        $self->_next_line_ref();
-        $l = $self->_curr_line_ref();
+        $l = $self->_next_line_ref();
     }
 
     return $return_value;
 
     $self->_curr_line_idx(0);
 
-    $self->_curr_line() =~ m{\A}g;
+    ${$self->_curr_line_ref()} =~ m{\A}g;
 
     return;
 }

File perl/modules/XML-Grammar-Fiction/t/data/proto-text-invalid/inner-desc-inside-char-addressing.txt

-<s id="top">
+<start id="top">
 
-<s id="david_and_goliath">
-
-[David and <a href="http://en.wikipedia.org/wiki/Goliath">Goliath</a> are 
-standing by each other.]
-
-David: I will kill you.<br />
-I will kill you.<br />
-You will not survive.<br />
-I will kill you.<br />
-I will kill you.<br />
-Ask Jive.
-
-Goliath: no way, you little idiot!
-
-David: yes way!
-
-Goliath [dead]: vengence will be mine.
-
-</s>
-
-</s>
+</wrong-finish-tag>

File perl/modules/XML-Grammar-Fiction/t/data/proto-text/sections-and-paras.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."
+
+<s id="goliath">
+
+<title>Goliath's Response</title>
+
+Goliath was not amused.
+
+He said to David: "Oh, really".
+
+</s>
+
+</s>
+
+</body>
+

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

 my $err = $@;
 
 # TEST
-like ($err, qr{inner-desc.*?addressing},
+like ($err, qr{Tags do not match: start on line 1 and wrong-finish-tag},
    "Tried to put an inner-desc inside an addressing "
 );
 

File perl/modules/XML-Grammar-Fiction/t/proto-text-to-xml-using-custom-parser.t

 use strict;
 use warnings;
 
-use Test::More skip_all => "Not implemented yet for XML-Grammar-Fortune";
+use Test::More tests => 2;
 
-# use Test::XML tests => 26;
+use Test::XML;
 
 use XML::LibXML;
 
         with-brs
     ));
 
-# TEST:$num_texts=13
+@tests = (qw(sections-and-paras));
+
+# TEST:$num_texts=1
 
 my $grammar = XML::Grammar::Fiction::FromProto->new({
         parser_class => "XML::Grammar::Fiction::FromProto::Parser::QnD",
 
 my $rngschema = XML::LibXML::RelaxNG->new(
         location => "./extradata/fiction-xml.rng" 
-    );    
+    );
 
 my $xml_parser = XML::LibXML->new();
 $xml_parser->validation(0);