File Coverage

blib/lib/HTML/WebDAO/Container.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

#$Id: Container.pm 215 2007-11-13 08:44:47Z zag $

package HTML::WebDAO::Container;
use HTML::WebDAO::Element;
use Data::Dumper;
use base qw(HTML::WebDAO::Element);
use strict 'vars';

#no strict 'refs';
__PACKAGE__->attributes qw/ __childs/;

sub _sysinit {
    my $self = shift;

    #First invoke parent _init;
    $self->SUPER::_sysinit(@_);

    #initalize "childs" array for this container
    $self->__childs( [] );

}

sub _get_vars {
    my $self = shift;
    my ( $res, $ref );
    $res = $self->SUPER::_get_vars;
    return $res;
}

sub _set_vars {
    my ( $self, $ref ) = @_;
    my $chld_name;
    $self->SUPER::_set_vars($ref);
}

=head3 _get_childs()

Return ref to childs array

=cut

sub _get_childs {
    return $_[0]->__childs;
}

=head3 _add_childs($object1[, $object2])

Insert set of objects into container

=cut

sub _add_childs {
    my $self   = shift;
    my @childs =
      grep { ref $_ }
      map { ref($_) eq 'ARRAY' ? @$_ : $_ }
      map { $_->__get_self_refs }
      grep { ref($_) && $_->can('__get_self_refs') } @_;
    return unless @childs;
    if ( $self->__parent ) {
        $_->_set_parent($self) for @childs;
        $self->getEngine->__restore_session_attributes(@childs);
    }
    push( @{ $self->__childs }, @childs );
}

#it for container
sub _set_parent {
    my ( $self, $par ) = @_;
    $self->SUPER::_set_parent($par);
    foreach my $ref ( @{ $self->__childs } ) {
        $ref->_set_parent($self);
    }
}

sub _call_method {
    my $self = shift;
    my ( $name, @path ) = @{ shift @_ };
    return $self->SUPER::_call_method( [ $name, @path ], @_ ) || do {
        if ( my $obj = $self->_get_obj_by_name($name) ) {
            if ( ref($obj) eq 'HASH' ) {
                LOG $self Dumper( [ map { [ caller($_) ] } ( 1 .. 6 ) ] );
                $self->LOG( " got $obj for $name" . Dumper($obj) );
            }
            $obj->_call_method( \@path, @_ );
        }
        else {
            _log4 $self "Cant find obj for name $name in "
              . $self->__my_name() . ":"
              . Dumper( [ map { $_->__my_name } @{ $self->_get_childs } ] );
            return;
        }
      }
}

sub _get_obj_by_name {
    my $self = shift;
    my $name = shift;
    return unless defined $name;
    my $res;
    foreach my $obj ( $self, @{ $self->__childs } ) {
        if ( $obj->_obj_name eq $name ) {
            return $obj;
        }
    }
    return;
}

=head2 fetch(@_), default call by webdao: fetch( $session )

Interate call fetch(@_) on childs

=cut

sub fetch {
    my $self = shift;
    my @res;
    for my $a ( @{ $self->__childs } ) {
        push( @res, @{ $a->_format(@_) } );
    }
    return \@res;

}

sub _destroy {
    my $self = shift;
    my @res;
    for my $a ( @{ $self->__childs } ) {
        $a->_destroy;
    }
    $self->__childs( [] );
    $self->SUPER::_destroy;
}

=head2 _get_object_by_path <$path>, [$session]

Return first Element object for path.
Try to load objects for current object.

=cut

sub _get_object_by_path {
    my $self        = shift;
    my $path        = shift;
    my $session     = shift;
#    _log1 $self Dumper {'$self'=>ref($self), path=>$path};
    my @backup_path = @$path;
    my $next_name   = $path->[0];
    #first try get by name
    if ( my $obj = $self->_get_obj_by_name($next_name) ) {
        shift @$path;    #skip first name
                         #ok got it
                         #check if it container
                         #skip extra path
        if ( UNIVERSAL::can( $obj, '__extra_path' ) ) {
            my $extra_path = $obj->__extra_path;

            #if extra path defined and not ref convert to ref
            if ( defined $extra_path ) {
                $extra_path = [$extra_path] unless ref($extra_path);
            }
            if ( ref($extra_path) ) {
                my @extra = @$extra_path;

                #now skip extra
                for (@extra) {
                    if ( $path->[0] eq $_ ) {
                        shift @$path;
                    }
                    else {
                        _log2 $self "Break __extra_path "
                          . $path->[0] . " <> "
                          . $_
                          . " for : $obj";
                        last;
                    }
                }
            }
        }
        if ( $obj->isa('HTML::WebDAO::Container') ) {
            return $obj unless @$path;    # return object if end of path
            return $obj->_get_object_by_path( $path, $session );
        }
        else {

            #if element return point in any way
            return $obj

              #            my $method = $path->[0] || 'index_html';
              #            #if it element try to can method
              #            return $obj->can($method) ? $obj : undef;
        }
    }
    else {

        #try get objects by special methods
        my $dyn = $self->__get_objects_by_path( $path, $session )
          || return;    #break search

        #handle self controlled objects
        if ( $dyn eq $self ) {
            return $self;
        }
        $dyn = [$dyn] unless ref($dyn) eq 'ARRAY';

        #now try find object in returned array
        my $next;
        foreach (@$dyn) {

            #skip non objects
            next unless $_->_obj_name eq $next_name;
            $next = $_;
            last;    #exit from loop loop
        }
        unless ($next) {
            return    # return undef unless find objects
        }
        else {

            # yes, from returned object present traverse continue
            #if defined $session ( load scene)
            if ($session) {
                $self->_add_childs(@$dyn);
                return $self->_get_object_by_path( $path, $session );
            }
            else {

                #if query without session
                #try to find  by name
                #ok got it
                #check if it container
                if ( $next->isa('HTML::WebDAO::Container') ) {
                    return $next->_get_object_by_path( $path, $session );
                }
                else {

                    #return object referense in any way
                    return $next;
                }
            }

        }
    }
}

=head2 __get_objects_by_path [path], $session

Return next object for path

=cut

sub __get_objects_by_path {
    my $self = shift;
    my ( $path, $session ) = @_;
    # check if path point to method
    return $self if $self->can($path->[0]);
    return;    # default return undef
}

1;