XML::CompareML::Base - base class for the CompareML-to-something converters.

see XML::CompareML.

A constructor - should be used by a derived class.

See XML::CompareML =cut

use XML::LibXML;

use XML::CompareML::DTD::Generate;

use base qw(Class::Accessor);

__PACKAGE__->mk_accessors( qw(_timestamp root_elem impls_indexes impls_names), qw(parser dom), );

sub new { my $class = shift; my $self = {}; bless $self, $class; $self->_initialize(@_); return $self; }

sub _findnodes { my $self = shift; return $self->root_elem->findnodes(@_); }

sub _xml_node_contents_to_string { my $self = shift; my $node = shift; my @child_nodes = $node->childNodes(); my $ret = join("", map { $_->toString() } @child_nodes); # Remove leading and trailing space. $ret =~ s!^\s+!!mg; $ret =~ s/\s+$//mg; return $ret; }

sub _impl_get_tag_text { my $self = shift; my $impl_elem = shift; my $tag = shift; my ($name_elem) = $impl_elem->getChildrenByTagName($tag); if (!defined($name_elem)) { return; } return $self->_xml_node_contents_to_string($name_elem); }

sub _impl_get_name { my $self = shift; my $impl_elem = shift; return $self->_impl_get_tag_text($impl_elem, "name"); }

sub _get_implementations { my $self = shift; return [ map { +{ 'id' => $_->getAttribute("id"), 'name' => $self->_impl_get_name($_) } } $self->_findnodes("/comparison/meta/implementations/impl") ]; }

sub _get_timestamp { my $self = shift; my @nodes = $self->_findnodes("/comparison/meta/timestamp"); if (@nodes) { return $self->_xml_node_contents_to_string($nodes[0]); } else { return undef; } }

sub _initialize { my $self = shift; my %args = (@_); my $parser; my $dom; if ($args{input_filename}) { $parser = XML::LibXML->new(); $parser->validation(0); $dom = $parser->parse_file($args{input_filename}); my $dtd = XML::LibXML::Dtd->parse_string( XML::CompareML::DTD::Generate::get_dtd() ); $dom->validate($dtd); } else { die "input_filename must be specified!"; } if ($args{output_handle}) { $self->{o} = $args{output_handle}; } else { die "output_handle must be specified!"; } $self->parser($parser); $self->dom($dom); $self->root_elem($dom->getDocumentElement()); }

sub process { my $self = shift;

    my ($contents_elem) = $self->root_elem->getChildrenByTagName("contents");
    my ($top_section_elem) = $contents_elem->getChildrenByTagName("section");

    my @impls = @{$self->_get_implementations()};

    $self->{impls} = \@impls;
    $self->impls_indexes(+{ map { $impls[$_]->{'id'} => $_ } (0 .. $#impls) });
    $self->impls_names(+{map { $_->{'id'} => $_->{'name'} } @impls });
    $self->_timestamp($self->_get_timestamp());

    $self->{document_text} = "";
    $self->{toc_text} = "";

    # Make sure we print anything only when we finished extracting all
    # the meta-data.
    $self->_print_header();

    $self->_start_rendering();

    $self->_render_section('elem' => $top_section_elem, 'depth' => 0,);

    $self->_finish_rendering();

    print {*{$self->{o}}} $self->{document_text};

    $self->_print_footer();
}

sub _name { my $self = shift; my $id = shift; return $self->impls_names->{$id}; }

sub _sorter { my $self = shift; my $impl = shift;

    my $indexes = $self->impls_indexes();

    if (!exists($indexes->{$impl}))
    {
        die "Unknown system $impl";
    }
    return $indexes->{$impl};
}

sub _out { my $self = shift; $self->{document_text} .= join("", @_); }

sub _toc_out { my $self = shift; $self->{toc_text} .= join("", @_); }

sub _render_section { my $self = shift; my %args = (@_); my $section_elem = $args{elem}; my $depth = $args{depth} || 0;

    my ($expl) = $section_elem->getChildrenByTagName("expl");
    my ($title) = $section_elem->getChildrenByTagName("title");
    my ($compare) = $section_elem->getChildrenByTagName("compare");
    my @sub_sections = $section_elem->getChildrenByTagName("section");

    my $title_string = $title->string_value();

    my $id = $section_elem->getAttribute("id");

    my @args = (
        'depth' => $depth,
        'id' => $id,
        'title_string' => $title_string,
        'expl' => $expl,
        'sub_sections' => \@sub_sections,
        );

    $self->_render_section_start(
        @args
    );

    if ($compare)
    {
        $self->_render_sys_table_start(@args);

        my @systems = ($compare->getChildrenByTagName("s"));
        my %kv =
            (map
                { $_->getAttribute("id") => $self->_render_s_elem($_) }
                @systems
            );
        my @keys_sorted = (sort { $self->_sorter($a) <=> $self->_sorter($b) } keys(%kv));
        foreach my $k (@keys_sorted)
        {
            $self->_render_sys_table_row(
                'name' => $self->_name($k),
                'desc' => $kv{$k},
            );
        }
        $self->_render_sys_table_end();
    }

    foreach my $sub (@sub_sections)
    {
        $self->_render_section(
            'elem' => $sub,
            'depth' => ($depth+1)
            );
    }

    $self->_render_section_end(
        @args,
    );
}

Shlomi Fish, http://www.shlomifish.org/.

XML::CompareML

Copyright 2004, Shlomi Fish. All rights reserved.

You can use, modify and distribute this module under the terms of the MIT X11 license. ( http://www.opensource.org/licenses/mit-license.php ).