--- a/joker.conf.example Wed Dec 24 21:47:20 2014 +0100
+++ b/joker.conf.example Fri Sep 24 11:04:21 2021 +0200
@@ -1,6 +1,8 @@
#! perl
(
# the joker account credentials
+ # 'ote' is the test api, remote ote for the real api
+ uri => 'https://dmapi.ote.joker.com/request/',
username => '…',
password => '…',
);
--- a/lib/Joker.pm Wed Dec 24 21:47:20 2014 +0100
+++ b/lib/Joker.pm Fri Sep 24 11:04:21 2021 +0200
@@ -5,51 +5,82 @@
use MooseX::SemiAffordanceAccessor;
use LWP::UserAgent;
use Joker::Result;
+use if $ENV{DEBUG} => 'Smart::Comments';
has [qw(username password)] => (
- isa => 'Str',
- is => 'ro',
+ isa => 'Str',
+ is => 'ro',
required => 1
);
has uri => (
- isa => 'Str',
- is => 'ro',
- default => 'https://dmapi.joker.com/request/',
+ isa => 'Str',
+ is => 'ro',
+ default => 'https://dmapi.ote.joker.com/request/', # default test api
+ initializer => sub { # append the trailing slash if missing
+ my ($self, $value, $writer) = @_;
+ return if $value =~ m{/$};
+ $writer->("$value/");
+ },
+);
+
+has id_file => (
+ isa => 'Str',
+ is => 'ro',
+ default => $ENV{JOKER_ID_FILE} // "$ENV{HOME}/.joker-auth-id",
);
has ua => (
- isa => 'LWP::UserAgent',
- is => 'ro',
- default => sub { LWP::UserAgent->new },
+ isa => 'LWP::UserAgent',
+ is => 'ro',
+ init_arg => undef,
+ default => sub { LWP::UserAgent->new },
);
-has auth_id => (
- isa => 'Str',
- is => 'ro',
- lazy => 1,
- builder => 'login',
+has _auth_id => (
+ isa => 'Str',
+ is => 'ro',
+ init_arg => undef,
+ lazy => 1,
+ builder => '_build_auth_id',
);
+has last_response => (
+ is => 'ro',
+ isa => 'Joker::Response',
+ init_arg => undef,
+ writer => '_set_last_response',
+);
+
+sub _init_uri {
+ die "@_";
+}
+
sub request {
my ($self, $type) = (shift, shift);
my %parm = (
- 'Auth-Sid', $self->auth_id,
- @_,
+ 'Auth-Sid' => $self->_auth_id,
+ @_,
);
my $req = HTTP::Request->new(
- GET => $self->uri . "$type?" . join '&', map { "$_=$parm{$_}" } keys %parm);
+ GET => $self->uri . "$type?" . join '&',
+ map { "$_=$parm{$_}" } keys %parm
+ );
my $result = $self->ua->request($req);
+ ### $result
croak $result->status_line if not $result->is_success;
return Joker::Result->new(response => $result->content);
}
-sub login {
+sub _login {
my $self = shift;
- my $req = HTTP::Request->new(
- GET => $self->uri . 'login?'
- . 'username=' . $self->username . '&'
- . 'password=' . $self->password);
+ my $req =
+ HTTP::Request->new(GET => $self->uri
+ . 'login?'
+ . 'username='
+ . $self->username . '&'
+ . 'password='
+ . $self->password);
my $result = $self->ua->request($req);
croak $result->status_line if not $result->is_success;
@@ -58,4 +89,68 @@
croak q{Can't get Auth-Sid};
}
+sub _build_auth_id {
+ my $self = shift;
+ open(my $f, '<', "$ENV{HOME}/.joker.auth-id") or return '';
+ chomp(my $_ = <$f>);
+ return $_ // '';
+}
+
__PACKAGE__->meta->make_immutable;
+
+__END__
+
+=head1 NAME
+
+Joker - simple OO interface to the Joker domain registry
+
+=head1 SYNOPSIS
+
+ use Joker;
+
+=head1 DESCRIPTION
+
+=head1 CONSTRUCTOR
+
+The B<new> method serves as a constructor. It requires a hash with the
+following attributes:
+
+=over
+
+=item B<username> = I<username>
+
+The username, that is your Joker.com account.
+
+=item B<password> = I<password>
+
+The password for the account above.
+
+=back
+
+Optional attributes are:
+
+=over
+
+=item B<ur> = I<uri of the DMAP server>
+
+The URI where the requests are sent to. (default:
+https://dmapi.ote.joker.com/) For production use remove the "ote" from
+the URI.
+
+=item B<id_file> = I<id file>
+
+The temporary store for the joker auth-id. The first login returns a
+joker auth-id (cookie). This cookie may be reused on further requests
+until it expires. (default: C<$ENV{JOKER_AUTH_ID_FILE}> //
+C<$ENV{HOME}/.joker-auth-id>)
+
+=back
+
+=head1 METHODS
+
+=head2 B<request>(I<request>, I<request params>)
+
+Send a request to the DMAPI. Returns a L<Joker::Result> object. Please
+refer to the L<DMAPI specs|https://dmapi.joker.com/docs/DMAPI-ext.txt>.
+
+=cut
--- a/t/10-joker.t Wed Dec 24 21:47:20 2014 +0100
+++ b/t/10-joker.t Fri Sep 24 11:04:21 2021 +0200
@@ -1,5 +1,31 @@
use Test::More;
+use Data::Dumper;
+use File::Temp;
+
+my $tmp = File::Temp->new;
+
use_ok 'Joker::Result' or BAIL_OUT 'sorry';
-use_ok 'Joker' or BAIL_OUT 'sorry';
+use_ok 'Joker' or BAIL_OUT 'sorry';
+can_ok 'Joker', qw(request);
+ok -f 'joker.conf' or BAIL_OUT 'joker.conf not found';
+
+ok my %conf = do 'joker.conf' or BAIL_OUT 'config not valid';
+
+subtest 'defaults' => sub {
+ isa_ok my $joker = Joker->new(username => 'foo', password => 'bar'),
+ 'Joker';
+ is $joker->username, 'foo' => 'username';
+ is $joker->password, 'bar' => 'password';
+ is $joker->id_file,
+ "$ENV{HOME}/.joker-auth-id" => 'default place of the auth id';
+ is $joker->uri, 'https://dmapi.ote.joker.com/request/' => 'default uri';
+};
+
+# now with a real config
+subtest 'real config' => sub {
+ plan skip_all => 'no config' if not -f 'joker.conf';
+ isa_ok my $joker = Joker->new(%conf, id_file => "$tmp"), 'Joker';
+ is $joker->id_file, "$tmp", 'id file';
+};
done_testing;