implemented 'change' and cleanup

.gitignore

@@ -1,5 +1,5 @@
 *.bak
-.paia_session
+paia-session.json
 paia.json
 .build
 App-PAIA-*

Changes

@@ -1,11 +1,13 @@
 Revision history for Perl module App::PAIA
 
-0.12    2013-10-31
+0.20    2013-10-31
 
-    * support Perl >= 5.10
     * better support --version and --help
     * new command 'config'
+    * implement PAIA method 'change'
     * changed session file from .paia_session to paia-session.json
+    * support Perl >= 5.10
+    * facilitate writing unit tests
 
 0.11    2013-10-23
 

bin/paia

@@ -65,7 +65,7 @@ Invalidate an access token. An existing session file is deleted.
 
 =item B<change> (<http://gbv.github.io/paia/paia.html#change>)
 
-Change login password (not implemented yet).
+Change login password.
 
 =back
 

cpanfile

@@ -1,6 +1,6 @@
-requires 'App::Cmd', '0.322';       # CLI framework
-requires 'JSON::PP', '2.27103';     # core module since Perl v5.13.9
-requires 'HTTP::Tiny', '0.024';     # core module since Perl v5.17.7
-requires 'IO::Socket::SSL', '1.56'; # for HTTPS
-requires 'Net::SSLeay', '1.49';     # for HTTPS
+requires 'App::Cmd', '0.322';        # CLI framework
+requires 'JSON::PP', '2.27103';      # core module since Perl v5.13.9
+requires 'HTTP::Tiny', '0.024';      # core module since Perl v5.17.7
+requires 'IO::Socket::SSL', '1.56';  # for HTTPS
+requires 'Net::SSLeay', '1.49';      # for HTTPS
 # requires 'Mozilla::CA';             # see https://metacpan.org/module/HTTP::Tiny#SSL-SUPPORT

lib/App/PAIA/Agent.pm

@@ -11,16 +11,17 @@ use App::PAIA::JSON;
 sub new {
     my ($class, %options) = @_;
     bless {
-        agent   => HTTP::Tiny->new( verify_SSL => (!$options{insecure}) ),
-        verbose => !!$options{verbose},
-        quiet   => !!$options{quiet},
+        agent    => HTTP::Tiny->new( verify_SSL => (!$options{insecure}) ),
+        verbose  => !!$options{verbose},
+        quiet    => !!$options{quiet},
+        insecure => !!$options{insecure},
     }, $class;
 }
 
 sub request {
     my $self    = shift;
     my $method  = shift;
-    my $url     = URI->new(shift);
+    my $url     = URI->new(shift) // '';
     my $param   = shift // {};
     my $headers = { 
         Accept => 'application/json',
@@ -30,6 +31,16 @@ sub request {
 
     say "# $method $url" unless $self->{quiet};
 
+    my $scheme = $url->scheme // '';
+    if ($self->{insecure}) {
+        return $self->error( msg => "Not an URL: $url" )
+            unless $scheme =~ /^https?$/;
+    } elsif( $scheme ne 'https' ) {
+        return $self->error( 
+            msg => "PAIA requires HTTPS unless insecure (got $url)"
+        );
+    }
+
     if ($method eq 'POST') {
         $headers->{'Content-Type'} = 'application/json';
         $content = encode_json($param);
@@ -48,23 +59,26 @@ sub request {
     return $response if $response->{status} eq '599';
 
     my $json = eval { decode_json($response->{content}) };
-    if (my $e = "$@") {
-        return {
-            url => "$url",
-            success => q{},
-            status  => 599,
-            reason  => 'Internal Exception',
-            content => $e,
-            headers => {
-                'content-type'   => 'text/plain',
-                'content-length' => length $e,
-            }
-        };
-    }
+    return $self->error( url => "$url", msg => "$@" ) if "$@";
 
     return ($response, $json);
 }
 
+sub error {
+    my ($self, %opts) = @_;
+    return {        
+        url     => $opts{url} // '',
+        success => q{},
+        status  => $opts{status} // '599',
+        reason  => 'Internal Exception',
+        content => $opts{msg},
+        headers => {
+            'content-type'   => 'text/plain',
+            'content-length' => length $opts{msg},
+        }
+    };
+}
+
 sub show_request {
     my ($self, $method, $url, $headers, $content) = @_;
     return unless $self->{verbose};

lib/App/PAIA/Command.pm

@@ -124,9 +124,8 @@ sub request {
     my ($response, $json) = $self->agent->request( $method, $url, $param, %headers );
 
     if ($response->{status} ne '200') {
-        die "HTTP request failed with response code ".$response->{status}.":\n".
-            $response->{content}.
-            "\n";
+        my $msg = $response->{content} // 'HTTP request failed: '.$response->{status};
+        die "$msg\n";
     }
 
     # TODO: more error handling
@@ -180,20 +179,28 @@ our %required_scopes = (
     change  => 'change_password',
 );
 
-sub core_request {
-    my ($self, $method, $command, $params) = @_;
+sub auto_login_for {
+    my ($self, $command) = @_;
 
-    my $core  = $self->core // $self->usage_error("missing PAIA core server URL");
     my $scope = $required_scopes{$command};
 
     if ($self->not_authentificated( $scope )) {
-        $self->log("auto-login with scope $scope");
-        $self->login( $scope );
+        # add to existing scopes (TODO: only if wanted)
+        my $new_scope = join ' ', split(' ',$self->scope // ''), $scope;
+        $self->log("auto-login with scope '$new_scope'");
+        $self->login( $new_scope );
         if ( $self->scope and !$self->has_scope($scope) ) {
-            say "current scope does not include $scope!";
-            exit 1;
+            die "current scope does not include $scope!\n";
         }
     }
+}
+
+sub core_request {
+    my ($self, $method, $command, $params) = @_;
+
+    my $core  = $self->core // $self->usage_error("missing PAIA core server URL");
+
+    $self->auto_login_for($command);
 
     my $patron = $self->patron // $self->usage_error("missing patron identifier");
 

lib/App/PAIA/Command/change.pm

@@ -5,9 +5,44 @@ use v5.10;
 use parent 'App::PAIA::Command';
 #VERSION
 
-sub execute {
+sub _execute {
     my ($self, $opt, $args) = @_;
-    die "Not implemented yet!\n";
+
+    my $auth = $self->auth // $self->usage_error("missing PAIA auth URL");
+
+    # take credentials from command line or config file only
+    my %params = (
+        patron => $self->patron,
+        username =>
+            ($self->explicit_option('username') // $self->usage_error("missing username")),
+        old_password => 
+            ($self->explicit_option('password') // $self->usage_error("missing password")),
+    );
+
+    $self->auto_login_for('change');
+
+    # Password should not be given as command line option, but as input
+    # TODO: better way to get a new password, without echoing
+    # e.g. use Term::ReadKey (ReadMode('noecho')) or TermTerm::ReadPassword
+    #  See also App::Cmd::Plugin::Prompt or Term::ReadPassword
+    {
+        print "new password: ";
+        chomp(my $pwd = scalar <STDIN>);
+        if (length($pwd) < 4) {
+            say "your password is too short!";
+            redo;
+        } else {
+            print "please repeat: ";
+            chomp(my $pwd2 = scalar <STDIN>);
+            if ($pwd2 ne $pwd) {
+                say "passwords don't match!"; 
+                redo;
+            }
+        }
+        $params{new_password} = $pwd;
+    }
+
+    $self->request( "POST", "$auth/change", \%params ); 
 }
 
 1;

lib/App/PAIA/Command/logout.pm

@@ -7,7 +7,7 @@ use parent 'App::PAIA::Command';
 
 use App::PAIA::JSON;
 
-sub execute {
+sub _execute {
     my ($self, $opt, $args) = @_;
 
     my $auth = $self->auth // $self->usage_error("missing PAIA auth URL");

lib/App/PAIA/Command/session.pm

@@ -19,7 +19,8 @@ sub _execute {
     my ($self, $opt, $args) = @_;
 
     if (defined $self->session->file ) {
-        say encode_json($self->session) if $self->verbose;
+        my $data = $self->session->load;
+        say encode_json($data) if $self->verbose;
         my $msg = $self->not_authentificated;
         die "$msg.\n" if $msg;
         say "session looks fine.";

lib/App/PAIA/Tester.pm

@@ -0,0 +1,80 @@
+#ABSTRACT: Facilitate PAIA client unit tests
+package App::PAIA::Tester;
+use strict;
+use v5.10;
+#VERSION
+
+use parent 'Exporter';
+our @cmd = qw(stdout stderr output error exit_code);
+our @EXPORT = (qw(new_paia_test done_paia_test paia stdout_json debug), @cmd);
+
+use Test::More;
+use App::Cmd::Tester;
+use JSON::PP;
+use File::Temp qw(tempdir);
+use Cwd;
+use App::PAIA;
+
+our $CWD = getcwd();
+our $RESULT;
+
+eval "sub $_ { \$RESULT->$_ }" for @cmd; ## no critic
+
+sub stdout_json {
+    decode_json($RESULT->stdout);
+}
+
+sub new_paia_test {
+    chdir tempdir();
+}
+
+sub paia(@) { ## no critic
+    $RESULT = test_app('App::PAIA' => [@_]);
+}
+
+sub done_paia_test {
+    chdir $CWD;
+    done_testing;
+}
+
+sub debug {
+    say "# $_" for split "\n", join "\n", (
+        "stdout: ".$RESULT->stdout,
+        "stderr: ".$RESULT->stderr,
+        "error: ".$RESULT->error // 'undef',
+        "exit_code: ".$RESULT->exit_code
+    );
+}
+
+=head1 SYNOPSIS
+
+    use Test::More;
+    use App::PAIA::Tester;
+
+    new_paia_test;
+
+    paia qw(config base http://example.org/);
+    is error, undef;
+
+    paia qw(config);
+    is_deeply stdout_json, {
+        base => 'http://example.org/'
+    };
+
+    paia qw(login -u alice -p 1234);
+    is stderr, '';
+    is exit_code, 0;
+
+    my $token = stdout_json->{access_token};
+    ok $token;
+
+    done_paia_test;
+
+=head1 DESCRIPTION
+
+The module implements a simple a singleton wrapper around L<App::Cmd::Tester>
+to facilitate writing unit tests for the paia client L<App::PAIA>. 
+
+=cut
+
+1;