typo; settings-tester update
[Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Application / PermaCrud.pm
1 # vim:et:ts=4:sw=4:
2
3 package OpenILS::Application::PermaCrud;
4 use OpenILS::Application;
5 use base qw/OpenILS::Application/;
6
7 use Unicode::Normalize;
8 use OpenSRF::EX qw/:try/;
9
10 use OpenSRF::AppSession;
11 use OpenSRF::Utils::SettingsClient;
12 use OpenSRF::Utils::Logger qw/:level/;
13
14 use OpenILS::Utils::Fieldmapper;
15 use OpenSRF::Utils::JSON;
16
17 use OpenILS::Utils::CStoreEditor qw/:funcs/;
18
19 use XML::LibXML;
20 use XML::LibXML::XPathContext;
21 use XML::LibXSLT;
22
23 our %namespace_map = (
24     oils_persist=> {ns => 'http://open-ils.org/spec/opensrf/IDL/persistence/v1'},
25     oils_obj    => {ns => 'http://open-ils.org/spec/opensrf/IDL/objects/v1'},
26     idl         => {ns => 'http://opensrf.org/spec/IDL/base/v1'},
27     reporter    => {ns => 'http://open-ils.org/spec/opensrf/IDL/reporter/v1'},
28 );
29
30
31 my $log = 'OpenSRF::Utils::Logger';
32
33 my $parser = XML::LibXML->new();
34 my $xslt = XML::LibXSLT->new();
35
36 my $xpc = XML::LibXML::XPathContext->new();
37 $xpc->registerNs($_, $namespace_map{$_}{ns}) for ( keys %namespace_map );
38
39 my $idl;
40
41 sub initialize {
42
43     my $conf = OpenSRF::Utils::SettingsClient->new;
44     my $idl_file = $conf->config_value( 'IDL' );
45
46     $idl = $parser->parse_file( $idl_file );
47
48     $log->debug( 'IDL XML file loaded' );
49 }
50 sub child_init {}
51
52 sub CRUD_action_object_permcheck {
53     my $self = shift;
54     my $client = shift;
55     my $auth = shift;
56     my $obj = shift;
57
58     my $e = new_editor(authtoken => $auth, xact => 1);
59     return $e->event unless $e->checkauth;
60
61     unless ($obj->json_hint eq $self->{class_hint}) {
62         throw OpenSRF::DomainObject::oilsException->new(
63             statusCode => 500,
64             status => "Class missmatch: $self->{class_hint} method called with " . $obj->json_hint,
65         );
66     }
67
68     my ($class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement );
69     my ($action_node) = $xpc->findnodes( "perm:permacrud/perm:actions/perm:$action", $class_node );
70     my $all_perms = $xpc->getAttribute( 'all_perms', $action_node );
71
72     if (!ref($obj)) {
73         my $retrieve_method = 'retrieve_' . $xpc->findvalue( '@oils_obj:fieldmapper', $class_node );
74         $retrieve_method =~ s/::/_/go;
75         $obj = $e->retrieve_method( $obj )->gather(1);
76     }
77
78     my $action = $self->api_name =~ s/^open-ils\.admin\.([^\.])\..+$/$1/o;
79     my $o_type = $obj->cdbi =~ s/::/./go;
80     my $id_field = $obj->Identity;
81
82     my $perm_field_value = $aciton_node->getAttribute('permission');
83
84     if (defined($perm_field_value)) {
85         my @perms = split '|', $aciton_node->getAttribute('permission');
86
87         my @context_ous;
88         if ($aciton_node->getAttribute('global_required')) {
89             push @context_ous, $e->search_actor_org_unit( { parent_ou => undef } )->[0]->id;
90
91         } else {
92             my $context_field_value = $aciton_node->getAttribute('context_field');
93
94             if (defined($context_field_value)) {
95                 push @context_ous, $obj->$_ for ( split '|', $context_field_value );
96             } else {  
97                 for my $context_node ( $xpc->findnodes( "perm:context", $action_node ) ) {
98                     my $context_field = $context_node->getAttribute('field');
99                     my $link_field = $context_node->getAttribute('link');
100
101                     if ($link_field) {
102
103                         my ($link_node) = $xpc->findnodes( "idl:links/idl:link[\@field='$link_field']", $class_node );
104                         my $link_class_hint = $link_node->getAttribute('class');
105                         my $remote_field = $link_node->getAttribute('key');
106
107                         my ($remote_class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement );
108                         my $search_method = 'search_' . $xpc->findvalue( '@oils_obj:fieldmapper', $remote_class_node );
109                         $search_method =~ s/::/_/go;
110
111                         for my $remote_object ( @{$e->$search_method( { $key => $obj->$link_field } )} ) {
112                             push @context_ous, $remote_object->$context_field;
113                         }
114                     } else {
115                         push @context_ous, $obj->$_ for ( split '|', $context_field );
116                     }
117                 }
118             }
119         }
120
121         my $pok = 0;
122         for my $perm (@perms) {
123             if (@context_ous) {
124                 for my $c_ou (@context_ous) {
125                     if ($e->allowed($perm => $c_ou => $obj)) {
126                         $pok++;
127                         last;
128                     }
129                 }
130             } else {
131                 $pok++ if ($e->allowed($perm => undef => $obj));
132             }
133         }
134
135         if ((lc($all_perms) eq 'true' && @perms != $pok) or !$pok) {
136             throw OpenSRF::DomainObject::oilsException->new(
137                 statusCode => 500,
138                 status => "Perm failure -- action: $action, object type: $self->{json_hint}",
139             );
140         }
141     }
142
143     return $obj if ($action eq 'retrieve');
144
145     return $e->session->request("open-ils.cstore.direct.$o_type.$action" => $obj )->gather(1);
146 }
147
148 sub search_permacrud {
149     my $self = shift;
150     my $client = shift;
151     my $auth = shift;
152     my @args = @_;
153
154     my $e = new_editor(authtoken => $auth);
155     return $e->event unless $e->checkauth;
156  
157     my ($class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement );
158     my $search_method = 'search_' . $xpc->findvalue( '@oils_obj:fieldmapper', $remote_class_node );
159     $search_method =~ s/::/_/go;
160
161     my $retriever = $self->method_lookup( $self->{retriever} );
162     my $obj_list = $e->$search_method( @args );
163
164     for my $o ( @$obj_list ) {
165         my ($o) = $retriever->run( $o );
166         $client->respond( $o ) if ($o);
167     }
168
169     return undef;
170 }
171
172 for my $class_node ( $xpc->findnodes( '//idl:class[perm:permacrud]', $class_node ) ) {
173     my $hint = $class_node->getAttribute('id');
174
175     for my $action_node ( $xpc->findnodes( "perm:permacrud/perm:actions/perm:*", $class_node ) ) {
176         my $method = $action_node->localname =~ s/^.+:(.+)$/$1/o;
177
178         __PACKAGE__->register_method(
179             method          => 'CRUD_action_object_permcheck',
180             api_name        => 'open-ils.permacrud.' . $method . '.' . $hint,
181             authoritative   => 1,
182             class_hint      => $hint,
183         );
184
185         if ($method eq 'retrieve') {
186             __PACKAGE__->register_method(
187                 method      => 'search_permcheck',
188                 api_name    => 'open-ils.permacrud.search.' . $hint,
189                 class_hint  => $hint,
190                 retriever   => 'open-ils.permacrud.retrieve.' . $hint,
191                 stream      => 1
192             );
193         }
194     }
195 }
196     
197
198
199 1;
200