Source

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

shl...@52c325ad-… 24980b2 

Shlomi Fish f136e54 
shl...@52c325ad-… 24980b2 













Shlomi Fish 7dbc955 
shl...@52c325ad-… 24980b2 











Shlomi Fish 43810e1 
shl...@52c325ad-… 24980b2 

Shlomi Fish 43810e1 

shl...@52c325ad-… 24980b2 





Shlomi Fish 9773cfd 




shl...@52c325ad-… aa8ce95 



Shlomi Fish 9773cfd 

shl...@52c325ad-… aa8ce95 









Shlomi Fish 9773cfd 









shl...@52c325ad-… aa8ce95 

Shlomi Fish 9773cfd 
shl...@52c325ad-… aa8ce95 





Shlomi Fish 43810e1 
shl...@52c325ad-… aa8ce95 






shl...@52c325ad-… 135230f 











shl...@52c325ad-… aa8ce95 







shl...@52c325ad-… 24980b2 
shl...@52c325ad-… ad95a95 












Shlomi Fish 0195a33 




































Shlomi Fish e60f1b8 








Shlomi Fish 0195a33 














shl...@52c325ad-… 24980b2 






package XML::Grammar::FictionBase::TagsTree2XML;

use MooX 'late';

use XML::Writer;
use HTML::Entities ();

use XML::Grammar::Fiction::FromProto::Nodes;


=head1 NAME

XML::Grammar::FictionBase::TagsTree2XML - base class for the tags-tree
to XML converters.

=head1 VERSION

Version 0.12.2

=cut

has '_parser_class' =>
(
    is => "ro",
    isa => "Str",
    init_arg => "parser_class",
    default => "XML::Grammar::Fiction::FromProto::Parser::QnD",
);

has "_parser" => (
    'isa' => "XML::Grammar::Fiction::FromProto::Parser",
    'is' => "rw",
    lazy => 1,
    default => sub {
        my $self = shift;
        return $self->_parser_class->new();
    },
);

has "_writer" => ('isa' => "XML::Writer", 'is' => "rw");

sub _is_passthrough_elem
{
    return;
}

sub _write_Element_elem
{
    my ($self, $elem) = @_;

    my $name = $elem->name();

    if ($elem->_short_isa("InnerDesc"))
    {
        $self->_output_tag_with_childs(
            {
                start => ["inlinedesc"],
                elem => $elem,
            }
        );
        return;
    }
    elsif ($self->_is_passthrough_elem($name))
    {
        return
        $self->_output_tag_with_childs(
            {
                start => [$name],
                elem => $elem,
            }
        );
    }
    else
    {
        my $method = "_handle_elem_of_name_$name";

        $self->$method($elem);

        return;
    }
}

sub _handle_elem_of_name_s
{
    my ($self, $elem) = @_;

    $self->_write_scene({scene => $elem});
}

sub _handle_elem_of_name_b
{
    my ($self, $elem) = @_;

    $self->_output_tag_with_childs(
        {
            start => [$self->_bold_tag_name()],
            elem => $elem,
        }
    );
}

sub _handle_elem_of_name_br
{
    my ($self, $elem) = @_;

    $self->_writer->emptyTag("br");

    return;
}

sub _handle_elem_of_name_i
{
    my ($self, $elem) = @_;

    $self->_output_tag_with_childs(
        {
            start => [$self->_italics_tag_name],
            elem => $elem,
        }
    );

    return;
}

sub _convert_while_handling_errors
{
    my ($self, $args) = @_;

    eval {
        my $output_xml = $self->convert(
            $args->{convert_args},
        );

        open my $out, ">", $args->{output_filename};
        binmode $out, ":utf8";
        print {$out} $output_xml;
        close($out);
    };

    # Error handling.

    my $e;
    if ($e = Exception::Class->caught("XML::Grammar::Fiction::Err::Parse::TagsMismatch"))
    {
        warn $e->error(), "\n";
        warn "Open: ", $e->opening_tag->name(),
            " at line ", $e->opening_tag->line(), "\n"
            ;
        warn "Close: ",
            $e->closing_tag->name(), " at line ",
            $e->closing_tag->line(), "\n";

        exit(-1);
    }
    elsif ($e = Exception::Class->caught("XML::Grammar::Fiction::Err::Parse::LineError"))
    {
        warn $e->error(), "\n";
        warn "At line ", $e->line(), "\n";
        exit(-1);
    }
    elsif ($e = Exception::Class->caught("XML::Grammar::Fiction::Err::Parse::TagNotClosedAtEOF"))
    {
        warn $e->error(), "\n";
        warn "Open: ", $e->opening_tag->name(),
            " at line ", $e->opening_tag->line(), "\n"
            ;

        exit(-1);
    }
    elsif ($e = Exception::Class->caught())
    {
        if (ref($e))
        {
            $e->rethrow();
        }
        else
        {
            die $e;
        }
    }

    return;
}

=head2 meta()

Internal - (to settle pod-coverage.).

=cut

1;