view release on metacpan or  search on metacpan

lib/Yahoo/Marketing/Service.pm  view on Meta::CPAN

        my $element_type = $1;
        return [ map { $self->_deserialize( $method, $_, $element_type ) } ( ref $hash eq 'ARRAY' ? @{ $hash } : values %$hash ) ];
    }elsif( $type !~ /^xsd:|^[Ss]tring$|^[Ii]nt$|^[Ll]ong$|^[Dd]ouble|^Continent$/ 
        and ! grep { $type =~ /^(tns:)?$_$/ } $self->simple_type_exceptions ){

        $type =~ s/^tns://;

        # pull it in
	my $pkg = $self->_class_name;
        my $class = ($pkg).ucfirst( $type );
        eval "require $class";

        die "whoops, couldn't load $class: $@" if $@;

        $obj = $class->new;
    }elsif( ref $hash ne 'HASH' ){
        return $hash;
    }else{  # this should never be reached
        confess "Please send this stack trace to the module author.\ntype = $type, hash = $hash";
    }

    foreach my $key ( keys %$hash ){
        if( not ref $hash->{ $key } ){
            $obj->$key( $hash->{ $key } );
        }elsif( ref $hash->{ $key } eq 'ARRAY' ){ # better have an array arguement mapping
                my $type = $self->_complex_type( $type, $key );

                return [ map { $self->_deserialize( $method, $_, $type ) } @{ $hash->{ $key } } ];
        }elsif( ref $hash->{ $key } eq 'HASH' ){
            my $type = $self->_complex_types( $type, $key );

            # special case for array types returning as just a hash with a single element.  Annoying.
            if( $type =~ /^ArrayOf/ ){
                $type = $self->_complex_types( $method, $type );
                $obj->$key( [ $self->_deserialize( $method, $hash->{ $key }->{ (keys %{ $hash->{ $key } })[0] }, $type ) ] );
                next;
            }
                
            $obj->$key( $self->_deserialize( $method, $hash->{ $key }, $type ) ); 
        }else{
            warn "can't handle $key in response yet ( $hash->{ $key } )\n";
        }
    }

    push @return_values, $obj;

    return wantarray
            ? @return_values
            : $return_values[0]
    ;
}


sub _headers {
    my ( $self, %args ) = @_;

    confess "must set username and password"
        unless defined $self->username and defined $self->password;

    return ( $self->_login_headers,
             SOAP::Header->name('license')
                         ->value( $self->license )
                         ->uri( $self->uri )
                         ->prefix('')
             ,
             ( $self->_add_master_account_to_header and not $args{ no_master_account } )
               ? SOAP::Header->name('masterAccountID')
                         ->type('string')
                         ->value( $self->master_account )
                         ->uri( $self->uri )
                         ->prefix('')
               : ()
             ,
             ( $self->_add_account_to_header and not $args{ no_account } )
               ? SOAP::Header->name('accountID')
                             ->type('string')
                             ->value( $self->account )
                             ->uri( $self->uri )
                             ->prefix('')
               : ()
             ,
             $self->on_behalf_of_username
               ? SOAP::Header->name('onBehalfOfUsername')
                             ->type('string')
                             ->value( $self->on_behalf_of_username )
                             ->uri( $self->uri )
                             ->prefix('')
               : ()
             ,
             $self->on_behalf_of_password
               ? SOAP::Header->name('onBehalfOfPassword')
                             ->type('string')
                             ->value( $self->on_behalf_of_password )
                             ->uri( $self->uri )
                             ->prefix('')
               : ()
             ,
    );
}

sub _add_account_to_header { return 0; }  # default to false

sub _add_master_account_to_header { return 1; }  # default to true


sub _login_headers {
    my ( $self ) = @_;
    return $self->use_wsse_security_headers
           ? ( SOAP::Header->name( 'Security' )
                           ->value(
                  \SOAP::Header->name( 'UsernameToken' )
                               ->value( [ SOAP::Header->name('Username')
                                                      ->value( $self->username )
                                                      ->prefix('wsse')
                                          ,
                                          SOAP::Header->name('Password')
                                                      ->value( $self->password )
                                                      ->prefix('wsse')
                                          ,
                                        ]
                               )
                               ->prefix( 'wsse' )
                           )
                           ->prefix( 'wsse' )
                           ->uri( 'http://schemas.xmlsoap.org/ws/2002/04/secext' )
               ,
             )
           : (
               SOAP::Header->name('username')
                           ->value( $self->username )
                           ->uri( $self->uri )
                           ->prefix('')
               ,
               SOAP::Header->name('password')
                           ->value( $self->password )
                           ->uri( $self->uri )
                           ->prefix('')
               ,
             );
}

sub clear_cache {
    my $self = shift;
    $self->cache->clear;
    delete $service_data->{ $self->_wsdl } 
        if $service_data and $self->_wsdl_components_are_defined;
    return $self;
}

sub purge_cache {
    my $self = shift;
    $self->cache->purge;
    delete $service_data->{ $self->_wsdl } 
        if $service_data and $self->_wsdl_components_are_defined;
    return $self;
}

sub _parse_wsdl {
    my ( $self, ) = @_;

    if( my $wsdl_data = $self->cache->get( $self->_wsdl ) ){
        $service_data->{ $self->_wsdl } = $wsdl_data;
        return;
    }

    my $xpath = XML::XPath->new( 
                    xml => SOAP::Schema->new(schema_url => $self->_wsdl )->access 
                );

    foreach my $node ( $xpath->find( q{/wsdl:definitions/wsdl:types/xsd:schema/* } )->get_nodelist ){
        my $name = $node->getName;
        if( $name eq 'xsd:complexType' ){
            $self->_parse_complex_type( $node, $xpath );
        }elsif( $node->getAttribute('name') and ($node->getAttribute('name') =~ /Response(Type)?$/) ){
            $self->_parse_response_type( $node, $xpath );
        }else{
            $self->_parse_request_type( $node, $xpath );
        }
    }

    $self->cache->set( $self->_wsdl, $service_data->{ $self->_wsdl }, $self->cache_expire_time );
    return;
}

sub _parse_request_type {
    my ( $self, $node, $xpath ) = @_;
    my $type_name = $node->getAttribute( 'name' );

    return unless $type_name;

    my $def = $xpath->find( qq{/wsdl:definitions/wsdl:types/xsd:schema/xsd:element[\@name='$type_name']/xsd:complexType/xsd:sequence/xsd:element} );

    return unless $def;