Tree::Persist::File::XML - a handler for Tree persistence

Tree-Persist documentation Contained in the Tree-Persist distribution.

Index

Code Index:

NAME

Top

Tree::Persist::File::XML - a handler for Tree persistence

SYNOPSIS

Top

Please see Tree::Persist for how to use this module.

DESCRIPTION

Top

This module is a plugin for Tree::Persist to store a Tree to an XML file.

PARAMETERS

Top

This class requires no additional parameters than are specified by its parent, Tree::Persist::File.

XML SPEC

Top

The XML used is very simple. Each element is called "node". The node contains two attributes - "class", which represents the Tree class to build this node for, and "value", which is the serialized value contained in the node (as retrieved by the value() method.) Parent-child relationships are represented by the parent containing the child.

NOTE: This plugin will currently only handle values that are strings or have a stringification method.

TODO

Top

CODE COVERAGE

Top

Please see the relevant section of Tree::Persist.

SUPPORT

Top

Please see the relevant section of Tree::Persist.

AUTHORS

Top

Rob Kinyon <rob.kinyon@iinteractive.com>

Stevan Little <stevan.little@iinteractive.com>

Thanks to Infinity Interactive for generously donating our time.

COPYRIGHT AND LICENSE

Top

Copyright 2004, 2005 by Infinity Interactive, Inc.

http://www.iinteractive.com

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Tree-Persist documentation Contained in the Tree-Persist distribution. 
package Tree::Persist::File::XML;

use strict;
use warnings;

use base qw( Tree::Persist::File );

use Scalar::Util qw( blessed refaddr );
use UNIVERSAL::require;
use XML::Parser;

our $VERSION = '1.00';

sub _reload {
    my $self = shift;

    my $linenum = 0;
    my @stack;
    my $tree;
    my $parser = XML::Parser->new(
        Handlers => {
            Start => sub {
                shift;
                my ($name, %args) = @_;

                my $class = $args{class}
                    ? $args{class}
                    : $self->{_class};
                $class->require or die $UNIVERSAL::require::ERROR;

                my $node = $class->new( $args{value} );

                if ( @stack ) {
                    $stack[-1]->add_child( $node );
                }
                else {
                    $tree = $node;
                }

                push @stack, $node;
            },
            End => sub {
                $linenum++;
                pop @stack;
            },
        },
    );

    $parser->parsefile( $self->{_filename} );

    $self->_set_tree( $tree );

    return $self;
}

my $pad = ' ' x 4;

sub _build_string {
    my $self = shift;
    my ($tree) = @_;

    my $str = '';

    my $curr_depth = $tree->depth;
    my @closer;
    foreach my $node ( $tree->traverse ) {
        my $new_depth = $node->depth;
        $str .= pop(@closer) while @closer && $curr_depth-- >= $new_depth;

        $curr_depth = $new_depth;
        $str .= ($pad x $curr_depth)
                . '<node class="'
                . blessed($node)
                . '" value="'
                #XXX Need to encode the value.
                . $node->value
                . '">' . $/;
        push @closer, ($pad x $curr_depth) . "</node>\n";
    }
    $str .= pop(@closer) while @closer;

    return $str;
}

1;
__END__