[perltidy]
authorHeiko Schlittermann <hs@schlittermann.de>
Fri, 24 Sep 2021 11:04:21 +0200
changeset 12 584ceb504d29
parent 11 7326d2e9b3a7
child 13 4e431e2de91a
[perltidy]
joker.conf.example
lib/Joker.pm
t/10-joker.t
--- 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;