Commits

Anonymous committed a2b836c

Renamed from XML-Grammar-Screenplay to XML-Grammar-Fiction everywhere.

Functionality is still the same.

Comments (0)

Files changed (36)

perl/modules/XML-Grammar-Fiction/Build.PL

 use XML::Grammar::Builder;
 
 my $builder = XML::Grammar::Builder->new(
-    module_name         => 'XML::Grammar::Screenplay',
+    module_name         => 'XML::Grammar::Fiction',
     license             => 'mit',
     dist_author         => 'Shlomi Fish <shlomif@cpan.org>',
-    dist_version_from   => 'lib/XML/Grammar/Screenplay.pm',
+    dist_version_from   => 'lib/XML/Grammar/Fiction.pm',
     build_requires => {
         'File::Find' => 0,
         'Test::More' => 0,
         'XML::LibXSLT' => 0,
         'XML::Writer' => 0,
     },
-    add_to_cleanup      => [ 'XML-Grammar-Screenplay-*' ],
+    add_to_cleanup      => [ 'XML-Grammar-Fiction-*' ],
     create_makefile_pl => 'passthrough',
     meta_merge =>
     {
         resources =>
         {
-            repository => "https://svn.berlios.de/svnroot/repos/web-cpan/XML-Grammar-Screenplay/",
-            homepage => "http://web-cpan.berlios.de/modules/XML-Grammar-Screenplay/",
+            repository => "https://svn.berlios.de/svnroot/repos/web-cpan/XML-Grammar-Fiction/",
+            homepage => "http://web-cpan.berlios.de/modules/XML-Grammar-Fiction/",
         },
         keywords =>
         [
             "grammar",
             "movies",
             "parsing",
-            "screenplay",
-            "screenplays",
-            "script",
-            "scripts",
+            "fiction",
+            "story",
+            "stories",
+            "noveilla",
+            "noveillas",
+            "novels",
+            "novel",
             "writing",
             "xml",
             "xml-libxml",

perl/modules/XML-Grammar-Fiction/MANIFEST

 extradata/screenplay-xml-to-xsl-fo.xslt
 inc/Test/Run/Builder.pm
 inc/XML/Grammar/Builder.pm
-lib/XML/Grammar/Screenplay/App/FromProto.pm
-lib/XML/Grammar/Screenplay/App/ToDocBook.pm
-lib/XML/Grammar/Screenplay/App/ToHTML.pm
-lib/XML/Grammar/Screenplay/Base.pm
-lib/XML/Grammar/Screenplay/FromProto/Nodes.pm
-lib/XML/Grammar/Screenplay/FromProto/Parser.pm
-lib/XML/Grammar/Screenplay/FromProto/Parser/PRD.pm
-lib/XML/Grammar/Screenplay/FromProto/Parser/QnD.pm
-lib/XML/Grammar/Screenplay/FromProto.pm
-lib/XML/Grammar/Screenplay.pm
-lib/XML/Grammar/Screenplay/ToDocBook.pm
-lib/XML/Grammar/Screenplay/ToHTML.pm
+lib/XML/Grammar/Fiction/App/FromProto.pm
+lib/XML/Grammar/Fiction/App/ToDocBook.pm
+lib/XML/Grammar/Fiction/App/ToHTML.pm
+lib/XML/Grammar/Fiction/Base.pm
+lib/XML/Grammar/Fiction/FromProto/Nodes.pm
+lib/XML/Grammar/Fiction/FromProto/Parser.pm
+lib/XML/Grammar/Fiction/FromProto/Parser/PRD.pm
+lib/XML/Grammar/Fiction/FromProto/Parser/QnD.pm
+lib/XML/Grammar/Fiction/FromProto.pm
+lib/XML/Grammar/Fiction.pm
+lib/XML/Grammar/Fiction/ToDocBook.pm
+lib/XML/Grammar/Fiction/ToHTML.pm
 Makefile.PL
 MANIFEST
 META.yml # Will be created by "make dist"
 t/data/xml/with-multi-line-comments.xml
 t/data/xml/with-multi-para-desc.xml
 t/data/xml/with-tags-inside-paragraphs.xml
-t/lib/run-test-1/XML/Grammar/Screenplay/ConfigData.pm
+t/lib/run-test-1/XML/Grammar/Fiction/ConfigData.pm
 t/pod-coverage.t
 t/pod.t
 t/proto-text-invalid.t

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

+package XML::Grammar::Fiction;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+XML::Grammar::Fiction - CPAN distribution implementing an XML grammar 
+and a lightweight markup language for stories, novels and other fiction.
+
+=head1 VERSION
+
+Version 0.0.1
+
+=cut
+
+our $VERSION = '0.0.1';
+
+=head1 SYNOPSIS
+
+See L<XML::Grammar::Fiction::FromProto>, 
+L<XML::Grammar::Fiction::ToDocBook> and
+L<XML::Grammar::Fiction::ToHTML>.
+
+=head1 DESCRIPTION
+
+XML::Grammar::Fiction is a Perl module for:
+
+=over 4
+
+=item 1. Converting a well-formed plain text format to a specialized XML format.
+
+=item 2. Converting the XML to DocBook/XML or directly to HTML for rendering.
+
+=back
+
+The best way to use it non-programatically is using
+L<XML::Grammar::Fiction::App::FromProto>,
+L<XML::Grammar::Fiction::App::ToDocBook> and
+L<XML::Grammar::Fiction::App::ToHTML>, which are modules implementing
+command line applications for their processing.
+
+The rest of this page will document the syntax of the custom textual format.
+
+=head1 FORMAT
+
+=head2 Scenes
+
+Scenes are placed in XML-like tags of C<< <section> ... </section> >> or
+abbreviated as C<< <s> ... </s> >>. Opening tags in the format may have 
+attributes whose keys are plaintext and whose values are surrounded by
+double quotes. (Single-quotes are not supported).
+
+The scene tag must have an C<id> attribute (for anchors, etc.) and could
+have an optional C<title> attribute. If the title is not specified, it will
+default to the ID.
+
+Scenes may be B<nested>. There cannot be any sayings or descriptions (see below)
+except inside scenes.
+
+=head2 Text
+
+Text is any of:
+
+=over 4
+
+=item 1. Plaintext
+
+Regular text
+
+=item 2. XML-like tags.
+
+Supported tags are C<< <b> >> for bold tags, C<< <a href="..."> >> for
+hyperlinks, and an empty C<< <br /> >> tag for line-breaks.
+
+=item 3. Entities
+
+The text format supports SGML-like entities such as C<< &amp; >>,
+C<< &lt; >>, C<< &quot; >> and all other entities that are supported by 
+L<HTML::Entities>.
+
+=item 4. Text between [ ... ]
+
+Text between square brackets (C<[ ... ]>) is reserved for descriptions
+or inline descriptions (see below).
+
+=back 
+
+=head2 Sayings
+
+The first paragraph when a character talks starts with the name of the
+character followed by a colon (C<:>) and the rest of the text. Like this:
+
+    David: Goliath, I'm going to kill you! You'll see -
+    I will.
+
+If a character says more than one paragraph, the next paragraph should start
+with any number of "+"-signs followed by a colon:
+
+    David: Goliath, I'm going to kill you! You'll see -
+    I will.
+
+    ++++: I will sling you and bing you till infinity!
+
+=head2 Descriptions.
+
+Descriptions that are not part of saying start with a C<[> at the first
+character of a line and extend till the next C<]>. They can span several
+paragraphs.
+
+There are also internal descriptions to the saying which are placed
+inside the paragraph of the saying and describe what happens while the
+character talks. 
+
+=head2 EXAMPLES
+
+Examples can be found in the C<t/data> directory, and here:
+
+=over 4
+
+=item * The One with the Fountainhead
+
+L<http://www.shlomifish.org/humour/TOWTF/>
+
+=item * Humanity - The Movie
+
+L<http://www.shlomifish.org/humour/humanity/>
+
+=item * Star Trek - "We The Living Dead"
+
+L<http://www.shlomifish.org/humour/Star-Trek/We-the-Living-Dead/>
+
+=back
+
+=head1 DEBUGGING
+
+When trying to convert the well-formed text to XML, one will often 
+encounter an obscure "Parse Error". This is caused by L<Parse::RecDescent>,
+which is used for parsing. The best way I found to deal with it is to
+gradually eliminate parts of the document until the offending markup is
+isolated.
+
+In the future, I plan on writing a custom parser that will provide better
+diagnostics and will hopefully also be faster.
+
+=head1 AUTHOR
+
+Shlomi Fish, L<http://www.shlomifish.org/>.
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-xml-grammar-screenplay at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=XML-Grammar-Fiction>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 TODO
+
+=over 4
+
+=item * Empty
+
+=back
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc XML::Grammar::Fiction
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/XML-Grammar-Fiction>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/XML-Grammar-Fiction>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=XML-Grammar-Fiction>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/XML-Grammar-Fiction>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Shlomi Fish, all rights reserved.
+
+This program is released under the following license: MIT X11.
+
+=cut
+
+1;
+

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

+package XML::Grammar::Fiction::App::FromProto;
+
+use strict;
+use warnings;
+
+use base 'Exporter';
+
+our @EXPORT = (qw(run));
+
+use Getopt::Long;
+
+use XML::Grammar::Fiction::FromProto;
+use XML::Grammar::Fiction::FromProto::Parser::QnD;
+
+=head1 NAME
+
+XML::Grammar::Fiction::App::FromProto - module implementing
+a command line application to convert a well-formed text to
+Screenplay XML.
+
+=head1 SYNOPSIS
+
+    perl -MXML::Grammar::Fiction::App::FromProto -e 'run()' -- \
+	-o $@ $<
+
+=head1 FUNCTIONS
+
+=head2 run()
+
+Call with no arguments to run the application from the commandline.
+
+=cut
+
+sub run
+{
+    my $output_filename;
+
+    GetOptions(
+        "output|o=s" => \$output_filename,
+    );
+
+    if (!defined($output_filename))
+    {
+        die "Output filename not specified! Use the -o|--output flag!";
+    }
+
+    my $converter = XML::Grammar::Fiction::FromProto->new({
+        parser_class => "XML::Grammar::Fiction::FromProto::Parser::QnD",
+    });
+
+    my $output_xml = $converter->convert({
+            source => { file => shift(@ARGV), },
+        }
+    );
+
+    open my $out, ">", $output_filename;
+    binmode $out, ":utf8";
+    print {$out} $output_xml;
+    close($out);
+
+    exit(0);
+}
+
+
+=head1 AUTHOR
+
+Shlomi Fish, L<http://www.shlomifish.org/>.
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-xml-grammar-screenplay at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=XML-Grammar-Screenplay>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Shlomi Fish, all rights reserved.
+
+This program is released under the following license: MIT X11.
+
+=cut
+
+1;
+

perl/modules/XML-Grammar-Fiction/lib/XML/Grammar/Fiction/App/ToDocBook.pm

+package XML::Grammar::Fiction::App::ToDocBook;
+
+use strict;
+use warnings;
+
+use base 'Exporter';
+
+our @EXPORT = (qw(run));
+
+use Getopt::Long;
+
+use XML::Grammar::Fiction::ToDocBook;
+
+=head1 NAME
+
+XML::Grammar::Fiction::App::ToDocBook - module implementing
+a command line application to convert a Screenplay XML file to docbook.
+
+=head1 FUNCTIONS
+
+=head2 run()
+
+Call with no arguments to run the application from the commandline.
+
+=cut
+
+sub run
+{
+    my $output_filename;
+
+    GetOptions(
+        "output|o=s" => \$output_filename,
+    );
+
+    if (!defined($output_filename))
+    {
+        die "Output filename not specified! Use the -o|--output flag!";
+    }
+
+    my $converter = XML::Grammar::Fiction::ToDocBook->new();
+
+    my $output_text = $converter->translate_to_docbook({
+            source => { file => shift(@ARGV), },
+            output => "string",
+        }
+    );
+
+    open my $out, ">", $output_filename;
+    binmode $out, ":utf8";
+    print {$out} $output_text;
+    close($out);
+
+    exit(0);
+}
+
+
+=head1 AUTHOR
+
+Shlomi Fish, L<http://www.shlomifish.org/>.
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-xml-grammar-screenplay at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=XML-Grammar-Screenplay>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Shlomi Fish, all rights reserved.
+
+This program is released under the following license: MIT X11.
+
+=cut
+
+1;
+

perl/modules/XML-Grammar-Fiction/lib/XML/Grammar/Fiction/App/ToHTML.pm

+package XML::Grammar::Fiction::App::ToHTML;
+
+use strict;
+use warnings;
+
+use base 'Exporter';
+
+our @EXPORT = (qw(run));
+
+use Getopt::Long;
+
+use XML::Grammar::Fiction::ToHTML;
+
+=head1 NAME
+
+XML::Grammar::Fiction::App::ToHTML - module implementing
+a command line application to convert a Screenplay XML file to HTML
+
+=head1 FUNCTIONS
+
+=head2 run()
+
+Call with no arguments to run the application from the commandline.
+
+=cut
+
+sub run
+{
+    my $output_filename;
+
+    GetOptions(
+        "output|o=s" => \$output_filename,
+    );
+
+    if (!defined($output_filename))
+    {
+        die "Output filename not specified! Use the -o|--output flag!";
+    }
+
+    my $converter = XML::Grammar::Fiction::ToHTML->new();
+
+    my $output_text = $converter->translate_to_html({
+            source => { file => shift(@ARGV), },
+            output => "string",
+        }
+    );
+
+    open my $out, ">", $output_filename;
+    binmode $out, ":utf8";
+    print {$out} $output_text;
+    close($out);
+
+    exit(0);
+}
+
+
+=head1 AUTHOR
+
+Shlomi Fish, L<http://www.shlomifish.org/>.
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-xml-grammar-screenplay at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=XML-Grammar-Screenplay>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Shlomi Fish, all rights reserved.
+
+This program is released under the following license: MIT X11.
+
+=cut
+
+1;
+

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

+package XML::Grammar::Fiction::Base;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+XML::Grammar::Fiction::Base - base class for XML::Grammar::Fiction
+classes.
+
+=head1 METHODS
+
+=head2 $package->new({%args});
+
+Constructs a new package
+
+=cut
+
+sub new
+{
+    my $class = shift;
+    my $self = {};
+
+    bless $self, $class;
+
+    $self->_init(@_);
+
+    return $self;
+}
+
+1;
+

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

+package XML::Grammar::Fiction::FromProto;
+
+use strict;
+use warnings;
+
+use Carp;
+
+use base 'XML::Grammar::Fiction::Base';
+
+use XML::Writer;
+use HTML::Entities ();
+
+use XML::Grammar::Fiction::FromProto::Nodes;
+
+use Moose;
+
+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/};
+
+=head1 NAME
+
+XML::Grammar::Fiction::FromProto - module that converts well-formed
+text representing a screenplay to an XML format.
+
+=head1 VERSION
+
+Version 0.0600
+
+=cut
+
+our $VERSION = '0.0600';
+
+=head2 new()
+
+Accepts no arguments so far. May take some time as the grammar is compiled
+at that point.
+
+=head2 meta()
+
+Internal - (to settle pod-coverage.).
+
+=cut
+
+sub _init
+{
+    my ($self, $args) = @_;
+
+    local $Parse::RecDescent::skip = "";
+
+    my $parser_class = 
+        ($args->{parser_class} || "XML::Grammar::Fiction::FromProto::Parser::QnD");
+
+    $self->_parser(
+        $parser_class->new()
+    );
+
+    return 0;
+}
+
+=head2 $self->convert({ source => { file => $path_to_file } })
+
+Converts the file $path_to_file to XML and returns it.
+
+=cut
+
+use Data::Dumper;
+
+sub _output_tag
+{
+    my ($self, $args) = @_;
+
+    my @start = @{$args->{start}};
+    $self->_writer->startTag([$screenplay_ns,$start[0]], @start[1..$#start]);
+
+    $args->{in}->($self, $args);
+
+    $self->_writer->endTag();
+}
+
+sub _output_tag_with_childs
+{
+    my ($self, $args) = @_;
+
+    return 
+        $self->_output_tag({
+            %$args,
+            'in' => sub {
+                foreach my $child (@{$args->{elem}->_get_childs()})
+                {
+                    $self->_write_elem({elem => $child,});
+                }
+            },
+        });
+}
+
+sub _get_text_start
+{
+    my ($self, $elem) = @_;
+
+    if ($elem->isa("XML::Grammar::Fiction::FromProto::Node::Saying"))
+    {
+        return ["saying", 'character' => $elem->character()];
+    }
+    elsif ($elem->isa("XML::Grammar::Fiction::FromProto::Node::Description"))
+    {
+        return ["description"];
+    }
+    else
+    {
+        Carp::confess ("Unknown element class - " . ref($elem) . "!");
+    }
+}
+
+sub _write_elem
+{
+    my ($self, $args) = @_;
+
+    my $elem = $args->{elem};
+
+    if (ref($elem) eq "")
+    {
+        $self->_writer->characters($elem);
+    }
+    elsif ($elem->isa("XML::Grammar::Fiction::FromProto::Node::Paragraph"))
+    {
+        $self->_output_tag_with_childs(
+            {
+               start => ["para"],
+                elem => $elem,
+            },
+        );
+    }
+    elsif ($elem->isa("XML::Grammar::Fiction::FromProto::Node::Element"))
+    {
+        if (($elem->name() eq "s") || ($elem->name() eq "section"))
+        {
+            $self->_write_scene({scene => $elem});
+        }
+        elsif ($elem->name() eq "a")
+        {
+            $self->_output_tag_with_childs(
+                {
+                    start => ["ulink", "url" => $elem->lookup_attr("href")],
+                    elem => $elem,
+                }
+            );
+        }
+        elsif ($elem->name() eq "b")
+        {
+            $self->_output_tag_with_childs(
+                {
+                    start => ["bold"],
+                    elem => $elem,
+                }
+            );
+        }
+        elsif ($elem->name() eq "br")
+        {
+            $self->_writer->emptyTag("br");
+        }
+        elsif ($elem->isa("XML::Grammar::Fiction::FromProto::Node::InnerDesc"))
+        {
+            $self->_output_tag_with_childs(
+                {
+                    start => ["inlinedesc"],
+                    elem => $elem,
+                }
+            );
+        }
+    }
+    elsif ($elem->isa("XML::Grammar::Fiction::FromProto::Node::Text"))
+    {
+        $self->_output_tag_with_childs(
+            {
+                start => $self->_get_text_start($elem),
+                elem => $elem,
+            },
+        );
+    }
+    elsif ($elem->isa("XML::Grammar::Fiction::FromProto::Node::Comment"))
+    {
+        $self->_writer->comment($elem->text());
+    }
+}
+
+sub _write_scene
+{
+    my ($self, $args) = @_;
+
+    my $scene = $args->{scene};
+
+    my $tag = $scene->name;
+    
+    if (($tag eq "s") || ($tag eq "scene"))
+    {
+        my $id = $scene->lookup_attr("id");
+
+        if (!defined($id))
+        {
+            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],
+                elem => $scene,
+            }
+        );
+    }
+    else
+    {
+        confess "Improper scene tag - should be '<s>' or '<scene>'!";
+    }
+
+    return;
+}
+
+sub _read_file
+{
+    my ($self, $filename) = @_;
+
+    open my $in, "<", $filename or
+        confess "Could not open the file \"$filename\" for slurping.";
+    binmode $in, ":utf8";
+    my $contents;
+    {
+        local $/;
+        $contents = <$in>;
+    }
+    close($in);
+    
+    return $contents;
+}
+
+sub _calc_tree
+{
+    my ($self, $args) = @_;
+
+    my $filename = $args->{source}->{file} or
+        confess "Wrong filename given.";
+
+    return $self->_parser->process_text($self->_read_file($filename));
+}
+
+sub convert
+{
+    my ($self, $args) = @_;
+
+    # These should be un-commented for debugging.
+    # local $::RD_HINT = 1;
+    # local $::RD_TRACE = 1;
+    
+    # We need this so P::RD won't skip leading whitespace at lines
+    # which are siginificant.  
+
+    my $tree = $self->_calc_tree($args);
+
+    if (!defined($tree))
+    {
+        Carp::confess("Parsing failed.");
+    }
+
+    my $buffer = "";
+    my $writer = XML::Writer->new(
+        OUTPUT => \$buffer, 
+        ENCODING => "utf-8",
+        NAMESPACES => 1,
+        PREFIX_MAP =>
+        {
+             $screenplay_ns => "",
+        }
+    );
+
+    $writer->xmlDecl("utf-8");
+    $writer->doctype("document", undef, "screenplay-xml.dtd");
+    $writer->startTag([$screenplay_ns, "document"]);
+    $writer->startTag([$screenplay_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();
+
+    $writer->endTag();
+    
+    return $buffer;
+}
+
+=head1 AUTHOR
+
+Shlomi Fish, L<http://www.shlomifish.org/>.
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-xml-grammar-screenplay at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=XML-Grammar-Screenplay>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Shlomi Fish, all rights reserved.
+
+This program is released under the following license: MIT X11.
+
+=cut
+
+1;
+

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

+package XML::Grammar::Fiction::FromProto::Nodes;
+
+use strict;
+use warnings;
+
+use List::Util ();
+
+package XML::Grammar::Fiction::FromProto::Node;
+
+use Moose;
+
+package XML::Grammar::Fiction::FromProto::Node::WithContent;
+
+use Moose;
+
+extends("XML::Grammar::Fiction::FromProto::Node");
+
+has 'children' => (
+    isa => 'XML::Grammar::Fiction::FromProto::Node::List', 
+    is => 'rw'
+);
+
+sub _get_childs
+{
+    my $self = shift;
+
+    my $childs = $self->children->contents();
+
+    return $childs || [];
+}
+
+package XML::Grammar::Fiction::FromProto::Node::Element;
+
+use Moose;
+
+extends("XML::Grammar::Fiction::FromProto::Node::WithContent");
+
+has 'name' => (isa => 'Str', is => 'rw');
+has 'attrs' => (isa => 'ArrayRef', is => 'rw');
+
+sub lookup_attr
+{
+    my ($self, $attr_name) = @_;
+
+    my $pair = List::Util::first { $_->{key} eq $attr_name } (@{$self->attrs()});
+
+    if (!defined($pair))
+    {
+        return undef;
+    }
+    else
+    {
+        return $pair->{value};
+    }
+}
+
+package XML::Grammar::Fiction::FromProto::Node::List;
+
+use Moose;
+
+has 'contents' => (isa => "ArrayRef", is => "rw");
+
+package XML::Grammar::Fiction::FromProto::Node::Text;
+
+use Moose;
+
+extends("XML::Grammar::Fiction::FromProto::Node::WithContent");
+
+package XML::Grammar::Fiction::FromProto::Node::Saying;
+
+use Moose;
+
+extends("XML::Grammar::Fiction::FromProto::Node::Text");
+
+has 'character' => (isa => "Str", is => "rw");
+
+package XML::Grammar::Fiction::FromProto::Node::Description;
+
+use Moose;
+
+extends("XML::Grammar::Fiction::FromProto::Node::Text");
+
+package XML::Grammar::Fiction::FromProto::Node::Paragraph;
+
+use Moose;
+
+extends("XML::Grammar::Fiction::FromProto::Node::Element");
+
+package XML::Grammar::Fiction::FromProto::Node::InnerDesc;
+
+use Moose;
+
+extends("XML::Grammar::Fiction::FromProto::Node::Element");
+
+sub name
+{
+    return "inlinedesc";
+}
+
+package XML::Grammar::Fiction::FromProto::Node::Comment;
+
+use Moose;
+
+extends("XML::Grammar::Fiction::FromProto::Node");
+
+has "text" => (isa => "Str", is => "rw");
+
+1;
+
+=head1 NAME
+
+XML::Grammar::Fiction::FromProto::Nodes - contains several nodes for
+use in XML::Grammar::Fiction::FromProto.
+
+=head1 DESCRIPTION
+
+Contains several nodes.
+
+=cut
+

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

+package XML::Grammar::Fiction::FromProto::Parser;
+
+use strict;
+use warnings;
+
+use base 'XML::Grammar::Fiction::Base';
+
+1;
+
+=head1 NAME
+
+XML::Grammar::Fiction::FromProto::Parser - base class for parsers of the
+ScreenplayXML proto-text.
+
+B<For internal use only>.
+
+=head1 AUTHOR
+
+Shlomi Fish, L<http://www.shlomifish.org/>.
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-xml-grammar-screenplay at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=XML-Grammar-Screenplay>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Shlomi Fish, all rights reserved.
+
+This program is released under the following license: MIT X11.
+
+=cut

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

+package XML::Grammar::Fiction::FromProto::Parser::PRD;
+
+use strict;
+use warnings;
+
+use base 'XML::Grammar::Fiction::FromProto::Parser';
+
+use Parse::RecDescent;
+
+use Moose;
+
+use XML::Grammar::Fiction::FromProto::Nodes;
+
+has "_p_rd" => ('isa' => "Parse::RecDescent", is => "rw");
+
+sub _init
+{
+    my $self = shift;
+
+    $self->_p_rd(Parse::RecDescent->new($self->_calc_grammar()));
+
+    return 0;
+}
+
+sub _calc_grammar
+{
+    my $self = shift;
+
+    return <<'EOF';
+
+start : tag  {$thisparser->{ret} = $item[1]; 1 }
+
+text_unit:   tag_or_comment { $item[1] }
+           | speech_or_desc { $item[1] }
+
+tag_or_comment:   tag
+                | comment
+
+comment:    /<!--(.*?)-->/ms para_sep {
+    XML::Grammar::Fiction::FromProto::Node::Comment->new(
+        text => $1
+    )
+    }
+
+para_sep:      /(\n\s*)+/
+
+speech_or_desc:   speech_unit
+                | desc_unit
+
+plain_inner_text:  /([^\n<\[\]&]+\n?)+/ { $item[1] }
+
+inner_standalone_tag: /</ id attribute(s?) / *\/ *>/ space
+    {
+        XML::Grammar::Fiction::FromProto::Node::Element->new(
+            name => $item[2],
+            children => XML::Grammar::Fiction::FromProto::Node::List->new(
+                contents => []
+            ),
+            attrs => $item[3]
+            );
+    }
+
+
+inner_tag:         opening_tag  inner_text closing_tag {
+        my ($open, $inside, $close) = @item[1..$#item];
+        if ($open->{name} ne $close->{name})
+        {
+            Carp::confess("Tags do not match: $open->{name} and $close->{name}");
+        }
+        XML::Grammar::Fiction::FromProto::Node::Element->new(
+            name => $open->{name},
+            children => XML::Grammar::Fiction::FromProto::Node::List->new(
+                contents => $inside
+                ),
+            attrs => $open->{attrs},
+            )
+    }
+
+inner_desc:      /\[/ inner_text /\]/ {
+        my $inside = $item[2];
+        XML::Grammar::Fiction::FromProto::Node::InnerDesc->new(
+            children => XML::Grammar::Fiction::FromProto::Node::List->new(
+                contents => $inside
+                ),
+            )
+    }
+
+inner_tag_or_desc:    inner_tag
+                   |  inner_desc
+
+inner_entity:      /\&\w+;/ {
+        my $inside = $item[1];
+        HTML::Entities::decode_entities($inside)
+    }
+
+inner_text_unit:    plain_inner_text  { [ $item[1] ] }
+                 |  inner_tag_or_desc { [ $item[1] ] }
+                 |  inner_entity      { [ $item[1] ] }
+                 |  inner_standalone_tag { [ $item[1] ] }
+
+inner_text:       inner_text_unit(s) {
+        [ map { @{$_} } @{$item[1]} ]
+        }
+
+addressing: /^([^:\n\+]+): /ms { $1 }
+
+saying_first_para: addressing inner_text para_sep {
+            my ($sayer, $what) = ($item[1], $item[2]);
+            +{
+             character => $sayer,
+             para => XML::Grammar::Fiction::FromProto::Node::Paragraph->new(
+                children =>
+                XML::Grammar::Fiction::FromProto::Node::List->new(
+                    contents => $what,
+                    )
+                ),
+            }
+            }
+
+saying_other_para: /^\++: /ms inner_text para_sep {
+        XML::Grammar::Fiction::FromProto::Node::Paragraph->new(
+            children =>
+                XML::Grammar::Fiction::FromProto::Node::List->new(
+                    contents => $item[2],
+                    ),
+        )
+    }
+
+speech_unit:  saying_first_para saying_other_para(s?)
+    {
+    my $first = $item[1];
+    my $others = $item[2] || [];
+        XML::Grammar::Fiction::FromProto::Node::Saying->new(
+            character => $first->{character},
+            children => XML::Grammar::Fiction::FromProto::Node::List->new(
+                contents => [ $first->{para}, @{$others} ],
+                ),
+        )
+    }
+
+desc_para:  inner_text para_sep { $item[1] }
+
+desc_unit_inner: desc_para(s?) inner_text { [ @{$item[1]}, $item[2] ] }
+
+desc_unit: /^\[/ms desc_unit_inner /\]\s*$/ms para_sep {
+        my $paragraphs = $item[2];
+
+        XML::Grammar::Fiction::FromProto::Node::Description->new(
+            children => 
+                XML::Grammar::Fiction::FromProto::Node::List->new(
+                    contents =>
+                [
+                map { 
+                XML::Grammar::Fiction::FromProto::Node::Paragraph->new(
+                    children =>
+                        XML::Grammar::Fiction::FromProto::Node::List->new(
+                            contents => $_,
+                            ),
+                        )
+                } @$paragraphs
+                ],
+            ),
+        )
+    }
+
+text: text_unit(s) { XML::Grammar::Fiction::FromProto::Node::List->new(
+        contents => $item[1]
+        ) }
+      | space { XML::Grammar::Fiction::FromProto::Node::List->new(
+        contents => []
+        ) }
+
+tag: space opening_tag space text space closing_tag space
+     {
+        my (undef, $open, undef, $inside, undef, $close) = @item[1..$#item];
+        if ($open->{name} ne $close->{name})
+        {
+            Carp::confess("Tags do not match: $open->{name} and $close->{name}");
+        }
+        XML::Grammar::Fiction::FromProto::Node::Element->new(
+            name => $open->{name},
+            children => $inside,
+            attrs => $open->{attrs},
+            );
+     }
+
+opening_tag: '<' id attribute(s?) '>'
+    { $item[0] = { 'name' => $item[2], 'attrs' => $item[3] }; }
+
+closing_tag: '</' id '>'
+    { $item[0] = { 'name' => $item[2], }; }
+
+attribute: space id '="' attributevalue '"' space
+    { $item[0] = { 'key' => $item[2] , 'value' => $item[4] }; }
+
+attributevalue: /[^"]+/
+    { $item[0] = HTML::Entities::decode_entities($item[1]); }
+
+space: /\s*/
+
+id: /[a-zA-Z_\-]+/
+
+EOF
+}
+
+sub process_text
+{   
+    my ($self, $text) = @_;
+
+    my $rv = $self->_p_rd()->start($text);
+
+    if (!defined($rv))
+    {
+        return;
+    }
+    else
+    {
+        return $self->_p_rd->{ret};
+    }
+}
+
+1;
+
+
+=head1 NAME
+
+XML::Grammar::Fiction::FromProto::Parser - base class for parsers of the
+ScreenplayXML proto-text.
+
+B<For internal use only>.
+
+=head1 METHODS
+
+=head2 $self->process_text($string)
+
+Processes the text and returns it.
+
+=head2 $self->meta()
+
+Something that L<Moose> adds.
+
+=head1 AUTHOR
+
+Shlomi Fish, L<http://www.shlomifish.org/>.
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-xml-grammar-screenplay at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=XML-Grammar-Screenplay>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Shlomi Fish, all rights reserved.
+
+This program is released under the following license: MIT X11.
+
+=cut

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

+package XML::Grammar::Fiction::FromProto::Parser::QnD;
+
+use strict;
+use warnings;
+
+use base 'XML::Grammar::Fiction::FromProto::Parser';
+
+use Moose;
+
+has "_curr_line_idx" => (isa => "Int", is => "rw");
+has "_lines" => (isa => "ArrayRef", is => "rw");
+
+sub _curr_line :lvalue
+{
+    my $self = shift;
+
+    return $self->_lines()->[$self->_curr_line_idx()];
+}
+
+sub _curr_line_ref
+{
+    my $self = shift;
+
+    return \($self->_lines()->[$self->_curr_line_idx()]);
+}
+
+sub _with_curr_line
+{
+    my ($self, $sub_ref) = @_;
+
+    return $sub_ref->(\($self->_lines()->[$self->_curr_line_idx()]));
+}
+
+sub _next_line_ref
+{
+    my $self = shift;
+
+    $self->_curr_line_idx($self->_curr_line_idx()+1);
+
+    return $self->_curr_line_ref();
+}
+
+sub _init
+{
+    my $self = shift;
+
+    return 0;
+}
+
+sub _start
+{
+    my $self = shift;
+
+    return $self->_parse_top_level_tag();
+}
+
+# Skip the whitespace.
+sub _skip_space
+{
+    my $self = shift;
+
+    $self->_consume(qr{\s});
+}
+
+my $id_regex = '[a-zA-Z_\-]+';
+
+sub _parse_opening_tag
+{
+    my $self = shift;
+
+    # Now Lisp got nothing on us.
+    return $self->_with_curr_line(
+        sub {
+            # $l is a reference to the string of the current
+            # line
+            my $l = shift;
+
+            if ($$l !~ m{\G<($id_regex)}g)
+            {
+                Carp::confess("Cannot match opening tag at line " . $self->_get_line_num());
+            }
+            my $id = $1;
+
+            my @attrs;
+
+            while ($$l =~ m{\G\s*($id_regex)="([^"]+)"\s*}cg)
+            {
+                push @attrs, { 'key' => $1, 'value' => $2, };
+            }
+
+            my $is_standalone = 0;
+            if ($$l =~ m{\G\s*/\s*>}cg)
+            {
+                $is_standalone = 1;
+            }
+            elsif ($$l !~ m{\G>}g)
+            {
+                Carp::confess (
+                    "Cannot match the \">\" of the opening tag at line " 
+                        . $self->_get_line_num()
+                );
+            }
+            
+            return
+            {
+                name => $id,
+                is_standalone => $is_standalone,
+                line => $self->_get_line_num(),
+                attrs => \@attrs,
+            };
+        }
+    );
+}
+
+sub _get_line_num
+{
+    my $self = shift;
+
+    return $self->_curr_line_idx()+1;
+}
+
+sub _parse_closing_tag
+{
+    my $self = shift;
+
+    return $self->_with_curr_line(
+        sub {
+            my $l = shift;
+            if ($$l !~ m{\G</($id_regex)>}g)
+            {
+                Carp::confess("Cannot match closing tag at line ". $self->_get_line_num());
+            }
+
+            return
+            {
+                name => $1,
+            };
+        }
+    );
+}
+
+sub _parse_text
+{
+    my $self = shift;
+
+    my @ret;
+    while (defined(my $unit = $self->_parse_text_unit()))
+    {
+        push @ret, $unit;
+    }
+
+    # If it's whitespace - return an empty list.
+    if ((scalar(@ret) == 1) && (ref($ret[0]) eq "") && ($ret[0] !~ m{\S}))
+    {
+        return 
+            XML::Grammar::Fiction::FromProto::Node::List->new(
+                contents => []
+            );
+    }
+
+    return XML::Grammar::Fiction::FromProto::Node::List->new(
+        contents => \@ret,
+        );
+}
+
+sub _consume_paragraph
+{
+    my $self = shift;
+
+    $self->_skip_space();
+
+    return $self->_parse_inner_text();
+}
+
+sub _parse_inner_desc
+{
+    my $self = shift;
+
+    my $start_line = $self->_get_line_num();
+
+    # Skip the [
+    $self->_with_curr_line(
+        sub {
+            my $l = shift;
+
+            $$l =~ m{\G\[}g;
+        }
+    );
+
+    my $inside = $self->_parse_inner_text();
+
+    $self->_with_curr_line(
+        sub {
+            my $l = shift;
+
+            if ($$l !~ m{\G\]}g)
+            {
+                Carp::confess (
+                      "Inner description that started on line $start_line did "
+                    . "not terminate with a \"]\"!"
+                );
+            }
+        }
+    );
+
+    return
+        XML::Grammar::Fiction::FromProto::Node::InnerDesc->new(
+            start => $start_line,
+            children => XML::Grammar::Fiction::FromProto::Node::List->new(
+                contents => $inside
+            ),
+        );
+ 
+}
+
+sub _parse_inner_tag
+{
+    my $self = shift;
+
+    my $open = $self->_parse_opening_tag();
+
+    if ($open->{is_standalone})
+    {
+        $self->_skip_space();
+
+        return        
+            XML::Grammar::Fiction::FromProto::Node::Element->new(
+                name => $open->{name},
+                children => XML::Grammar::Fiction::FromProto::Node::List->new(
+                    contents => []
+                ),
+                attrs => $open->{attrs},
+            );
+    }
+
+    my $inside = $self->_parse_inner_text();
+
+    my $close = $self->_parse_closing_tag();
+
+    if ($open->{name} ne $close->{name})
+    {
+        Carp::confess("Opening and closing tags do not match: " 
+            . "$open->{name} and $close->{name} on element starting at "
+            . "line $open->{line}"
+        );
+    }
+    return XML::Grammar::Fiction::FromProto::Node::Element->new(
+        name => $open->{name},
+        children => XML::Grammar::Fiction::FromProto::Node::List->new(
+            contents => $inside
+            ),
+        attrs => $open->{attrs},
+        );
+}
+
+sub _parse_inner_text
+{
+    my $self = shift;
+
+    my @contents;
+
+    my $start_line = $self->_curr_line_idx();
+
+    my $curr_text = "";
+
+    CONTENTS_LOOP:
+    while ($self->_curr_line() ne "\n")
+    {
+        my $which_tag;
+        # We need this to avoid appending the rest of the first line 
+        $self->_with_curr_line(
+            sub {
+                my $l = shift;
+                
+                # Apparently, perl does not always returns true in this
+                # case, so we need the defined($1) ? $1 : "" workaround.
+                $$l =~ m{\G([^\<\[\]\&]*)}cgms;
+
+                $curr_text .= (defined($1) ? $1 : "");
+
+                if ($$l =~ m{\G\[})
+                {
+                    $which_tag = "open_desc";
+                }
+                elsif ($$l =~ m{\G\&})
+                {
+                    $which_tag = "entity";
+                }                
+                elsif ($$l =~ m{\G(?:</|\])})
+                {
+                    $which_tag = "close";
+                }
+                elsif ($$l =~ m{\G<})
+                {
+                    $which_tag = "open_tag";
+                }
+            }
+        );
+
+        push @contents, $curr_text;
+
+        $curr_text = "";
+
+        if (!defined($which_tag))
+        {
+            # Do nothing - a tag was not detected.
+        }
+        else
+        {
+            if (($which_tag eq "open_desc") || ($which_tag eq "open_tag"))
+            {
+                push @contents, 
+                    (($which_tag eq "open_tag")
+                        ? $self->_parse_inner_tag()
+                        : $self->_parse_inner_desc()
+                    );
+                # Avoid skipping to the next line.
+                # Gotta love teh Perl!
+                redo CONTENTS_LOOP;
+            }
+            elsif ($which_tag eq "close")
+            {
+                last CONTENTS_LOOP;
+            }
+            elsif ($which_tag eq "entity")
+            {
+                $self->_with_curr_line(
+                    sub {
+                        my $l = shift;
+                        if ($$l !~ m{\G(\&\w+;)}g)
+                        {
+                            Carp::confess("Cannot match entity (e.g: \"&quot;\") at line " .
+                                $self->_get_line_num()
+                            );
+                        }
+                        push @contents, HTML::Entities::decode_entities($1);
+                    }
+                );
+                redo CONTENTS_LOOP;
+            }
+        }
+    }
+    continue
+    {
+        if (!defined(${$self->_next_line_ref()}))
+        {
+            Carp::confess "End of file in an addressing paragraph starting at $start_line";
+        }
+    }
+
+    if (length($curr_text) > 0)
+    {
+        push @contents, $curr_text;
+    }
+
+    return \@contents;
+}
+
+# TODO : _parse_saying_first_para and _parse_saying_other_para are
+# very similar - abstract them into one function.
+sub _parse_saying_first_para
+{
+    my $self = shift;
+
+    my ($sayer, $what);
+    
+    ($sayer) = $self->_with_curr_line(
+        sub {
+            my $l = shift;
+
+            if ($$l !~ /\G([^:\n\+]+): /cgms)
+            {
+                Carp::confess("Cannot match addressing at line " . $self->_get_line_num());
+            }
+            my $sayer = $1;
+
+            if ($sayer =~ m{[\[\]]})
+            {
+                Carp::confess("Tried to put an inner-desc inside an addressing at line " . $self->_get_line_num());
+            }
+
+            return ($sayer);
+        }
+    );
+
+    $what = $self->_parse_inner_text();
+
+    return
+    +{
+         character => $sayer,
+         para => XML::Grammar::Fiction::FromProto::Node::Paragraph->new(
+            children =>
+            XML::Grammar::Fiction::FromProto::Node::List->new(
+                contents => $what,
+                )
+            ),
+    };
+}
+
+sub _parse_saying_other_para
+{
+    my $self = shift;
+
+    $self->_skip_space();
+
+    my $verdict = $self->_with_curr_line(
+        sub {
+            my $l = shift;
+
+            if ($$l !~ /\G\++: /cgms)
+            {
+                return;
+            }
+            else
+            {
+                return 1;
+            }
+        }
+    );
+
+    if (!defined($verdict))