File Coverage

blib/lib/Graph/Template.pm

Criterion	Covered	Total	%
statement	18	20	90.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	25	27	92.5

package Graph::Template;

use strict;

BEGIN {
    use Graph::Template::Base;
    use vars qw ($VERSION @ISA);

    $VERSION  = '0.05';
    @ISA      = qw (Graph::Template::Base);
}

use File::Basename;
use IO::File;
use XML::Parser;

sub new
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);

    $self->parse_xml($self->{FILENAME})
        if defined $self->{FILENAME};

    return $self;
}

sub param
{
    my $self = shift;

    # Allow an arbitrary number of hashrefs, so long as they're the first things
    # into param(). Put each one onto the end, de-referenced.
    push @_, %{shift @_} while UNIVERSAL::isa($_[0], 'HASH');

    (@_ % 2)
        && die __PACKAGE__, "->param() : Odd number of parameters to param()\n";

    my %params = @_;
    $params{uc $_} = delete $params{$_} for keys %params;
    @{$self->{PARAM_MAP}}{keys %params} = @params{keys %params};

    return 1;
}

sub write_file
{
    my $self = shift;
    my ($filename) = @_;

    my ($graph, $method) = $self->_prepare_output;

    open IMG, ">$filename"
        or die "Cannot open '$filename' for writing: $!\n";
    binmode IMG;
    print IMG $graph->$method;
    close IMG;
}

sub output
{
    my $self = shift;

    my ($graph, $method) = $self->_prepare_output;

    binmode STDOUT;
    $graph->$method;
}

sub parse
{
    my $self = shift;

    $self->parse_xml(@_);
}

sub parse_xml
{
    my $self = shift;
    my ($filename) = @_;

    my ($fname, $dirname) = fileparse($filename);

    my @stack;
    my $parser = XML::Parser->new(
        Base => $dirname,
        Handlers => {
            Start => sub {
                shift;

                my $name = uc shift;

                my $node = Graph::Template::Factory->create_node($name, @_);
                die "'$name' (@_) didn't make a node!\n" unless defined $node;

                if ($name eq 'GRAPH')
                {
                    push @{$self->{GRAPHS}}, $node;
                }
                elsif ($name eq 'VAR')
                {
                    return unless @stack;

                    if (exists $stack[-1]{TXTOBJ} &&
                        $stack[-1]{TXTOBJ}->isa('TEXTOBJECT'))
                    {
                        push @{$stack[-1]{TXTOBJ}{STACK}}, $node;
                    }

                }
                else
                {
                    push @{$stack[-1]{ELEMENTS}}, $node
                        if @stack;
                }
                push @stack, $node;
            },
            Char => sub {
                shift;
                return unless @stack;

                my $parent = $stack[-1];

                if (
                    exists $parent->{TXTOBJ}
                        &&
                    $parent->{TXTOBJ}->isa('TEXTOBJECT')
                ) {
                    push @{$parent->{TXTOBJ}{STACK}}, @_;
                }
            },
            End => sub {
                shift;
                return unless @stack;

                pop @stack if $stack[-1]->isa(uc $_[0]);
            },
        },
    );

    {
        my $fh = IO::File->new($filename)
            || die "Cannot open '$filename' for reading: $!\n";

        $parser->parse(do { local $/ = undef; <$fh> });

        $fh->close;
    }

    return 1;
}

sub _prepare_output
{
    my $self = shift;
    my ($graph) = @_;

    my $context = Graph::Template::Factory->create(
        'CONTEXT',

        PARAM_MAP => [ $self->{PARAM_MAP} ],
    );

    foreach my $graph (@{$self->{GRAPHS}})
    {
        foreach my $method (qw( enter_scope render exit_scope ))
        {
            $graph->$method($context);
        }
    }

    return ($context->plotted_graph, $context->format);
}

sub register { shift; Graph::Template::Factory::register(@_) }

1;
__END__