« 01.11 SOAP::Liteめぇ | ココ | 01.13 初めての岡崎 »

2008年1月12日

続・SOAP::Liteめぇ  このエントリーを含むはてなブックマーク 

昨日の問題は解決したっぽい。
ヒントは、KEGG APIの解説ページにあった下のコード。

# sub routines implicitly used in the above code

sub SOAP::Serializer::as_ArrayOfstring{
    my ($self, $value, $name, $type, $attr) = @_;
    return [$name, {'xsi:type' => 'array', %$attr}, $value];
}

sub SOAP::Serializer::as_ArrayOfint{
    my ($self, $value, $name, $type, $attr) = @_;
    return [$name, {'xsi:type' => 'array', %$attr}, $value];
}


C#みたいに名前空間指定して拡張する手が使えたんか、ということに気がついたので、

sub SOAP::Lite::service2 {
    my $self = shift->new;
    return $self->{'_service'} unless @_;
    $self->schema->schema_url($self->{'_service'} = shift);
    my %services = %{$self->schema->parse(@_)->load2->services};

    Carp::croak "More than one service in service description. Service and port names have to be specified\n"
        if keys %services > 1;
    my $service = (keys %services)[0]->new;
    return $service;
}

sub SOAP::Schema::load2 {
    my $self = shift->new;
    local $^W; # supress warnings about redefining
    foreach (keys %{$self->services || Carp::croak 'Nothing to load. Schema is not specified'}) {
        # TODO - check age of cached file, and delete if older than configured amount
        if ($self->cache_dir) {
            my $cached_file = File::Spec->catfile($self->cache_dir,$_.".pm");
            my $ttl = $self->cache_ttl || $SOAP::Constants::DEFAULT_CACHE_TTL;
            open (CACHE, "<$cached_file");
            my @stat = stat($cached_file) unless eof(CACHE);
            close CACHE;
            if (@stat) {
                # Cache exists
                my $cache_lived = time() - $stat[9];
                if ($ttl > 0 && $cache_lived > $ttl) {
                    $self->refresh_cache($cached_file,$self->generate_stub($_));
                }
            } else {
                # Cache doesn't exist
                $self->refresh_cache($cached_file,$self->generate_stub($_));
            }
            push @INC,$self->cache_dir;
            eval "require $_" or Carp::croak "Could not load cached file: $@";
        } else {
            my $stub_pkg = $self->generate_stub($_);
            ($stub_pkg) = ($stub_pkg =~ /^(.*)$/ism);
            eval $stub_pkg or Carp::croak "Bad stub: $@";
            # eval $self->generate_stub($_) or Carp::croak "Bad stub: $@";

        }
    }
    $self;
}

これで解決、serviceの代わりにservice2を呼び出せばOK。派生させてオーバーライドかなぁとか思ってたけどクラスが複数やから嫌やったんよ。

By ただ at 23:23 カテゴリー ; mein Erbe , 仕事関係

« 01.11 SOAP::Liteめぇ | 01月の記事 | 01.13 初めての岡崎 »




トラックバック

このエントリーのトラックバックURL:
http://pinmarch.sakura.ne.jp/mt/mt-tb.cgi/1179