more Moo-like

gbv · Dec 18, 2013 · 1a30281 · 1a30281
1 parent 5112b18
commit 1a30281
Show file tree

Hide file tree

Showing 4 changed files with 73 additions and 58 deletions.
diff --git a/cpanfile b/cpanfile
@@ -1,3 +1,5 @@
+requires 'perl', '5.10.0';
+
 requires 'App::Cmd', '0.322';        # CLI framework
 requires 'URI', '1.59';
 requires 'JSON::PP', '2.27103';      # core module since Perl v5.13.9

diff --git a/dist.ini b/dist.ini
@@ -1,6 +1,6 @@
 name             = App-PAIA
 license          = Perl_5
-version          = 0.23
+version          = 0.24
 copyright_year   = 2013
 author           = Jakob Voß
 copyright_holder = Jakob Voß
@@ -9,7 +9,6 @@ copyright_holder = Jakob Voß
 [OurPkgVersion]
 [PodWeaver]
 [Prereqs::FromCPANfile]
-[MinimumPerl]
 [Test::Perl::Critic]
 
 [PruneFiles]
@@ -18,9 +17,8 @@ filename = paia
 filename = dist.ini
 filename = weaver.ini
 filename = .travis.yml
-filename = paia.json
-filename = .paia_session
-filename = *.bak
+match = ^.*\.json$
+match = ^.*\.bak$
 
 [GithubMeta]
 issues=1

diff --git a/lib/App/PAIA/Command.pm b/lib/App/PAIA/Command.pm
@@ -14,17 +14,41 @@ use URI;
 # Implements lazy accessors just like Mo, Moo, Moose...
 sub has {
     my ($name, %options) = @_;
+    my $coerce  = $options{coerce} || sub { $_[0] };
     my $default = $options{default};
     no strict 'refs'; ## no critic 
     *{__PACKAGE__."::$name"} = sub {
-        @_ > 1 
-            ? $_[0]->{$name} = $_[1]
-            : (!exists $_[0]->{$name} && $default)
-                ? $_[0]->{$name} = $default->($_[0])
-                : $_[0]->{$name}
+        if (@_ > 1) {
+            $_[0]->{$name} = $coerce->($_[1]);
+        } elsif (!exists $_[0]->{$name} && $default) {
+            $_[0]->{$name} = $coerce->($default->($_[0]));
+        } else {
+            $_[0]->{$name}
+        }
     }
 }
 
+sub option { 
+    my ($self, $name) = @_;
+    $self->app->global_options->{$name} # command line 
+        // $self->session->get($name)   # session file
+        // $self->config->get($name);   # config file
+}
+
+sub explicit_option {
+    my ($self, $name) = @_;
+    $self->app->global_options->{$name} # command line
+        // $self->config->get($name);   # config file
+}
+
+sub token { # TODO: make option
+    my ($self) = @_;
+
+    $self->app->global_options->{'token'}
+        // $self->session->get('access_token') 
+        // $self->config->get('access_token');
+}
+
 has config => ( 
     default => sub {
         App::PAIA::File->new(
@@ -71,60 +95,42 @@ has dumper => (
     }
 );
 
-sub option { 
-    my ($self, $name) = @_;
-    $self->app->global_options->{$name} # command line 
-        // $self->session->get($name)   # session file
-        // $self->config->get($name);   # config file
-}
-
-sub explicit_option {
-    my ($self, $name) = @_;
-    $self->app->global_options->{$name} # command line
-        // $self->config->get($name);   # config file
-}
-
-# get auth URL
-sub auth { 
-    my ($self) = @_;
-    $_[0]->option('auth') // ( $self->base ? $self->base . '/auth' : undef );
-}
-
-# get core URL
-sub core {
-    my ($self) = @_;
-    $_[0]->option('core') // ( $self->base ? $self->base . '/core' : undef );
-}
-
-#has_option 'base';
-#has_option 'patron';
-
-# get base URL
-sub base { $_[0]->option('base') }
+has auth => (
+    default => sub {
+        $_[0]->option('auth') // ( $_[0]->base ? $_[0]->base . '/auth' : undef )
+    }
+);
 
-# get patron identifier
-sub patron { 
-    $_[0]->option('patron')
-}
+has core => (
+    default => sub {
+        $_[0]->option('core') // ( $_[0]->base ? $_[0]->base . '/core' : undef )
+    }
+);
 
-# get current scopes
-sub scope { $_[0]->option('scope') }
+has base => (
+    default => sub { $_[0]->option('base') },
+    coerce  => sub { my ($b) = @_; $b =~ s!/$!!; $b; },
+);
 
-sub username {
-    $_[0]->explicit_option('username') // $_[0]->usage_error("missing username");
-}
+has patron => (
+    default => sub { $_[0]->option('patron') },
+);
 
-sub password {
-    $_[0]->explicit_option('password') // $_[0]->usage_error("missing password");
-}
+has scope => (
+    default => sub { $_[0]->option('scope') },
+);
 
-sub token {
-    my ($self) = @_;
+has username => (
+    default => sub {
+        $_[0]->explicit_option('username') // $_[0]->usage_error("missing username")
+    }
+);
 
-    $self->app->global_options->{'token'}
-        // $self->session->get('access_token') 
-        // $self->config->get('access_token');
-}
+has password => (
+    default => sub {
+        $_[0]->explicit_option('password') // $_[0]->usage_error("missing password")
+    }
+);
 
 sub not_authentificated {
     my ($self, $scope) = @_;

diff --git a/t/10-config.t b/t/10-config.t
@@ -49,4 +49,13 @@ is output, '', 'unset config value';
 paia qw(config foo);
 is exit_code, 1, "config value not found";
 
+# override base with command line option
+
+paia qw(login -u alice -p 1234 -b http://example.com/ -v);
+
+is output, <<OUT;
+# loaded config file paia.json
+# POST http://example.com/auth/login
+OUT
+
 done_paia_test;