File Coverage

blib/lib/PlugAuth/Plugin/Test.pm
Criterion Covered Total %
statement 77 77 100.0
branch 5 6 83.3
condition n/a
subroutine 30 30 100.0
pod 0 21 0.0
total 112 134 83.5


line stmt bran cond sub pod time code
1             package PlugAuth::Plugin::Test;
2              
3             # ABSTRACT: Test Plugin server
4             our $VERSION = '0.35'; # VERSION
5              
6 6     6   2494 use strict;
  6         12  
  6         265  
7 6     6   32 use warnings;
  6         9  
  6         210  
8 6     6   1457 use PlugAuth::Plugin::FlatAuth;
  6         15  
  6         246  
9 6     6   1857 use PlugAuth::Plugin::FlatAuthz;
  6         20  
  6         225  
10 6     6   37 use Role::Tiny::With;
  6         9  
  6         436  
11 6     6   35 use Log::Log4perl qw( :easy );
  6         11  
  6         65  
12 6     6   3946 use Fcntl qw( :flock );
  6         13  
  6         6600  
13              
14             with 'PlugAuth::Role::Plugin';
15             with 'PlugAuth::Role::Refresh';
16             with 'PlugAuth::Role::Auth';
17             with 'PlugAuth::Role::Authz';
18              
19             sub init
20             {
21 5     5 0 11 my($self) = @_;
22             $self->app->routes->route('/test/setup/reset')->post(sub {
23            
24 1     1   4765 foreach my $filename (map { $self->global_config->{$_} } qw( group_file resource_file user_file ))
  3         9  
25             {
26 3         111 open my $fh, '+<', $filename;
27 3         8 eval { flock $fh, LOCK_EX };
  3         28  
28 3 50       10 WARN "cannot lock $filename - $@" if $@;
29 3         6 seek $fh, 0, 0;
30 3         103 truncate $fh, 0;
31 3         32 close $fh;
32 3         25 PlugAuth::Role::Flat->mark_changed($filename);
33             }
34            
35 1         4 $self->real_auth->refresh;
36 1         6 $self->real_authz->refresh;
37              
38 1         7 shift->render(text => 'ok');
39 5         20 });
40             $self->app->routes->route('/test/setup/basic')->post(sub {
41 2     2   11765 my $auth = $self->real_auth;
42 2         13 $auth->create_user('primus', 'spark');
43 2         12 $auth->create_user('optimus', 'matrix');
44 2         24 $auth->refresh;
45            
46 2         10 my $authz = $self->real_authz;
47 2         15 $authz->create_group('admin', 'primus');
48 2         9 $authz->refresh;
49 2         13 $authz->grant('admin', 'accounts', '/');
50 2         9 $authz->grant('primus', 'accounts', '/');
51            
52 2         29 shift->render(text => 'ok');
53 5         1845 });
54             }
55              
56             sub refresh
57             {
58 33     33 0 55 my($self) = @_;
59 33         94 $self->real_auth->refresh;
60 33         126 $self->real_authz->refresh;
61 33         111 1;
62             }
63              
64 11     11 0 33 sub check_credentials { shift->real_auth->check_credentials(@_) }
65 2     2 0 8 sub create_user { shift->real_auth->create_user(@_) }
66 1     1 0 3 sub change_password { shift->real_auth->change_password(@_) }
67 1     1 0 4 sub delete_user { shift->real_auth->delete_user(@_) }
68             sub all_users { shift->real_auth->all_users }
69 35     35 0 75 sub can_user_action_resource { shift->real_authz->can_user_action_resource(@_) }
70              
71 1     1 0 4 sub match_resources { shift->real_authz->match_resources(@_) }
72 1     1 0 19 sub host_has_tag { shift->real_authz->host_has_tag(@_) }
73 3     3 0 10 sub actions { shift->real_authz->actions(@_) }
74 13     13 0 24 sub groups_for_user { shift->real_authz->groups_for_user(@_) }
75 4     4 0 9 sub all_groups { shift->real_authz->all_groups(@_) }
76 6     6 0 25 sub users_in_group { shift->real_authz->users_in_group(@_) }
77              
78 3     3 0 10 sub create_group { shift->real_authz->create_group(@_) }
79 1     1 0 3 sub delete_group { shift->real_authz->delete_group(@_) }
80 4     4 0 11 sub grant { shift->real_authz->grant(@_) }
81 3     3 0 8 sub revoke { shift->real_authz->revoke(@_) }
82 2     2 0 9 sub granted { shift->real_authz->granted(@_) }
83 1     1 0 3 sub update_group { shift->real_authz->update_group(@_) }
84              
85             sub real_auth
86             {
87 69     69 0 89 my($self) = @_;
88            
89 69 100       203 unless($self->{real_auth})
90             {
91 4         30 my $auth = $self->{real_auth} = new PlugAuth::Plugin::FlatAuth(
92             Clustericious::Config->new({}),
93             Clustericious::Config->new({}),
94             $self->app
95             );
96             }
97            
98 69         562 return $self->{real_auth};
99             }
100              
101             sub real_authz
102             {
103 113     113 0 142 my($self) = @_;
104            
105 113 100       285 unless($self->{real_authz})
106             {
107 4         11 my $auth = $self->real_auth;
108 4         22 my $authz = $self->{real_authz} = new PlugAuth::Plugin::FlatAuthz(
109             Clustericious::Config->new({}),
110             Clustericious::Config->new({}),
111             $self->app
112             );
113             }
114            
115 113         455 return $self->{real_authz};
116             }
117              
118             1;
119              
120             __END__
121              
122             =pod
123              
124             =encoding UTF-8
125              
126             =head1 NAME
127              
128             PlugAuth::Plugin::Test - Test Plugin server
129              
130             =head1 VERSION
131              
132             version 0.35
133              
134             =head1 AUTHOR
135              
136             Graham Ollis <gollis@sesda3.com>
137              
138             =head1 COPYRIGHT AND LICENSE
139              
140             This software is copyright (c) 2012 by NASA GSFC.
141              
142             This is free software; you can redistribute it and/or modify it under
143             the same terms as the Perl 5 programming language system itself.
144              
145             =cut