package Games::Lacuna::Client::Module; { $Games::Lacuna::Client::Module::VERSION = '0.003'; } use 5.0080000; use strict; use warnings; use Carp 'croak'; use Class::XSAccessor { getters => [qw(client uri)], }; require Games::Lacuna::Client; sub api_methods_without_session { croak("unimplemented"); } sub api_methods_with_session { croak("unimplemented"); } sub module_prefix { my $self = shift; my $class = ref($self)||$self; $class =~ /::(\w+)+$/ or croak("unimplemented"); return lc($1); } sub session_id { my $self = shift; return $self->client->assert_session(); } sub new { my $class = shift; my %opt = @_; my $client = $opt{client} || croak("Need Games::Lacuna::Client"); my $self = bless { %opt, } => $class; $self->{uri} = $self->client->uri . '/' . $self->module_prefix; return $self; } sub init { my $class = shift; $class->_generate_api_methods($class->api_methods); } sub _generate_api_methods { my $class = shift; my $method_specs = shift || croak("Missing method specs"); foreach my $method_name (keys %$method_specs) { my $target = $class->_find_target_name($method_name); my $spec = $method_specs->{$method_name}; $class->_generate_method_per_spec($target, $method_name, $spec); } } sub _generate_method_per_spec { my $class = shift; my $target = shift; my $method_name = shift; my $spec = shift; my $default_args = $spec->{default_args}; my $sub = sub { my $self = shift; my $client = $self->client; # prepend the default parameters to the arguments my $params = [ (map $self->$_(), @$default_args), @_ ]; if ($client->debug) { print STDERR "DEBUG: " . __PACKAGE__ . " request " . Data::Dumper::Dumper([$self->uri, $method_name, $params]); } my $ret = $client->rpc->call($self->uri, $method_name, $params); if ($client->debug) { print STDERR "DEBUG: " . __PACKAGE__ . " result " . Data::Dumper::Dumper($ret); } if (ref $ret eq 'HASH' and exists $ret->{result} and ref $ret->{result} eq 'HASH') { $self->client->{rpc_count} = $ret->{result}{status} ? $ret->{result}{status}{empire}{rpc_count} : $ret->{result}{empire} ? $ret->{result}{empire}{rpc_count} : $self->client->{rpc_count}; } return $ret->{result}; }; no strict 'refs'; *{"$target"} = $sub; } sub _find_target_name { my $class = shift; my $method_name = shift; no strict 'refs'; my $target = "${class}::$method_name"; if (defined &{"$target"}) { $target = "${class}::_$method_name"; } return $target; } 1; __END__ =head1 NAME Games::Lacuna::Client::Empire - The empire module =head1 SYNOPSIS use Games::Lacuna::Client; =head1 DESCRIPTION =head1 AUTHOR Steffen Mueller, Esmueller@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2010 by Steffen Mueller This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.0 or, at your option, any later version of Perl 5 you may have available. =cut