root/lang/perl/Text-Nyarlax/trunk/lib/Text/Nyarlax/Element.pm @ 105

package Text::Nyarlax::Element;

use strict;
use warnings;

our $VERSION = '0.1';

use Carp;
use base qw( Class::Accessor::Fast );
__PACKAGE__->mk_ro_accessors( qw( name attribute ) );
use Text::Nyarlax::Util qw( join_node );

{
    no warnings 'uninitialized';
    *attr = __PACKAGE__->can('attribute');
}

sub new {
    my ( $class, %args ) = @_;

    my $name = $args{'name'}
        or croak "Element name is not specified.";

    my $attr = $args{'attribute'} || $args{'attr'} || {};
    croak "Attribute is not HASH reference." if ( ref $attr ne 'HASH' );

    my $self = bless {
        name        => $name,
        attribute   => $attr,
        content     => [],
    }, $class;

    my $content = $args{'content'} || [];
       $content = [ $content ] if ( ref $content ne 'ARRAY' );

    $self->content( $content );

    return $self;
}

sub parent {
    my $self = shift;
    if ( @_ ) {
        my $parent = shift @_;
        croak "Argument is not " . __PACKAGE__ . " object."
            if ( ref $parent ne __PACKAGE__ );
        $self->{'parent'} = $parent;
    }
    else {
        $self->{'parent'};
    }
}

sub content {
    my $self = shift;
    if ( @_ ) {
        my $contents = shift @_;
           $contents = [ $contents ] if ( ref $contents ne 'ARRAY' );
        for my $content ( @{ $contents } ) {
            $content->parent( $self ) if ( ref $content eq __PACKAGE__ );
        }
        $self->{'content'} = $contents;
    }
    else {
        $self->{'content'};
    }
}

sub shift_content {
    my ( $self ) = @_;
    shift @{ $self->{'content'} };
}

sub unshift_content {
    my ( $self, @contents ) = @_;
    for my $content ( @contents ) {
        $content->parent( $self ) if ( ref $content eq __PACKAGE__ );
    }
    unshift @{ $self->{'content'} }, @contents;
}

sub pop_content {
    my ( $self ) = @_;
    pop @{ $self->{'content'} };
}

sub push_content {
    my ( $self, @contents ) = @_;
    for my $content ( @contents ) {
        $content->parent( $self ) if ( ref $content eq __PACKAGE__ );
    }
    push @{ $self->{'content'} }, @contents;
}

sub join_content {
    my ( $self, %args ) = @_;
    $self->content( join_node( $self->content, %args ) );
}

1;
__END__

=head1 NAME

Text::Nyarlax::Element - Text::Nyarlax element object

=head1 SYNOPSIS

    use Text::Nyarlax::Element;
    
    my $elm = Text::Nyarlax::Element->new(
        name => 'Section',
        attr => {
            id => 'MyID',
            class => 'MyClass',
        },
        content => [
            'Foo',
            'Bar',
            'Baz'
        ],
    );

=head1 DESCRIPTION

Text::Nyarlax::Element is the object to compose the element tree.
The element tree is generated by the parser of Text::Nyarlax.

=head1 METHODS

=head2 new

The argument is three of name, attribute(attr) and content, and name is necessary.

attribute has to be Hash and content has to be one character string,Text::Nyarlax::Element object
or ARRAY which consists of a character string and Text::Nyarlax::element object.

=head2 name

get element name. readonly.

=head2 attribute/attr

get element attributes. return HASH reference.

=head2 parent

set/get the Text::Nyarlax::Element object which becomes a parent.

=head2 content

set/get the contents of Text::Nyarlax::Element object.

When setting the contents, it's necessary to use ARRAY reference,
and when getting the contents, ARRAY reference is returning.

=head2 shift_content

The contents are added at the first of obejct contents.

=head2 unshift_content

The first contents is taken out.

=head2 push_content

The contents are added at the last of obejct contents.

=head2 pop_content

The last contents is taken out.

Naoki Okamura E<lt>thotep@nayrla.netE<gt>

=head1 LICENSE

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

=head1 SEE ALSO

L<Text::Nyarlax::Element::Content>

=cut;