d8571d306aa975645c9423c4df31de244574f04e
[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     perm        => {ns => 'http://open-ils.org/spec/opensrf/IDL/permacrud/v1'},
29 );
30
31
32 my $log = 'OpenSRF::Utils::Logger';
33
34 my $parser = XML::LibXML->new();
35 my $xslt = XML::LibXSLT->new();
36
37 my $xpc = XML::LibXML::XPathContext->new();
38 $xpc->registerNs($_, $namespace_map{$_}{ns}) for ( keys %namespace_map );
39
40 my $idl;
41
42 sub initialize {
43
44     my $conf = OpenSRF::Utils::SettingsClient->new;
45     my $idl_file = $conf->config_value( 'IDL' );
46
47     $idl = $parser->parse_file( $idl_file );
48
49     $log->debug( 'IDL XML file loaded' );
50
51     generate_methods();
52
53 }
54 sub child_init {}
55
56 sub CRUD_action_object_permcheck {
57     my $self = shift;
58     my $client = shift;
59     my $auth = shift;
60     my $obj = shift;
61
62     my $e = new_editor(authtoken => $auth, xact => 1);
63     return $e->event unless $e->checkauth;
64
65     if (ref($obj) && $obj->json_hint ne $self->{class_hint}) {
66         throw OpenSRF::DomainObject::oilsException->new(
67             statusCode => 500,
68             status => "Class missmatch: $self->{class_hint} method called with " . $obj->json_hint,
69         );
70     }
71
72     my $class_node;
73     try {
74         ($class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement );
75     } catch Error with {
76         my $error = shift;
77         $log->error("Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]");
78         throw OpenSRF::DomainObject::oilsException->new(
79             statusCode => 500,
80             status => "Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]"
81         );
82     };
83
84     if (!$class_node) {
85         $log->error("Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]");
86         throw OpenSRF::DomainObject::oilsException->new(
87             statusCode => 500,
88             status => "Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]"
89         );
90     }
91
92     my $action_node;
93     try {
94         ($action_node) = $xpc->findnodes( "perm:permacrud/perm:actions/perm:$self->{action}", $class_node );
95     } catch Error with {
96         my $error = shift;
97         $log->error("Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]");
98         throw OpenSRF::DomainObject::oilsException->new(
99             statusCode => 500,
100             status => "Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]"
101         );
102     };
103
104     if (!$action_node) {
105         $log->error("Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]");
106         throw OpenSRF::DomainObject::oilsException->new(
107             statusCode => 500,
108             status => "Error finding action node: $error [perm:permacrud/perm:actions/perm:$self->{action}]"
109         );
110     }
111
112     my $all_perms = $action_node->getAttribute( 'all_perms' );
113
114     my $fm_class = $xpc->findvalue( '@oils_obj:fieldmapper', $class_node );
115     if (!ref($obj)) {
116         my $retrieve_method = 'retrieve_' . $fm_class;
117         $retrieve_method =~ s/::/_/go;
118         $obj = $e->$retrieve_method( $obj );
119     }
120
121     (my $o_type = $fm_class) =~ s/::/./go;
122
123     my $perm_field_value = $action_node->getAttribute('permission');
124
125     if ($perm_field_value) {
126         my @perms = split '\|', $action_node->getAttribute('permission');
127
128         my @context_ous;
129         if ($action_node->getAttribute('global_required')) {
130             push @context_ous, $e->search_actor_org_unit( { parent_ou => undef } )->[0]->id;
131
132         } else {
133             my $context_field_value = $action_node->getAttribute('context_field');
134
135             if ($context_field_value) {
136                 push @context_ous, $obj->$_ for ( split '\|', $context_field_value );
137             } else {  
138                 for my $context_node ( $xpc->findnodes( "perm:context", $action_node ) ) {
139                     my $context_field = $context_node->getAttribute('field');
140                     my $link_field = $context_node->getAttribute('link');
141
142                     if ($link_field) {
143
144                         my ($link_node) = $xpc->findnodes( "idl:links/idl:link[\@field='$link_field']", $class_node );
145                         my $link_class_hint = $link_node->getAttribute('class');
146                         my $remote_field = $link_node->getAttribute('key');
147
148                         my ($remote_class_node) = $xpc->findnodes( "//idl:class[\@id='$link_class_hint']", $idl->documentElement );
149                         my $search_method = 'search_' . $xpc->findvalue( '@oils_obj:fieldmapper', $remote_class_node );
150                         $search_method =~ s/::/_/go;
151
152                         for my $remote_object ( @{$e->$search_method( { $remote_field => $obj->$link_field } )} ) {
153                             push @context_ous, $remote_object->$context_field;
154                         }
155                     } else {
156                         push @context_ous, $obj->$_ for ( split '\|', $context_field );
157                     }
158                 }
159             }
160         }
161
162         my $pok = 0;
163         for my $perm (@perms) {
164             if (@context_ous) {
165                 for my $c_ou (@context_ous) {
166                     if ($e->allowed($perm => $c_ou => $obj)) {
167                         $pok++;
168                         last;
169                     }
170                 }
171             } else {
172                 $pok++ if ($e->allowed($perm => undef => $obj));
173             }
174         }
175
176         if ((lc($all_perms) eq 'true' && @perms != $pok) or !$pok) {
177             throw OpenSRF::DomainObject::oilsException->new(
178                 statusCode => 500,
179                 status => "Perm failure -- action: $self->{action}, object type: $self->{json_hint}",
180             );
181         }
182     }
183
184     return $obj if ($self->{action} eq 'retrieve');
185
186     my $val = $e->session->request("open-ils.cstore.direct.$o_type.$self->{action}" => $obj )->gather(1);
187     $e->commit;
188
189     return $val;
190 }
191
192 sub search_permacrud {
193     my $self = shift;
194     my $client = shift;
195     my $auth = shift;
196     my @args = @_;
197
198     if (@args > 1) {
199         delete $args[1]{flesh};
200         delete $args[1]{flesh_fields};
201     }
202
203     my $e = new_editor(authtoken => $auth, xact => 1);
204     return $e->event unless $e->checkauth;
205  
206     my $class_node;
207     try {
208         ($class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement );
209     } catch Error with {
210         my $error = shift;
211         $log->error("Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]");
212         throw OpenSRF::DomainObject::oilsException->new(
213             statusCode => 500,
214             status => "Error finding class node: $error [//idl:class[\@id='$self->{class_hint}']]"
215         );
216     };
217
218     my $search_method = 'search_' . $xpc->findvalue( '@oils_obj:fieldmapper', $class_node );
219     $search_method =~ s/::/_/go;
220
221     $log->debug("Calling CStoreEditor search method: $search_method");
222
223     my $obj_list = $e->$search_method( \@args );
224
225     my $retriever = $self->method_lookup( $self->{retriever} );
226     for my $o ( @$obj_list ) {
227         my ($o) = $retriever->run( $auth, $o );
228         $client->respond( $o ) if ($o);
229     }
230
231     return undef;
232 }
233
234 sub generate_methods {
235     try {
236         for my $class_node ( $xpc->findnodes( '//idl:class[perm:permacrud]', $idl->documentElement ) ) {
237             my $hint = $class_node->getAttribute('id');
238             $log->debug("permacrud class_node $hint");
239         
240             for my $action_node ( $xpc->findnodes( "perm:permacrud/perm:actions/perm:*", $class_node ) ) {
241                 (my $method = $action_node->localname) =~ s/^.+:(.+)$/$1/o;
242                 $log->internal("permacrud method = $method");
243         
244                 __PACKAGE__->register_method(
245                     method          => 'CRUD_action_object_permcheck',
246                     api_name        => 'open-ils.permacrud.' . $method . '.' . $hint,
247                     class_hint      => $hint,
248                     action          => $method,
249                 );
250         
251                 if ($method eq 'retrieve') {
252                     __PACKAGE__->register_method(
253                         method          => 'search_permacrud',
254                         api_name        => 'open-ils.permacrud.search.' . $hint,
255                         class_hint      => $hint,
256                         retriever       => 'open-ils.permacrud.retrieve.' . $hint,
257                         stream          => 1
258                     );
259                 }
260             }
261         }
262     } catch Error with {
263         my $e = shift;
264         $log->error("error generating permacrud methods: $e");
265     };
266 }
267
268
269 1;
270