Open-ILS/src/perlmods/OpenILS/Utils/CStoreEditor.pm

   1 use strict; use warnings;
   2 package OpenILS::Utils::CStoreEditor;
   3 use OpenILS::Application::AppUtils;
   4 use OpenSRF::AppSession;
   5 use OpenSRF::EX qw(:try);
   6 use OpenILS::Utils::Fieldmapper;
   7 use OpenILS::Event;
   8 use Data::Dumper;
   9 use JSON;
  10 use OpenSRF::Utils::Logger qw($logger);
  11 my $U = "OpenILS::Application::AppUtils";
  12 my %PERMS;
  13 my $cache;
  14
  15 #my %PERMS = (
  16 #       'biblio.record_entry'   => { update => 'UPDATE_MARC' },
  17 #       'asset.copy'                            => { update => 'UPDATE_COPY'},
  18 #       'asset.call_number'             => { update => 'UPDATE_VOLUME'},
  19 #       'action.circulation'            => { retrieve => 'VIEW_CIRCULATIONS'},
  20 #);
  21
  22
  23
  24 # -----------------------------------------------------------------------------
  25 # Export some useful functions
  26 # -----------------------------------------------------------------------------
  27 use vars qw(@EXPORT_OK %EXPORT_TAGS);
  28 use Exporter;
  29 use base qw/Exporter/;
  30 push @EXPORT_OK, ( 'new_editor', 'new_rstore_editor' );
  31 %EXPORT_TAGS = ( funcs => [ qw/ new_editor new_rstore_editor / ] );
  32
  33 sub new_editor { return OpenILS::Utils::CStoreEditor->new(@_); }
  34
  35 sub new_rstore_editor {
  36         my $e = OpenILS::Utils::CStoreEditor->new(@_);
  37         $e->app('open-ils.reporter-store');
  38         return $e;
  39 }
  40
  41
  42 # -----------------------------------------------------------------------------
  43 # Log levels
  44 # -----------------------------------------------------------------------------
  45 use constant E => 'error';
  46 use constant W => 'warn';
  47 use constant I => 'info';
  48 use constant D => 'debug';
  49 use constant A => 'activity';
  50
  51
  52
  53 # -----------------------------------------------------------------------------
  54 # Params include:
  55 #       xact=><true> : creates a storage transaction
  56 #       authtoken=>$token : the login session key
  57 # -----------------------------------------------------------------------------
  58 sub new {
  59         my( $class, %params ) = @_;
  60         $class = ref($class) || $class;
  61         my $self = bless( \%params, $class );
  62         $self->{checked_perms} = {};
  63         return $self;
  64 }
  65
  66
  67 sub app {
  68         my( $self, $app ) = @_;
  69         $self->{app} = $app if $app;
  70         $self->{app} = 'open-ils.cstore' unless $self->{app};
  71         return $self->{app};
  72 }
  73
  74
  75 # -----------------------------------------------------------------------------
  76 # Log the editor metadata along with the log string
  77 # -----------------------------------------------------------------------------
  78 sub log {
  79         my( $self, $lev, $str ) = @_;
  80         my $s = "editor[";
  81         $s .= "0|" unless $self->{xact};
  82         $s .= "1|" if $self->{xact};
  83         $s .= "0" unless $self->requestor;
  84         $s .= $self->requestor->id if $self->requestor;
  85         $s .= "]";
  86         $logger->$lev("$s $str");
  87 }
  88
  89 # -----------------------------------------------------------------------------
  90 # Verifies the auth token and fetches the requestor object
  91 # -----------------------------------------------------------------------------
  92 sub checkauth {
  93         my $self = shift;
  94         $self->log(D, "checking auth token ".$self->authtoken);
  95         my ($reqr, $evt) = $U->checkses($self->authtoken);
  96         $self->event($evt) if $evt;
  97         return $self->{requestor} = $reqr;
  98 }
  99
 100
 101 =head test
 102 sub checkauth {
 103         my $self = shift;
 104         $cache = OpenSRF::Utils::Cache->new('global') unless $cache;
 105         $self->log(D, "checking cached auth token ".$self->authtoken);
 106         my $user = $cache->get_cache("oils_auth_".$self->authtoken);
 107         return $self->{requestor} = $user->{userobj} if $user;
 108         $self->event(OpenILS::Event->new('NO_SESSION'));
 109         return undef;
 110 }
 111 =cut
 112
 113
 114 # -----------------------------------------------------------------------------
 115 # Returns the last generated event
 116 # -----------------------------------------------------------------------------
 117 sub event {
 118         my( $self, $evt ) = @_;
 119         $self->{event} = $evt if $evt;
 120         return $self->{event};
 121 }
 122
 123 # -----------------------------------------------------------------------------
 124 # Destroys the transaction and disconnects where necessary,
 125 # then returns the last event that occurred
 126 # -----------------------------------------------------------------------------
 127 sub die_event {
 128         my $self = shift;
 129         $self->rollback;
 130         return $self->event;
 131 }
 132
 133
 134 # -----------------------------------------------------------------------------
 135 # Clears the last caught event
 136 # -----------------------------------------------------------------------------
 137 sub clear_event {
 138         my $self = shift;
 139         $self->{event} = undef;
 140 }
 141
 142 sub authtoken {
 143         my( $self, $auth ) = @_;
 144         $self->{authtoken} = $auth if $auth;
 145         return $self->{authtoken};
 146 }
 147
 148 # -----------------------------------------------------------------------------
 149 # fetches the session, creating if necessary.  If 'xact' is true on this
 150 # object, a db session is created
 151 # -----------------------------------------------------------------------------
 152 sub session {
 153         my( $self, $session ) = @_;
 154         $self->{session} = $session if $session;
 155
 156         if(!$self->{session}) {
 157                 $self->{session} = OpenSRF::AppSession->create($self->app);
 158
 159                 if( ! $self->{session} ) {
 160                         my $str = "Error creating cstore session with OpenSRF::AppSession->create()!";
 161                         $self->log(E, $str);
 162                         throw OpenSRF::EX::ERROR ($str);
 163                 }
 164
 165                 $self->{session}->connect if $self->{xact} or $self->{connect};
 166                 $self->xact_start if $self->{xact};
 167         }
 168         return $self->{session};
 169 }
 170
 171
 172 # -----------------------------------------------------------------------------
 173 # Starts a storage transaction
 174 # -----------------------------------------------------------------------------
 175 sub xact_start {
 176         my $self = shift;
 177         $self->log(D, "starting new db session");
 178         my $stat = $self->request($self->app . '.transaction.begin');
 179         $self->log(E, "error starting database transaction") unless $stat;
 180         return $stat;
 181 }
 182
 183 # -----------------------------------------------------------------------------
 184 # Commits a storage transaction
 185 # -----------------------------------------------------------------------------
 186 sub xact_commit {
 187         my $self = shift;
 188         $self->log(D, "comitting db session");
 189         my $stat = $self->request($self->app.'.transaction.commit');
 190         $self->log(E, "error comitting database transaction") unless $stat;
 191         return $stat;
 192 }
 193
 194 # -----------------------------------------------------------------------------
 195 # Rolls back a storage stransaction
 196 # -----------------------------------------------------------------------------
 197 sub xact_rollback {
 198         my $self = shift;
 199    return unless $self->{session};
 200         $self->log(I, "rolling back db session");
 201         return $self->request($self->app.".transaction.rollback");
 202 }
 203
 204
 205
 206 # -----------------------------------------------------------------------------
 207 # Rolls back the transaction and disconnects
 208 # -----------------------------------------------------------------------------
 209 sub rollback {
 210         my $self = shift;
 211         $self->xact_rollback if $self->{xact};
 212    delete $self->{xact};
 213         $self->disconnect;
 214 }
 215
 216 sub disconnect {
 217         my $self = shift;
 218         $self->session->disconnect if $self->{session};
 219    delete $self->{session};
 220 }
 221
 222
 223 # -----------------------------------------------------------------------------
 224 # commits the db session and destroys the session
 225 # -----------------------------------------------------------------------------
 226 sub commit {
 227         my $self = shift;
 228         return unless $self->{xact};
 229         $self->xact_commit;
 230         $self->session->disconnect;
 231         $self->{session} = undef;
 232 }
 233
 234 # -----------------------------------------------------------------------------
 235 # clears all object data. Does not commit the db transaction.
 236 # -----------------------------------------------------------------------------
 237 sub reset {
 238         my $self = shift;
 239         $self->disconnect;
 240         $$self{$_} = undef for (keys %$self);
 241 }
 242
 243
 244 # -----------------------------------------------------------------------------
 245 # commits and resets
 246 # -----------------------------------------------------------------------------
 247 sub finish {
 248         my $self = shift;
 249         $self->commit;
 250         $self->reset;
 251 }
 252
 253
 254
 255 # -----------------------------------------------------------------------------
 256 # Does a simple storage request
 257 # -----------------------------------------------------------------------------
 258 sub request {
 259         my( $self, $method, @params ) = @_;
 260
 261         my $val;
 262         my $err;
 263         my $argstr = __arg_to_string( (scalar(@params)) == 1 ? $params[0] : \@params);
 264
 265         $self->log(I, "request $method : $argstr");
 266
 267         if( $self->{xact} and
 268                         $self->session->state != OpenSRF::AppSession::CONNECTED() ) {
 269                 $logger->error("CStoreEditor lost it's connection!!");
 270                 #throw OpenSRF::EX::ERROR ("CStoreEditor lost it's connection - transaction cannot continue");
 271         }
 272
 273         try {
 274
 275       my $req = $self->session->request($method, @params);
 276
 277       if( $self->substream ) {
 278          $self->log(D,"running in substream mode");
 279          $val = [];
 280          while( my $resp = $req->recv ) {
 281             push(@$val, $resp->content) if $resp->content;
 282          }
 283       } else {
 284          $val = $req->gather(1);
 285       }
 286
 287                 #$val = $self->session->request($method, @params)->gather(1);
 288
 289         } catch Error with {
 290                 $err = shift;
 291                 $self->log(E, "request error $method : $argstr : $err");
 292         };
 293
 294         throw $err if $err;
 295         return $val;
 296 }
 297
 298 sub substream {
 299    my( $self, $bool ) = @_;
 300    $self->{substream} = $bool if defined $bool;
 301    return $self->{substream};
 302 }
 303
 304
 305 # -----------------------------------------------------------------------------
 306 # Sets / Returns the requstor object.  This is set when checkauth succeeds.
 307 # -----------------------------------------------------------------------------
 308 sub requestor {
 309         my($self, $requestor) = @_;
 310         $self->{requestor} = $requestor if $requestor;
 311         return $self->{requestor};
 312 }
 313
 314
 315
 316 # -----------------------------------------------------------------------------
 317 # Holds the last data received from a storage call
 318 # -----------------------------------------------------------------------------
 319 sub data {
 320         my( $self, $data ) = @_;
 321         $self->{data} = $data if defined $data;
 322         return $self->{data};
 323 }
 324
 325
 326 # -----------------------------------------------------------------------------
 327 # True if this perm has already been checked at this org
 328 # -----------------------------------------------------------------------------
 329 sub perm_checked {
 330         my( $self, $perm, $org ) = @_;
 331         $self->{checked_perms}->{$org} = {}
 332                 unless $self->{checked_perms}->{$org};
 333         my $checked = $self->{checked_perms}->{$org}->{$perm};
 334         if(!$checked) {
 335                 $self->{checked_perms}->{$org}->{$perm} = 1;
 336                 return 0;
 337         }
 338         return 1;
 339 }
 340
 341
 342
 343 # -----------------------------------------------------------------------------
 344 # Returns true if the requested perm is allowed.  If the perm check fails,
 345 # $e->event is set and undef is returned
 346 # The perm user is $e->requestor->id and perm org defaults to the requestor's
 347 # ws_ou
 348 # If this perm at the given org has already been verified, true is returned
 349 # and the perm is not re-checked
 350 # -----------------------------------------------------------------------------
 351 sub allowed {
 352         my( $self, $perm, $org ) = @_;
 353         my $uid = $self->requestor->id;
 354         $org ||= $self->requestor->ws_ou;
 355         $self->log(I, "checking perms user=$uid, org=$org, perm=$perm");
 356         return 1 if $self->perm_checked($perm, $org);
 357         return $self->checkperm($uid, $org, $perm);
 358 }
 359
 360 sub checkperm {
 361         my($self, $userid, $org, $perm) = @_;
 362         my $s = $U->storagereq(
 363                 "open-ils.storage.permission.user_has_perm", $userid, $perm, $org );
 364
 365         if(!$s) {
 366                 my $e = OpenILS::Event->new('PERM_FAILURE', ilsperm => $perm, ilspermloc => $org);
 367                 $self->event($e);
 368                 return undef;
 369         }
 370
 371         return 1;
 372 }
 373
 374
 375
 376 # -----------------------------------------------------------------------------
 377 # checks the appropriate perm for the operation
 378 # -----------------------------------------------------------------------------
 379 sub _checkperm {
 380         my( $self, $ptype, $action, $org ) = @_;
 381         $org ||= $self->requestor->ws_ou;
 382         my $perm = $PERMS{$ptype}{$action};
 383         if( $perm ) {
 384                 return undef if $self->perm_checked($perm, $org);
 385                 return $self->event unless $self->allowed($perm, $org);
 386         } else {
 387                 $self->log(I, "no perm provided for $ptype.$action");
 388         }
 389         return undef;
 390 }
 391
 392
 393
 394 # -----------------------------------------------------------------------------
 395 # Logs update actions to the activity log
 396 # -----------------------------------------------------------------------------
 397 sub log_activity {
 398         my( $self, $type, $action, $arg ) = @_;
 399         my $str = "$type.$action";
 400         $str .= _prop_string($arg);
 401         $self->log(A, $str);
 402 }
 403
 404
 405
 406 sub _prop_string {
 407         my $obj = shift;
 408         my @props = $obj->properties;
 409         my $str = "";
 410         for(@props) {
 411                 my $prop = $obj->$_() || "";
 412                 $prop = substr($prop, 0, 128) . "..." if length $prop > 131;
 413                 $str .= " $_=$prop";
 414         }
 415         return $str;
 416 }
 417
 418
 419 sub __arg_to_string {
 420         my $arg = shift;
 421         return "" unless defined $arg;
 422         if( UNIVERSAL::isa($arg, "Fieldmapper") ) {
 423                 return (defined $arg->id) ? $arg->id : '<new object>';
 424         }
 425         return JSON->perl2JSON($arg);
 426         return "";
 427 }
 428
 429
 430 # -----------------------------------------------------------------------------
 431 # This does the actual storage query.
 432 #
 433 # 'search' calls become search_where calls and $arg can be a search hash or
 434 # an array-ref of storage search options.
 435 #
 436 # 'retrieve' expects an id
 437 # 'update' expects an object
 438 # 'create' expects an object
 439 # 'delete' expects an object
 440 #
 441 # All methods return true on success and undef on failure.  On failure,
 442 # $e->event is set to the generated event.
 443 # Note: this method assumes that updating a non-changed object and
 444 # thereby receiving a 0 from storage, is a successful update.
 445 #
 446 # The method will therefore return true so the caller can just do
 447 # $e->update_blah($x) or return $e->event;
 448 # The true value returned from storage for all methods will be stored in
 449 # $e->data, until the next method is called.
 450 #
 451 # not-found events are generated on retrieve and serach methods.
 452 # action=search methods will return [] (==true) if no data is found.  If the
 453 # caller is interested in the not found event, they can do:
 454 # return $e->event unless @$results;
 455 # -----------------------------------------------------------------------------
 456 sub runmethod {
 457         my( $self, $action, $type, $arg, $options ) = @_;
 458
 459    $options ||= {};
 460
 461         if( $action eq 'retrieve' ) {
 462                 if(! defined($arg) ) {
 463                         $self->log(W,"$action $type called with no ID...");
 464                         $self->event(_mk_not_found($type, $arg));
 465                         return undef;
 466                 } elsif( ref($arg) =~ /Fieldmapper/ ) {
 467                         $self->log(E,"$action $type called with an object.. attempting ID retrieval..");
 468                         $arg = $arg->id;
 469                 }
 470         }
 471
 472         my @arg = ( ref($arg) eq 'ARRAY' ) ? @$arg : ($arg);
 473         my $method = $self->app.".direct.$type.$action";
 474
 475         if( $action eq 'search' ) {
 476                 $method = "$method.atomic";
 477
 478         } elsif( $action eq 'batch_retrieve' ) {
 479                 $action = 'search';
 480                 @arg = ( { id => $arg } );
 481                 $method =~ s/batch_retrieve/search/o;
 482                 $method = "$method.atomic";
 483
 484         } elsif( $action eq 'retrieve_all' ) {
 485                 $action = 'search';
 486                 $method =~ s/retrieve_all/search/o;
 487                 my $tt = $type;
 488                 $tt =~ s/\./::/og;
 489                 my $fmobj = "Fieldmapper::$tt";
 490                 @arg = ( { $fmobj->Identity => { '!=' => undef } } );
 491                 $method = "$method.atomic";
 492         }
 493
 494         $method =~ s/search/id_list/o if $options->{idlist};
 495
 496    $method =~ s/\.atomic$//o if $self->substream($$options{substream});
 497
 498         # remove any stale events
 499         $self->clear_event;
 500
 501         if( $action eq 'update' or $action eq 'delete' or $action eq 'create' ) {
 502                 if(!$self->{xact}) {
 503                         $logger->error("Attempt to update DB while not in a transaction : $method");
 504                         throw OpenSRF::EX::ERROR ("Attempt to update DB while not in a transaction : $method");
 505                 }
 506                 $self->log_activity($type, $action, $arg);
 507         }
 508
 509         if($$options{checkperm}) {
 510                 my $a = ($action eq 'search') ? 'retrieve' : $action;
 511                 my $e = $self->_checkperm($type, $a, $$options{permorg});
 512                 if($e) {
 513                         $self->event($e);
 514                         return undef;
 515                 }
 516         }
 517
 518         my $obj;
 519         my $err;
 520
 521         try {
 522                 $obj = $self->request($method, @arg);
 523         } catch Error with { $err = shift; };
 524
 525
 526         if(!defined $obj) {
 527                 $self->log(I, "request returned no data : $method");
 528
 529                 if( $action eq 'retrieve' ) {
 530                         $self->event(_mk_not_found($type, $arg));
 531
 532                 } elsif( $action eq 'update' or
 533                                 $action eq 'delete' or $action eq 'create' ) {
 534                         my $evt = OpenILS::Event->new(
 535                                 'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" );
 536                         $self->event($evt);
 537                 }
 538
 539                 if( $err ) {
 540                         $self->event(
 541                                 OpenILS::Event->new( 'DATABASE_QUERY_FAILED',
 542                                         payload => $arg, debug => "$err" ));
 543                         return undef;
 544                 }
 545
 546                 return undef;
 547         }
 548
 549         if( $action eq 'create' and $obj == 0 ) {
 550                 my $evt = OpenILS::Event->new(
 551                         'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" );
 552                 $self->event($evt);
 553                 return undef;
 554         }
 555
 556         # If we havn't dealt with the error in a nice way, go ahead and throw it
 557         if( $err ) {
 558                 $self->event(
 559                         OpenILS::Event->new( 'DATABASE_QUERY_FAILED',
 560                                 payload => $arg, debug => "$err" ));
 561                 return undef;
 562         }
 563
 564         if( $action eq 'search' or $action eq 'batch_retrieve' or $action eq 'retrieve_all') {
 565                 $self->log(I, "$type.$action : returned ".scalar(@$obj). " result(s)");
 566                 $self->event(_mk_not_found($type, $arg)) unless @$obj;
 567         }
 568
 569         if( $action eq 'create' ) {
 570                 $self->log(I, "created a new $type object with ID " . $obj->id);
 571                 $arg->id($obj->id);
 572         }
 573
 574         $self->data($obj); # cache the data for convenience
 575
 576         return ($obj) ? $obj : 1;
 577 }
 578
 579
 580 sub _mk_not_found {
 581         my( $type, $arg ) = @_;
 582         (my $t = $type) =~ s/\./_/og;
 583         $t = uc($t);
 584         return OpenILS::Event->new("${t}_NOT_FOUND", payload => $arg);
 585 }
 586
 587
 588
 589 # utility method for loading
 590 sub __fm2meth {
 591         my $str = shift;
 592         my $sep = shift;
 593         $str =~ s/Fieldmapper:://o;
 594         $str =~ s/::/$sep/g;
 595         return $str;
 596 }
 597
 598
 599 # -------------------------------------------------------------
 600 # Load up the methods from the FM classes
 601 # -------------------------------------------------------------
 602 my $map = $Fieldmapper::fieldmap;
 603 for my $object (keys %$map) {
 604         my $obj = __fm2meth($object,'_');
 605         my $type = __fm2meth($object, '.');
 606
 607         my $update = "update_$obj";
 608         my $updatef =
 609                 "sub $update {return shift()->runmethod('update', '$type', \@_);}";
 610         eval $updatef;
 611
 612         my $retrieve = "retrieve_$obj";
 613         my $retrievef =
 614                 "sub $retrieve {return shift()->runmethod('retrieve', '$type', \@_);}";
 615         eval $retrievef;
 616
 617         my $search = "search_$obj";
 618         my $searchf =
 619                 "sub $search {return shift()->runmethod('search', '$type', \@_);}";
 620         eval $searchf;
 621
 622         my $create = "create_$obj";
 623         my $createf =
 624                 "sub $create {return shift()->runmethod('create', '$type', \@_);}";
 625         eval $createf;
 626
 627         my $delete = "delete_$obj";
 628         my $deletef =
 629                 "sub $delete {return shift()->runmethod('delete', '$type', \@_);}";
 630         eval $deletef;
 631
 632         my $bretrieve = "batch_retrieve_$obj";
 633         my $bretrievef =
 634                 "sub $bretrieve {return shift()->runmethod('batch_retrieve', '$type', \@_);}";
 635         eval $bretrievef;
 636
 637         my $retrieveall = "retrieve_all_$obj";
 638         my $retrieveallf =
 639                 "sub $retrieveall {return shift()->runmethod('retrieve_all', '$type', \@_);}";
 640         eval $retrieveallf;
 641 }
 642
 643
 644
 645 1;
 646
 647