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     generate_methods();
  51 }
  52 sub child_init {}
  53
  54 sub CRUD_action_object_permcheck {
  55     my $self = shift;
  56     my $client = shift;
  57     my $auth = shift;
  58     my $obj = shift;
  59
  60     my $e = new_editor(authtoken => $auth, xact => 1);
  61     return $e->event unless $e->checkauth;
  62
  63     unless ($obj->json_hint eq $self->{class_hint}) {
  64         throw OpenSRF::DomainObject::oilsException->new(
  65             statusCode => 500,
  66             status => "Class missmatch: $self->{class_hint} method called with " . $obj->json_hint,
  67         );
  68     }
  69
  70     my ($class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement );
  71     my ($action_node) = $xpc->findnodes( "perm:permacrud/perm:actions/perm:$action", $class_node );
  72     my $all_perms = $xpc->getAttribute( 'all_perms', $action_node );
  73
  74     if (!ref($obj)) {
  75         my $retrieve_method = 'retrieve_' . $xpc->findvalue( '@oils_obj:fieldmapper', $class_node );
  76         $retrieve_method =~ s/::/_/go;
  77         $obj = $e->retrieve_method( $obj )->gather(1);
  78     }
  79
  80     my $action = $self->api_name =~ s/^open-ils\.admin\.([^\.])\..+$/$1/o;
  81     my $o_type = $obj->cdbi =~ s/::/./go;
  82     my $id_field = $obj->Identity;
  83
  84     my $perm_field_value = $aciton_node->getAttribute('permission');
  85
  86     if (defined($perm_field_value)) {
  87         my @perms = split '|', $aciton_node->getAttribute('permission');
  88
  89         my @context_ous;
  90         if ($aciton_node->getAttribute('global_required')) {
  91             push @context_ous, $e->search_actor_org_unit( { parent_ou => undef } )->[0]->id;
  92
  93         } else {
  94             my $context_field_value = $aciton_node->getAttribute('context_field');
  95
  96             if (defined($context_field_value)) {
  97                 push @context_ous, $obj->$_ for ( split '|', $context_field_value );
  98             } else {
  99                 for my $context_node ( $xpc->findnodes( "perm:context", $action_node ) ) {
 100                     my $context_field = $context_node->getAttribute('field');
 101                     my $link_field = $context_node->getAttribute('link');
 102
 103                     if ($link_field) {
 104
 105                         my ($link_node) = $xpc->findnodes( "idl:links/idl:link[\@field='$link_field']", $class_node );
 106                         my $link_class_hint = $link_node->getAttribute('class');
 107                         my $remote_field = $link_node->getAttribute('key');
 108
 109                         my ($remote_class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement );
 110                         my $search_method = 'search_' . $xpc->findvalue( '@oils_obj:fieldmapper', $remote_class_node );
 111                         $search_method =~ s/::/_/go;
 112
 113                         for my $remote_object ( @{$e->$search_method( { $key => $obj->$link_field } )} ) {
 114                             push @context_ous, $remote_object->$context_field;
 115                         }
 116                     } else {
 117                         push @context_ous, $obj->$_ for ( split '|', $context_field );
 118                     }
 119                 }
 120             }
 121         }
 122
 123         my $pok = 0;
 124         for my $perm (@perms) {
 125             if (@context_ous) {
 126                 for my $c_ou (@context_ous) {
 127                     if ($e->allowed($perm => $c_ou => $obj)) {
 128                         $pok++;
 129                         last;
 130                     }
 131                 }
 132             } else {
 133                 $pok++ if ($e->allowed($perm => undef => $obj));
 134             }
 135         }
 136
 137         if ((lc($all_perms) eq 'true' && @perms != $pok) or !$pok) {
 138             throw OpenSRF::DomainObject::oilsException->new(
 139                 statusCode => 500,
 140                 status => "Perm failure -- action: $action, object type: $self->{json_hint}",
 141             );
 142         }
 143     }
 144
 145     return $obj if ($action eq 'retrieve');
 146
 147     return $e->session->request("open-ils.cstore.direct.$o_type.$action" => $obj )->gather(1);
 148 }
 149
 150 sub search_permacrud {
 151     my $self = shift;
 152     my $client = shift;
 153     my $auth = shift;
 154     my @args = @_;
 155
 156     my $e = new_editor(authtoken => $auth);
 157     return $e->event unless $e->checkauth;
 158
 159     my ($class_node) = $xpc->findnodes( "//idl:class[\@id='$self->{class_hint}']", $idl->documentElement );
 160     my $search_method = 'search_' . $xpc->findvalue( '@oils_obj:fieldmapper', $remote_class_node );
 161     $search_method =~ s/::/_/go;
 162
 163     my $retriever = $self->method_lookup( $self->{retriever} );
 164     my $obj_list = $e->$search_method( @args );
 165
 166     for my $o ( @$obj_list ) {
 167         my ($o) = $retriever->run( $o );
 168         $client->respond( $o ) if ($o);
 169     }
 170
 171     return undef;
 172 }
 173
 174 sub generate_methods {
 175     for my $class_node ( $xpc->findnodes( '//idl:class[perm:permacrud]', $idl->documentElement ) ) {
 176         my $hint = $class_node->getAttribute('id');
 177
 178         for my $action_node ( $xpc->findnodes( "perm:permacrud/perm:actions/perm:*", $class_node ) ) {
 179             my $method = $action_node->localname =~ s/^.+:(.+)$/$1/o;
 180
 181             __PACKAGE__->register_method(
 182                 method          => 'CRUD_action_object_permcheck',
 183                 api_name        => 'open-ils.permacrud.' . $method . '.' . $hint,
 184                 authoritative   => 1,
 185                 class_hint      => $hint,
 186             );
 187
 188             if ($method eq 'retrieve') {
 189                 __PACKAGE__->register_method(
 190                     method      => 'search_permcheck',
 191                     api_name    => 'open-ils.permacrud.search.' . $hint,
 192                     class_hint  => $hint,
 193                     retriever   => 'open-ils.permacrud.retrieve.' . $hint,
 194                     stream      => 1
 195                 );
 196             }
 197         }
 198     }
 199 }
 200
 201
 202 1;
 203