1 use strict; use warnings;
2 package OpenILS::Utils::Editor;
3 use OpenILS::Application::AppUtils;
4 use OpenSRF::AppSession;
5 use OpenSRF::EX qw(:try);
6 use OpenILS::Utils::Fieldmapper;
9 use OpenSRF::Utils::JSON;
10 use OpenSRF::Utils::Logger qw($logger);
11 my $U = "OpenILS::Application::AppUtils";
14 # -----------------------------------------------------------------------------
15 # Export some useful functions
16 # -----------------------------------------------------------------------------
17 use vars qw(@EXPORT_OK %EXPORT_TAGS);
19 use base qw/Exporter/;
20 push @EXPORT_OK, 'new_editor';
21 %EXPORT_TAGS = ( funcs => [ qw/ new_editor / ] );
23 sub new_editor { return OpenILS::Utils::Editor->new(@_); }
26 # -----------------------------------------------------------------------------
27 # These need to be auto-generated
28 # -----------------------------------------------------------------------------
30 'biblio.record_entry' => { update => 'UPDATE_MARC' },
31 'asset.copy' => { update => 'UPDATE_COPY'},
32 'asset.call_number' => { update => 'UPDATE_VOLUME'},
33 'action.circulation' => { retrieve => 'VIEW_CIRCULATIONS'},
37 use constant E => 'error';
38 use constant W => 'warn';
39 use constant I => 'info';
40 use constant D => 'debug';
41 use constant A => 'activity';
45 # -----------------------------------------------------------------------------
47 # xact=><true> : creates a storage transaction
48 # authtoken=>$token : the login session key
49 # -----------------------------------------------------------------------------
51 my( $class, %params ) = @_;
52 $class = ref($class) || $class;
53 my $self = bless( \%params, $class );
54 $self->{checked_perms} = {};
55 $logstr = "editor [0";
56 $logstr = "editor [1" if $self->{xact};
60 # -----------------------------------------------------------------------------
61 # Log the editor metadata along with the log string
62 # -----------------------------------------------------------------------------
64 my( $self, $lev, $str ) = @_;
66 $s .= "0|" unless $self->{xact};
67 $s .= "1|" if $self->{xact};
68 $s .= "0" unless $self->requestor;
69 $s .= $self->requestor->id if $self->requestor;
71 $logger->$lev("$s $str");
74 # -----------------------------------------------------------------------------
75 # Verifies the auth token and fetches the requestor object
76 # -----------------------------------------------------------------------------
79 $self->log(D, "checking auth token ".$self->authtoken);
80 my ($reqr, $evt) = $U->checkses($self->authtoken);
81 $self->event($evt) if $evt;
82 return $self->{requestor} = $reqr;
86 # -----------------------------------------------------------------------------
87 # Returns the last generated event
88 # -----------------------------------------------------------------------------
90 my( $self, $evt ) = @_;
91 $self->{event} = $evt if $evt;
92 return $self->{event};
95 # -----------------------------------------------------------------------------
96 # Clears the last caught event
97 # -----------------------------------------------------------------------------
100 $self->{event} = undef;
104 my( $self, $auth ) = @_;
105 $self->{authtoken} = $auth if $auth;
106 return $self->{authtoken};
109 # -----------------------------------------------------------------------------
110 # fetches the session, creating if necessary. If 'xact' is true on this
111 # object, a db session is created
112 # -----------------------------------------------------------------------------
114 my( $self, $session ) = @_;
115 $self->{session} = $session if $session;
117 if(!$self->{session}) {
118 $self->{session} = OpenSRF::AppSession->create('open-ils.storage');
120 if( ! $self->{session} ) {
121 my $str = "Error creating storage session with OpenSRF::AppSession->create()!";
123 throw OpenSRF::EX::ERROR ($str);
126 $self->{session}->connect if $self->{xact} or $self->{connect};
127 $self->xact_start if $self->{xact};
129 return $self->{session};
133 # -----------------------------------------------------------------------------
134 # Starts a storage transaction
135 # -----------------------------------------------------------------------------
138 $self->log(D, "starting new db session");
139 my $stat = $self->request('open-ils.storage.transaction.begin');
140 $self->log(E, "error starting database transaction") unless $stat;
144 # -----------------------------------------------------------------------------
145 # Commits a storage transaction
146 # -----------------------------------------------------------------------------
149 $self->log(D, "comitting db session");
150 my $stat = $self->request('open-ils.storage.transaction.commit');
151 $self->log(E, "error comitting database transaction") unless $stat;
155 # -----------------------------------------------------------------------------
156 # Rolls back a storage stransaction
157 # -----------------------------------------------------------------------------
160 $self->log(I, "rolling back db session");
161 return $self->request("open-ils.storage.transaction.rollback");
165 # -----------------------------------------------------------------------------
166 # commits the db session and destroys the session
167 # -----------------------------------------------------------------------------
170 return unless $self->{xact};
172 $self->session->disconnect;
173 $self->{session} = undef;
176 # -----------------------------------------------------------------------------
177 # clears all object data. Does not commit the db transaction.
178 # -----------------------------------------------------------------------------
181 $self->session->disconnect if $self->{session};
182 $$self{$_} = undef for (keys %$self);
186 # -----------------------------------------------------------------------------
188 # -----------------------------------------------------------------------------
197 # -----------------------------------------------------------------------------
198 # Does a simple storage request
199 # -----------------------------------------------------------------------------
201 my( $self, $method, @params ) = @_;
205 my $argstr = __arg_to_string( (scalar(@params)) == 1 ? $params[0] : \@params);
207 $self->log(I, "request $method : $argstr");
210 $val = $self->session->request($method, @params)->gather(1);
214 $self->log(E, "request error $method : $argstr : $err");
222 # -----------------------------------------------------------------------------
223 # Sets / Returns the requstor object. This is set when checkauth succeeds.
224 # -----------------------------------------------------------------------------
226 my($self, $requestor) = @_;
227 $self->{requestor} = $requestor if $requestor;
228 return $self->{requestor};
233 # -----------------------------------------------------------------------------
234 # Holds the last data received from a storage call
235 # -----------------------------------------------------------------------------
237 my( $self, $data ) = @_;
238 $self->{data} = $data if defined $data;
239 return $self->{data};
243 # -----------------------------------------------------------------------------
244 # True if this perm has already been checked at this org
245 # -----------------------------------------------------------------------------
247 my( $self, $perm, $org ) = @_;
248 $self->{checked_perms}->{$org} = {}
249 unless $self->{checked_perms}->{$org};
250 my $checked = $self->{checked_perms}->{$org}->{$perm};
252 $self->{checked_perms}->{$org}->{$perm} = 1;
260 # -----------------------------------------------------------------------------
261 # Returns true if the requested perm is allowed. If the perm check fails,
262 # $e->event is set and undef is returned
263 # The perm user is $e->requestor->id and perm org defaults to the requestor's
265 # If this perm at the given org has already been verified, true is returned
266 # and the perm is not re-checked
267 # -----------------------------------------------------------------------------
269 my( $self, $perm, $org ) = @_;
270 my $uid = $self->requestor->id;
271 $org ||= $self->requestor->ws_ou;
272 $self->log(I, "checking perms user=$uid, org=$org, perm=$perm");
273 return 1 if $self->perm_checked($perm, $org);
274 return $self->checkperm($uid, $org, $perm);
278 my($self, $userid, $org, $perm) = @_;
279 my $s = $self->request(
280 "open-ils.storage.permission.user_has_perm", $userid, $perm, $org );
283 my $e = OpenILS::Event->new('PERM_FAILURE', ilsperm => $perm, ilspermloc => $org);
293 # -----------------------------------------------------------------------------
294 # checks the appropriate perm for the operation
295 # -----------------------------------------------------------------------------
297 my( $self, $ptype, $action, $org ) = @_;
298 $org ||= $self->requestor->ws_ou;
299 my $perm = $PERMS{$ptype}{$action};
301 return undef if $self->perm_checked($perm, $org);
302 return $self->event unless $self->allowed($perm, $org);
304 $self->log(E, "no perm provided for $ptype.$action");
311 # -----------------------------------------------------------------------------
312 # Logs update actions to the activity log
313 # -----------------------------------------------------------------------------
315 my( $self, $type, $action, $arg ) = @_;
316 my $str = "$type.$action";
317 $str .= _prop_string($arg);
325 my @props = $obj->properties;
328 my $prop = $obj->$_() || "";
329 $prop = substr($prop, 0, 128) . "..." if length $prop > 131;
336 sub __arg_to_string {
338 return "" unless defined $arg;
339 return $arg->id if UNIVERSAL::isa($arg, "Fieldmapper");
340 return OpenSRF::Utils::JSON->perl2JSON($arg);
344 # -----------------------------------------------------------------------------
345 # This does the actual storage query.
347 # 'search' calls become search_where calls and $arg can be a search hash or
348 # an array-ref of storage search options.
350 # 'retrieve' expects an id
351 # 'update' expects an object
352 # 'create' expects an object
353 # 'delete' expects an object
355 # All methods return true on success and undef on failure. On failure,
356 # $e->event is set to the generated event.
357 # Note: this method assumes that updating a non-changed object and
358 # thereby receiving a 0 from storage, is a successful update.
360 # The method will therefore return true so the caller can just do
361 # $e->update_blah($x) or return $e->event;
362 # The true value returned from storage for all methods will be stored in
363 # $e->data, until the next method is called.
365 # not-found events are generated on retrieve and serach methods.
366 # action=search methods will return [] (==true) if no data is found. If the
367 # caller is interested in the not found event, they can do:
368 # return $e->event unless @$results;
369 # -----------------------------------------------------------------------------
371 my( $self, $action, $type, $arg, $options ) = @_;
374 my $method = "open-ils.storage.direct.$type.$action";
376 if( $action eq 'search' ) {
377 $method =~ s/search/search_where/o;
378 $method =~ s/direct/id_list/o if $options->{idlist};
379 $method = "$method.atomic";
380 @arg = @$arg if ref($arg) eq 'ARRAY';
382 } elsif( $action eq 'batch_retrieve' ) {
383 $method =~ s/batch_retrieve/batch.retrieve/o;
384 $method = "$method.atomic";
385 @arg = @$arg if ref($arg) eq 'ARRAY';
387 } elsif( $action eq 'retrieve_all' ) {
388 $method =~ s/retrieve_all/retrieve.all.atomic/o;
391 # remove any stale events
394 if( $action eq 'update' or $action eq 'delete' or $action eq 'create' ) {
395 $self->log_activity($type, $action, $arg);
398 if($$options{checkperm}) {
399 my $a = ($action eq 'search' or
400 $action eq 'batch_retrieve' or $action eq 'retrieve_all') ? 'retrieve' : $action;
401 my $e = $self->_checkperm($type, $a, $$options{permorg});
412 $obj = $self->request($method, @arg);
413 } catch Error with { $err = shift; };
417 $self->log(I, "request returned no data");
419 if( $action eq 'retrieve' ) {
420 $self->event(_mk_not_found($type, $arg));
422 } elsif( $action eq 'update' or
423 $action eq 'delete' or $action eq 'create' ) {
424 my $evt = OpenILS::Event->new(
425 'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" );
431 OpenILS::Event->new( 'DATABASE_QUERY_FAILED',
432 payload => $arg, debug => "$err" ));
439 if( $action eq 'create' and $obj == 0 ) {
440 my $evt = OpenILS::Event->new(
441 'DATABASE_UPDATE_FAILED', payload => $arg, debug => "$err" );
446 # If we havn't dealt with the error in a nice way, go ahead and throw it
449 OpenILS::Event->new( 'DATABASE_QUERY_FAILED',
450 payload => $arg, debug => "$err" ));
454 if( $action eq 'search' or $action eq 'batch_retrieve' or $action eq 'retrieve_all') {
455 $self->log(I, "$type.$action : returned ".scalar(@$obj). " result(s)");
456 $self->event(_mk_not_found($type, $arg)) unless @$obj;
459 $arg->id($obj) if $action eq 'create'; # grabs the id on create
460 $self->data($obj); # cache the data for convenience
462 return ($obj) ? $obj : 1;
467 my( $type, $arg ) = @_;
468 (my $t = $type) =~ s/\./_/og;
470 return OpenILS::Event->new("${t}_NOT_FOUND", payload => $arg);
475 # utility method for loading
479 $str =~ s/Fieldmapper:://o;
485 # -------------------------------------------------------------
486 # Load up the methods from the FM classes
487 # -------------------------------------------------------------
488 my $map = $Fieldmapper::fieldmap;
489 for my $object (keys %$map) {
490 my $obj = __fm2meth($object,'_');
491 my $type = __fm2meth($object, '.');
493 my $update = "update_$obj";
495 "sub $update {return shift()->runmethod('update', '$type', \@_);}";
498 my $retrieve = "retrieve_$obj";
500 "sub $retrieve {return shift()->runmethod('retrieve', '$type', \@_);}";
503 my $search = "search_$obj";
505 "sub $search {return shift()->runmethod('search', '$type', \@_);}";
508 my $create = "create_$obj";
510 "sub $create {return shift()->runmethod('create', '$type', \@_);}";
513 my $delete = "delete_$obj";
515 "sub $delete {return shift()->runmethod('delete', '$type', \@_);}";
518 my $bretrieve = "batch_retrieve_$obj";
520 "sub $bretrieve {return shift()->runmethod('batch_retrieve', '$type', \@_);}";
523 my $retrieveall = "retrieve_all_$obj";
525 "sub $retrieveall {return shift()->runmethod('retrieve_all', '$type', \@_);}";