File Coverage

blib/lib/WebService/GData/Node.pm

Criterion	Covered	Total	%
statement	106	119	89.0
branch	32	40	80.0
condition	4	6	66.6
subroutine	21	26	80.7
pod	11	12	91.6
total	174	203	85.7

package WebService::GData::Node;
use WebService::GData;
use base 'WebService::GData';

our $VERSION = 0.06;

my $attributes = [];

sub import {
    shift();
    my $package = shift() || caller;
    return if ( $package->isa(__PACKAGE__) || $package eq 'main' );


    WebService::GData->import;

    WebService::GData::install_in_package( ['set_meta'],
        sub { return \&set_meta; }, $package );

    #install this package in the inheritance chain
    #and create the default tag_name by lowering the last name of the package
    {
        no strict 'refs';
        push @{ $package . '::ISA' }, __PACKAGE__;
        my $pk = $package;
        $package =~ s/.*:://;
        *{ $pk . '::node_name' } = sub {
            return "\l$package";
          }
    }
}

sub set_meta {
    my %data    = @_;
    my $package = caller;
    return if ( $package eq __PACKAGE__ );
    {
        no strict 'refs';
        no warnings 'redefine';
        while ( my ( $sub, $val ) = each %data ) {
            *{ $package . '::' . $sub } = sub {
                return $val;
              }
        }

    }
}

sub __init {
    my ( $this, @args ) = @_;

    $this->{namespaces} = {};
    if ( ref( $args[0] ) eq 'HASH' ) {

        #accept a text tag but json feed uses $t tag so adapt
        #for compatibility
        if ( $args[0]->{'$t'} ) {
            $args[0]->{'text'} = $args[0]->{'$t'};
            delete $args[0]->{'$t'};
        }
        my %args = %{ $args[0] };
        foreach my $attr (keys %args) {
            my $val = delete $args{$attr};
            $attr =~ s/\$/:/;
            $args{$attr} = $val;
        }
        @args = %args;
    }

    $this->SUPER::__init(@args) if ( @args % 2 == 0 );
    $this->{_children} = [];
}

sub namespace_prefix { "" }

sub node_name { "" }

sub namespace_uri { "" }

sub extra_namespaces { }

sub attributes { $attributes }

sub is_parent { 1 }

sub namespaces {
    my ($this) = @_;
    $this->{namespaces};
}

sub text {
    my ($this,@args) = @_;
    $this->{text}= $args[0] if(@args);
    return $this->{text};
}


sub child {
    my $this = shift;
    if ( @_ == 1 ) {
        my $child = shift;
        return $this
          if ( $this == $child );    #TODO:warn
        push @{ $this->{_children} }, $child;
        return $this;
    }
    return $this->{_children};
}

sub swap {
    my ( $this, $remove, $new ) = @_;
    my $i = 0;
    foreach my $child ( @{ $this->{_children} } ) {
        if ( $child == $remove ) {
            $this->{_children}->[$i] = $new;
        }
        $i++;
    }
}

sub __set {
    my ( $this, $func, @args ) = @_;
    my $called_func= $func;

    my @attrs = @{ $this->attributes };

    if ( !grep /^$func$/, @attrs ) {
         foreach my $attr (@attrs){
            $func = $attr if($attr=~m/^.+?:$func$/);
         }
    }

    if ( my ( $ns, $tag ) = $func =~ /^(.+?)_(.+)$/ ) {

        my $attr  = $ns . ':' . camelcase($tag);
        if ( grep /^$attr$/, @attrs ) {
            $func = $attr;
        }
    }
    my $camelize=camelcase($func);
    $this->{ $camelize } = @args == 1 ? $args[0] : \@args;

    _install_get_set(ref $this,$called_func,$camelize);

    return $this;
}

sub __get {
    my ( $this, $func ) = @_;
    my $called_func= $func;

    my @attrs = @{ $this->attributes };
    if ( !grep /^$func$/, @attrs ) {
         foreach my $attr (@attrs){
            $func = $attr if($attr=~m/^.+?:$func$/);
         }
    }
    if ( my ( $ns, $tag ) = $func =~ /^(.+?)_(.+)$/ ) {

        my $attr  = $ns . ':' . camelcase($tag);
        if ( grep /$attr/, @attrs ) {
            $func = $attr;
        }
    }
    my $camelize = camelcase($func);

    _install_get_set(ref $this,$called_func,$camelize);

    $this->{ $camelize };

}

private _install_get_set=>sub {
  my ($package,$called_func,$stored_attr)=@_;

 {
        no strict 'refs';
        *{$package.'::'.$called_func}= sub {
            my ($this,@args) = @_;
            local *__ANON__=$called_func;
            if(@args>0){
                $this->{ $stored_attr } = @args == 1 ? $args[0] : \@args;
                return $this;
            }
            $this->{ $stored_attr };
        };
   }

};

sub camelcase {
    my $str = shift;
    $str =~ s/_([a-z])/\U$1/g;
    return $str;
}

"The earth is blue like an orange.";

__END__