File Coverage

blib/lib/HTML/WebDAO/Element.pm

Criterion	Covered	Total	%
statement	12	12	100.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	16	16	100.0

#$Id: Element.pm 216 2007-11-13 08:48:37Z zag $

package HTML::WebDAO::Element;
use Data::Dumper;
use HTML::WebDAO::Base;
use base qw/ HTML::WebDAO::Base/;
use strict 'vars';
__PACKAGE__->attributes
  qw/ _format_subs __attribute_names __my_name __parent __path2me  __engine  __extra_path /;

sub _init {
    my $self = shift;
    $self->_sysinit( \@_ );    #For system internal inherites
    $self->init(@_);           # if (@_);
    return 1;
}

sub RegEvent {
    my $self    = shift;
    my $ref_eng = $self->getEngine;
    $ref_eng->RegEvent( $self, @_ );
}

#
sub _sysinit {
    my $self = shift;

    #get init hash reference
    my $ref_init_hash = shift( @{ $_[0] } );

    #_engine - reference to engine
    $self->__engine( $ref_init_hash->{ref_engine} );

    #_my_name - name of this object
    $self->__my_name( $ref_init_hash->{name_obj} );

    #init hash of attribute_names
    my $ref_names_hash = {};
    map { $ref_names_hash->{$_} = 1 } $self->get_attribute_names();

    #        _attribute_names $self $ref_names_hash;
    $self->__attribute_names($ref_names_hash);

    #init array of _format sub's references
    #    $self->_format_subs(
    #        [
    #            sub { $self->pre_format(@_) },
    #            sub { $self->format(@_) },
    #            sub { $self->post_format(@_) },
    #        ]
    #    );

}

sub init {

    #Public Init metod for modules;
}

sub _get_vars {
    my $self = shift;
    my $res;
    for my $key ( keys %{ $self->__attribute_names } ) {
        my $val = $self->get_attribute($key);
        no strict 'vars';
        $res->{$key} = $val if ( defined($val) );
        use strict 'vars';
    }
    return $res;
}

=head3 _get_childs()

Return ref to childs array

=cut

sub _get_childs {
    return [];
}

sub call_path {
    my $self = shift;
    my $path = shift;
    $path = [ grep { $_ } split( /\//, $path ) ];
    return $self->getEngine->_call_method( $path, @_ );
}

sub _call_method {
    my $self = shift;
    my ( $method, @path ) = @{ shift @_ };
    if ( scalar @path ) {

        #_log4 $self "Extra path @path $self";
        return;
    }
    unless ( $self->can($method) ) {
        _log4 $self $self->_obj_name . ": don't have method $method";
        return;
    }
    else {
        $self->$method(@_);
    }
}

sub __get_self_refs {
    return $_[0];
}

sub _set_parent {
    my ( $self, $parent ) = @_;
    $self->__parent($parent);
    $self->_set_path2me();
}

sub _set_path2me {
    my $self   = shift;
    my $parent = $self->__parent;
    if ( $self != $parent ) {
        ( my $parents_path = $parent->__path2me ) ||= "";
        my $extr = $parent->__extra_path;
        $extr = [] unless defined $extr;
        $extr = [$extr] unless ( ref($extr) eq 'ARRAY' );
        my $my_path = join "/", $parents_path, @$extr, $self->__my_name;
        $self->__path2me($my_path);
    }
    else {
        $self->__path2me('');
    }
}

sub _obj_name {
    return $_[0]->__my_name;
}

sub getEngine {
    my $self = shift;
    return $self->__engine;
}

sub SendEvent {
    my $self   = shift;
    my $parent = __parent $self;
    $self->_log1( "Not def parent $self name:"
          . ( $self->__my_name )
          . Dumper( \@_ )
          . Dumper( [ map { [ caller($_) ] } ( 1 .. 10 ) ] ) )
      unless $parent;
    $parent->SendEvent(@_);
}

sub pre_format {
    my $self = shift;
    return [];
}

sub _format {
    my $self = shift;
    my @res;
    push( @res, @{ $self->pre_format(@_) } );    #for compat
    if ( my $result = $self->fetch(@_) ) {
        push @res, ( ref($result) eq 'ARRAY' ? @{$result} : $result );
    }
    push( @res, @{ $self->post_format(@_) } );    #for compat

    \@res;
}

sub format {
    my $self = shift;
    return shift;
}

sub post_format {
    my $self = shift;
    return [];
}

sub fetch { my $self = shift; return [] }

sub _destroy {
    my $self = shift;
    $self->__parent(undef);
    $self->__engine(undef);
    $self->_format_subs(undef);
}

sub _set_vars {
    my ( $self, $ref, $names ) = @_;
    $names = $self->__attribute_names;
    for my $key ( keys %{$ref} ) {
        if ( exists( $names->{$key} ) ) {
            $self ->${key}( $ref->{$key} );
        }
        else {

            # Uknown attribute ???

        }
    }
}

=head2 __get_objects_by_path [path], $session

Check if exist method in $path and return $self or undef

=cut

sub __get_objects_by_path {
    my $self = shift;
    return;
}
1;