Open-ILS/src/perlmods/lib/OpenILS/Application/AppUtils.pm

   1 package OpenILS::Application::AppUtils;
   2 # vim:noet:ts=4
   3 use strict; use warnings;
   4 use OpenILS::Application;
   5 use base qw/OpenILS::Application/;
   6 use OpenSRF::Utils::Cache;
   7 use OpenSRF::Utils::Logger qw/$logger/;
   8 use OpenILS::Utils::ModsParser;
   9 use OpenSRF::EX qw(:try);
  10 use OpenILS::Event;
  11 use Data::Dumper;
  12 use OpenILS::Utils::CStoreEditor;
  13 use OpenILS::Const qw/:const/;
  14 use Unicode::Normalize;
  15 use OpenSRF::Utils::SettingsClient;
  16 use UUID::Tiny;
  17 use Encode;
  18 use DateTime;
  19 use DateTime::Format::ISO8601;
  20
  21 # ---------------------------------------------------------------------------
  22 # Pile of utilty methods used accross applications.
  23 # ---------------------------------------------------------------------------
  24 my $cache_client = "OpenSRF::Utils::Cache";
  25
  26
  27 # ---------------------------------------------------------------------------
  28 # on sucess, returns the created session, on failure throws ERROR exception
  29 # ---------------------------------------------------------------------------
  30 sub start_db_session {
  31
  32         my $self = shift;
  33         my $session = OpenSRF::AppSession->connect( "open-ils.storage" );
  34         my $trans_req = $session->request( "open-ils.storage.transaction.begin" );
  35
  36         my $trans_resp = $trans_req->recv();
  37         if(ref($trans_resp) and UNIVERSAL::isa($trans_resp,"Error")) { throw $trans_resp; }
  38         if( ! $trans_resp->content() ) {
  39                 throw OpenSRF::ERROR
  40                         ("Unable to Begin Transaction with database" );
  41         }
  42         $trans_req->finish();
  43
  44         $logger->debug("Setting global storage session to ".
  45                 "session: " . $session->session_id . " : " . $session->app );
  46
  47         return $session;
  48 }
  49
  50 sub set_audit_info {
  51         my $self = shift;
  52         my $session = shift;
  53         my $authtoken = shift;
  54         my $user_id = shift;
  55         my $ws_id = shift;
  56
  57         my $audit_req = $session->request( "open-ils.storage.set_audit_info", $authtoken, $user_id, $ws_id );
  58         my $audit_resp = $audit_req->recv();
  59         $audit_req->finish();
  60 }
  61
  62 my $PERM_QUERY = {
  63     select => {
  64         au => [ {
  65             transform => 'permission.usr_has_perm',
  66             alias => 'has_perm',
  67             column => 'id',
  68             params => []
  69         } ]
  70     },
  71     from => 'au',
  72     where => {},
  73 };
  74
  75
  76 # returns undef if user has all of the perms provided
  77 # returns the first failed perm on failure
  78 sub check_user_perms {
  79         my($self, $user_id, $org_id, @perm_types ) = @_;
  80         $logger->debug("Checking perms with user : $user_id , org: $org_id, @perm_types");
  81
  82         for my $type (@perm_types) {
  83             $PERM_QUERY->{select}->{au}->[0]->{params} = [$type, $org_id];
  84                 $PERM_QUERY->{where}->{id} = $user_id;
  85                 return $type unless $self->is_true(OpenILS::Utils::CStoreEditor->new->json_query($PERM_QUERY)->[0]->{has_perm});
  86         }
  87         return undef;
  88 }
  89
  90 # checks the list of user perms.  The first one that fails returns a new
  91 sub check_perms {
  92         my( $self, $user_id, $org_id, @perm_types ) = @_;
  93         my $t = $self->check_user_perms( $user_id, $org_id, @perm_types );
  94         return OpenILS::Event->new('PERM_FAILURE', ilsperm => $t, ilspermloc => $org_id ) if $t;
  95         return undef;
  96 }
  97
  98
  99
 100 # ---------------------------------------------------------------------------
 101 # commits and destroys the session
 102 # ---------------------------------------------------------------------------
 103 sub commit_db_session {
 104         my( $self, $session ) = @_;
 105
 106         my $req = $session->request( "open-ils.storage.transaction.commit" );
 107         my $resp = $req->recv();
 108
 109         if(!$resp) {
 110                 throw OpenSRF::EX::ERROR ("Unable to commit db session");
 111         }
 112
 113         if(UNIVERSAL::isa($resp,"Error")) {
 114                 throw $resp ($resp->stringify);
 115         }
 116
 117         if(!$resp->content) {
 118                 throw OpenSRF::EX::ERROR ("Unable to commit db session");
 119         }
 120
 121         $session->finish();
 122         $session->disconnect();
 123         $session->kill_me();
 124 }
 125
 126 sub rollback_db_session {
 127         my( $self, $session ) = @_;
 128
 129         my $req = $session->request("open-ils.storage.transaction.rollback");
 130         my $resp = $req->recv();
 131         if(UNIVERSAL::isa($resp,"Error")) { throw $resp;  }
 132
 133         $session->finish();
 134         $session->disconnect();
 135         $session->kill_me();
 136 }
 137
 138
 139 # returns undef it the event is not an ILS event
 140 # returns the event code otherwise
 141 sub event_code {
 142         my( $self, $evt ) = @_;
 143         return $evt->{ilsevent} if( ref($evt) eq 'HASH' and defined($evt->{ilsevent})) ;
 144         return undef;
 145 }
 146
 147 # ---------------------------------------------------------------------------
 148 # Checks to see if a user is logged in.  Returns the user record on success,
 149 # throws an exception on error.
 150 # ---------------------------------------------------------------------------
 151 sub check_user_session {
 152         my( $self, $user_session ) = @_;
 153
 154         my $content = $self->simplereq(
 155                 'open-ils.auth',
 156                 'open-ils.auth.session.retrieve', $user_session);
 157
 158     return undef if (!$content) or $self->event_code($content);
 159         return $content;
 160 }
 161
 162 # generic simple request returning a scalar value
 163 sub simplereq {
 164         my($self, $service, $method, @params) = @_;
 165         return $self->simple_scalar_request($service, $method, @params);
 166 }
 167
 168
 169 sub simple_scalar_request {
 170         my($self, $service, $method, @params) = @_;
 171
 172         my $session = OpenSRF::AppSession->create( $service );
 173
 174         my $request = $session->request( $method, @params );
 175
 176         my $val;
 177         my $err;
 178         try  {
 179
 180                 $val = $request->gather(1);
 181
 182         } catch Error with {
 183                 $err = shift;
 184         };
 185
 186         if( $err ) {
 187                 warn "received error : service=$service : method=$method : params=".Dumper(\@params) . "\n $err";
 188                 throw $err ("Call to $service for method $method \n failed with exception: $err : " );
 189         }
 190
 191         return $val;
 192 }
 193
 194 sub build_org_tree {
 195         my( $self, $orglist ) = @_;
 196
 197         return $orglist unless ref $orglist;
 198     return $$orglist[0] if @$orglist == 1;
 199
 200         my @list = sort {
 201                 $a->ou_type <=> $b->ou_type ||
 202                 $a->name cmp $b->name } @$orglist;
 203
 204         for my $org (@list) {
 205
 206                 next unless ($org);
 207         next if (!defined($org->parent_ou) || $org->parent_ou eq "");
 208
 209                 my ($parent) = grep { $_->id == $org->parent_ou } @list;
 210                 next unless $parent;
 211                 $parent->children([]) unless defined($parent->children);
 212                 push( @{$parent->children}, $org );
 213         }
 214
 215         return $list[0];
 216 }
 217
 218 sub fetch_closed_date {
 219         my( $self, $cd ) = @_;
 220         my $evt;
 221
 222         $logger->debug("Fetching closed_date $cd from cstore");
 223
 224         my $cd_obj = $self->simplereq(
 225                 'open-ils.cstore',
 226                 'open-ils.cstore.direct.actor.org_unit.closed_date.retrieve', $cd );
 227
 228         if(!$cd_obj) {
 229                 $logger->info("closed_date $cd not found in the db");
 230                 $evt = OpenILS::Event->new('ACTOR_USER_NOT_FOUND');
 231         }
 232
 233         return ($cd_obj, $evt);
 234 }
 235
 236 sub fetch_user {
 237         my( $self, $userid ) = @_;
 238         my( $user, $evt );
 239
 240         $logger->debug("Fetching user $userid from cstore");
 241
 242         $user = $self->simplereq(
 243                 'open-ils.cstore',
 244                 'open-ils.cstore.direct.actor.user.retrieve', $userid );
 245
 246         if(!$user) {
 247                 $logger->info("User $userid not found in the db");
 248                 $evt = OpenILS::Event->new('ACTOR_USER_NOT_FOUND');
 249         }
 250
 251         return ($user, $evt);
 252 }
 253
 254 sub checkses {
 255         my( $self, $session ) = @_;
 256         my $user = $self->check_user_session($session) or
 257         return (undef, OpenILS::Event->new('NO_SESSION'));
 258     return ($user);
 259 }
 260
 261
 262 # verifiese the session and checks the permissions agains the
 263 # session user and the user's home_ou as the org id
 264 sub checksesperm {
 265         my( $self, $session, @perms ) = @_;
 266         my $user; my $evt; my $e;
 267         $logger->debug("Checking user session $session and perms @perms");
 268         ($user, $evt) = $self->checkses($session);
 269         return (undef, $evt) if $evt;
 270         $evt = $self->check_perms($user->id, $user->home_ou, @perms);
 271         return ($user, $evt);
 272 }
 273
 274
 275 sub checkrequestor {
 276         my( $self, $staffobj, $userid, @perms ) = @_;
 277         my $user; my $evt;
 278         $userid = $staffobj->id unless defined $userid;
 279
 280         $logger->debug("checkrequestor(): requestor => " . $staffobj->id . ", target => $userid");
 281
 282         if( $userid ne $staffobj->id ) {
 283                 ($user, $evt) = $self->fetch_user($userid);
 284                 return (undef, $evt) if $evt;
 285                 $evt = $self->check_perms( $staffobj->id, $user->home_ou, @perms );
 286
 287         } else {
 288                 $user = $staffobj;
 289         }
 290
 291         return ($user, $evt);
 292 }
 293
 294 sub checkses_requestor {
 295         my( $self, $authtoken, $targetid, @perms ) = @_;
 296         my( $requestor, $target, $evt );
 297
 298         ($requestor, $evt) = $self->checkses($authtoken);
 299         return (undef, undef, $evt) if $evt;
 300
 301         ($target, $evt) = $self->checkrequestor( $requestor, $targetid, @perms );
 302         return( $requestor, $target, $evt);
 303 }
 304
 305 sub fetch_copy {
 306         my( $self, $copyid ) = @_;
 307         my( $copy, $evt );
 308
 309         $logger->debug("Fetching copy $copyid from cstore");
 310
 311         $copy = $self->simplereq(
 312                 'open-ils.cstore',
 313                 'open-ils.cstore.direct.asset.copy.retrieve', $copyid );
 314
 315         if(!$copy) { $evt = OpenILS::Event->new('ASSET_COPY_NOT_FOUND'); }
 316
 317         return( $copy, $evt );
 318 }
 319
 320
 321 # retrieves a circ object by id
 322 sub fetch_circulation {
 323         my( $self, $circid ) = @_;
 324         my $circ; my $evt;
 325
 326         $logger->debug("Fetching circ $circid from cstore");
 327
 328         $circ = $self->simplereq(
 329                 'open-ils.cstore',
 330                 "open-ils.cstore.direct.action.circulation.retrieve", $circid );
 331
 332         if(!$circ) {
 333                 $evt = OpenILS::Event->new('ACTION_CIRCULATION_NOT_FOUND', circid => $circid );
 334         }
 335
 336         return ( $circ, $evt );
 337 }
 338
 339 sub fetch_record_by_copy {
 340         my( $self, $copyid ) = @_;
 341         my( $record, $evt );
 342
 343         $logger->debug("Fetching record by copy $copyid from cstore");
 344
 345         $record = $self->simplereq(
 346                 'open-ils.cstore',
 347                 'open-ils.cstore.direct.asset.copy.retrieve', $copyid,
 348                 { flesh => 3,
 349                   flesh_fields => {     bre => [ 'fixed_fields' ],
 350                                         acn => [ 'record' ],
 351                                         acp => [ 'call_number' ],
 352                                   }
 353                 }
 354         );
 355
 356         if(!$record) {
 357                 $evt = OpenILS::Event->new('BIBLIO_RECORD_ENTRY_NOT_FOUND');
 358         } else {
 359                 $record = $record->call_number->record;
 360         }
 361
 362         return ($record, $evt);
 363 }
 364
 365 # turns a record object into an mvr (mods) object
 366 sub record_to_mvr {
 367         my( $self, $record ) = @_;
 368         return undef unless $record and $record->marc;
 369         my $u = OpenILS::Utils::ModsParser->new();
 370         $u->start_mods_batch( $record->marc );
 371         my $mods = $u->finish_mods_batch();
 372         $mods->doc_id($record->id);
 373    $mods->tcn($record->tcn_value);
 374         return $mods;
 375 }
 376
 377 sub fetch_hold {
 378         my( $self, $holdid ) = @_;
 379         my( $hold, $evt );
 380
 381         $logger->debug("Fetching hold $holdid from cstore");
 382
 383         $hold = $self->simplereq(
 384                 'open-ils.cstore',
 385                 'open-ils.cstore.direct.action.hold_request.retrieve', $holdid);
 386
 387         $evt = OpenILS::Event->new('ACTION_HOLD_REQUEST_NOT_FOUND', holdid => $holdid) unless $hold;
 388
 389         return ($hold, $evt);
 390 }
 391
 392
 393 sub fetch_hold_transit_by_hold {
 394         my( $self, $holdid ) = @_;
 395         my( $transit, $evt );
 396
 397         $logger->debug("Fetching transit by hold $holdid from cstore");
 398
 399         $transit = $self->simplereq(
 400                 'open-ils.cstore',
 401                 'open-ils.cstore.direct.action.hold_transit_copy.search', { hold => $holdid } );
 402
 403         $evt = OpenILS::Event->new('ACTION_HOLD_TRANSIT_COPY_NOT_FOUND', holdid => $holdid) unless $transit;
 404
 405         return ($transit, $evt );
 406 }
 407
 408 # fetches the captured, but not fulfilled hold attached to a given copy
 409 sub fetch_open_hold_by_copy {
 410         my( $self, $copyid ) = @_;
 411         $logger->debug("Searching for active hold for copy $copyid");
 412         my( $hold, $evt );
 413
 414         $hold = $self->cstorereq(
 415                 'open-ils.cstore.direct.action.hold_request.search',
 416                 {
 417                         current_copy            => $copyid ,
 418                         capture_time            => { "!=" => undef },
 419                         fulfillment_time        => undef,
 420                         cancel_time                     => undef,
 421                 } );
 422
 423         $evt = OpenILS::Event->new('ACTION_HOLD_REQUEST_NOT_FOUND', copyid => $copyid) unless $hold;
 424         return ($hold, $evt);
 425 }
 426
 427 sub fetch_hold_transit {
 428         my( $self, $transid ) = @_;
 429         my( $htransit, $evt );
 430         $logger->debug("Fetching hold transit with hold id $transid");
 431         $htransit = $self->cstorereq(
 432                 'open-ils.cstore.direct.action.hold_transit_copy.retrieve', $transid );
 433         $evt = OpenILS::Event->new('ACTION_HOLD_TRANSIT_COPY_NOT_FOUND', id => $transid) unless $htransit;
 434         return ($htransit, $evt);
 435 }
 436
 437 sub fetch_copy_by_barcode {
 438         my( $self, $barcode ) = @_;
 439         my( $copy, $evt );
 440
 441         $logger->debug("Fetching copy by barcode $barcode from cstore");
 442
 443         $copy = $self->simplereq( 'open-ils.cstore',
 444                 'open-ils.cstore.direct.asset.copy.search', { barcode => $barcode, deleted => 'f'} );
 445                 #'open-ils.storage.direct.asset.copy.search.barcode', $barcode );
 446
 447         $evt = OpenILS::Event->new('ASSET_COPY_NOT_FOUND', barcode => $barcode) unless $copy;
 448
 449         return ($copy, $evt);
 450 }
 451
 452 sub fetch_open_billable_transaction {
 453         my( $self, $transid ) = @_;
 454         my( $transaction, $evt );
 455
 456         $logger->debug("Fetching open billable transaction $transid from cstore");
 457
 458         $transaction = $self->simplereq(
 459                 'open-ils.cstore',
 460                 'open-ils.cstore.direct.money.open_billable_transaction_summary.retrieve',  $transid);
 461
 462         $evt = OpenILS::Event->new(
 463                 'MONEY_OPEN_BILLABLE_TRANSACTION_SUMMARY_NOT_FOUND', transid => $transid ) unless $transaction;
 464
 465         return ($transaction, $evt);
 466 }
 467
 468
 469
 470 my %buckets;
 471 $buckets{'biblio'} = 'biblio_record_entry_bucket';
 472 $buckets{'callnumber'} = 'call_number_bucket';
 473 $buckets{'copy'} = 'copy_bucket';
 474 $buckets{'user'} = 'user_bucket';
 475
 476 sub fetch_container {
 477         my( $self, $id, $type ) = @_;
 478         my( $bucket, $evt );
 479
 480         $logger->debug("Fetching container $id with type $type");
 481
 482         my $e = 'CONTAINER_CALL_NUMBER_BUCKET_NOT_FOUND';
 483         $e = 'CONTAINER_BIBLIO_RECORD_ENTRY_BUCKET_NOT_FOUND' if $type eq 'biblio';
 484         $e = 'CONTAINER_USER_BUCKET_NOT_FOUND' if $type eq 'user';
 485         $e = 'CONTAINER_COPY_BUCKET_NOT_FOUND' if $type eq 'copy';
 486
 487         my $meth = $buckets{$type};
 488         $bucket = $self->simplereq(
 489                 'open-ils.cstore',
 490                 "open-ils.cstore.direct.container.$meth.retrieve", $id );
 491
 492         $evt = OpenILS::Event->new(
 493                 $e, container => $id, container_type => $type ) unless $bucket;
 494
 495         return ($bucket, $evt);
 496 }
 497
 498
 499 sub fetch_container_e {
 500         my( $self, $editor, $id, $type ) = @_;
 501
 502         my( $bucket, $evt );
 503         $bucket = $editor->retrieve_container_copy_bucket($id) if $type eq 'copy';
 504         $bucket = $editor->retrieve_container_call_number_bucket($id) if $type eq 'callnumber';
 505         $bucket = $editor->retrieve_container_biblio_record_entry_bucket($id) if $type eq 'biblio';
 506         $bucket = $editor->retrieve_container_user_bucket($id) if $type eq 'user';
 507
 508         $evt = $editor->event unless $bucket;
 509         return ($bucket, $evt);
 510 }
 511
 512 sub fetch_container_item_e {
 513         my( $self, $editor, $id, $type ) = @_;
 514
 515         my( $bucket, $evt );
 516         $bucket = $editor->retrieve_container_copy_bucket_item($id) if $type eq 'copy';
 517         $bucket = $editor->retrieve_container_call_number_bucket_item($id) if $type eq 'callnumber';
 518         $bucket = $editor->retrieve_container_biblio_record_entry_bucket_item($id) if $type eq 'biblio';
 519         $bucket = $editor->retrieve_container_user_bucket_item($id) if $type eq 'user';
 520
 521         $evt = $editor->event unless $bucket;
 522         return ($bucket, $evt);
 523 }
 524
 525
 526
 527
 528
 529 sub fetch_container_item {
 530         my( $self, $id, $type ) = @_;
 531         my( $bucket, $evt );
 532
 533         $logger->debug("Fetching container item $id with type $type");
 534
 535         my $meth = $buckets{$type} . "_item";
 536
 537         $bucket = $self->simplereq(
 538                 'open-ils.cstore',
 539                 "open-ils.cstore.direct.container.$meth.retrieve", $id );
 540
 541
 542         my $e = 'CONTAINER_CALL_NUMBER_BUCKET_ITEM_NOT_FOUND';
 543         $e = 'CONTAINER_BIBLIO_RECORD_ENTRY_BUCKET_ITEM_NOT_FOUND' if $type eq 'biblio';
 544         $e = 'CONTAINER_USER_BUCKET_ITEM_NOT_FOUND' if $type eq 'user';
 545         $e = 'CONTAINER_COPY_BUCKET_ITEM_NOT_FOUND' if $type eq 'copy';
 546
 547         $evt = OpenILS::Event->new(
 548                 $e, itemid => $id, container_type => $type ) unless $bucket;
 549
 550         return ($bucket, $evt);
 551 }
 552
 553
 554 sub fetch_patron_standings {
 555         my $self = shift;
 556         $logger->debug("Fetching patron standings");
 557         return $self->simplereq(
 558                 'open-ils.cstore',
 559                 'open-ils.cstore.direct.config.standing.search.atomic', { id => { '!=' => undef } });
 560 }
 561
 562
 563 sub fetch_permission_group_tree {
 564         my $self = shift;
 565         $logger->debug("Fetching patron profiles");
 566         return $self->simplereq(
 567                 'open-ils.actor',
 568                 'open-ils.actor.groups.tree.retrieve' );
 569 }
 570
 571 sub fetch_permission_group_descendants {
 572     my( $self, $profile ) = @_;
 573     my $group_tree = $self->fetch_permission_group_tree();
 574     my $start_here;
 575     my @groups;
 576
 577     # FIXME: okay, so it's not an org tree, but it is compatible
 578     $self->walk_org_tree($group_tree, sub {
 579         my $g = shift;
 580         if ($g->id == $profile) {
 581             $start_here = $g;
 582         }
 583     });
 584
 585     $self->walk_org_tree($start_here, sub {
 586         my $g = shift;
 587         push(@groups,$g->id);
 588     });
 589
 590     return \@groups;
 591 }
 592
 593 sub fetch_patron_circ_summary {
 594         my( $self, $userid ) = @_;
 595         $logger->debug("Fetching patron summary for $userid");
 596         my $summary = $self->simplereq(
 597                 'open-ils.storage',
 598                 "open-ils.storage.action.circulation.patron_summary", $userid );
 599
 600         if( $summary ) {
 601                 $summary->[0] ||= 0;
 602                 $summary->[1] ||= 0.0;
 603                 return $summary;
 604         }
 605         return undef;
 606 }
 607
 608
 609 sub fetch_copy_statuses {
 610         my( $self ) = @_;
 611         $logger->debug("Fetching copy statuses");
 612         return $self->simplereq(
 613                 'open-ils.cstore',
 614                 'open-ils.cstore.direct.config.copy_status.search.atomic', { id => { '!=' => undef } });
 615 }
 616
 617 sub fetch_copy_location {
 618         my( $self, $id ) = @_;
 619         my $evt;
 620         my $cl = $self->cstorereq(
 621                 'open-ils.cstore.direct.asset.copy_location.retrieve', $id );
 622         $evt = OpenILS::Event->new('ASSET_COPY_LOCATION_NOT_FOUND') unless $cl;
 623         return ($cl, $evt);
 624 }
 625
 626 sub fetch_copy_locations {
 627         my $self = shift;
 628         return $self->simplereq(
 629                 'open-ils.cstore',
 630                 'open-ils.cstore.direct.asset.copy_location.search.atomic', { id => { '!=' => undef } });
 631 }
 632
 633 sub fetch_copy_location_by_name {
 634         my( $self, $name, $org ) = @_;
 635         my $evt;
 636         my $cl = $self->cstorereq(
 637                 'open-ils.cstore.direct.asset.copy_location.search',
 638                         { name => $name, owning_lib => $org } );
 639         $evt = OpenILS::Event->new('ASSET_COPY_LOCATION_NOT_FOUND') unless $cl;
 640         return ($cl, $evt);
 641 }
 642
 643 sub fetch_callnumber {
 644         my( $self, $id, $flesh, $e ) = @_;
 645
 646         $e ||= OpenILS::Utils::CStoreEditor->new;
 647
 648         my $evt = OpenILS::Event->new( 'ASSET_CALL_NUMBER_NOT_FOUND', id => $id );
 649         return( undef, $evt ) unless $id;
 650
 651         $logger->debug("Fetching callnumber $id");
 652
 653     my $cn = $e->retrieve_asset_call_number([
 654         $id,
 655         { flesh => $flesh, flesh_fields => { acn => [ 'prefix', 'suffix', 'label_class' ] } },
 656     ]);
 657
 658         return ( $cn, $e->event );
 659 }
 660
 661 my %ORG_CACHE; # - these rarely change, so cache them..
 662 sub fetch_org_unit {
 663         my( $self, $id ) = @_;
 664         return undef unless $id;
 665         return $id if( ref($id) eq 'Fieldmapper::actor::org_unit' );
 666         return $ORG_CACHE{$id} if $ORG_CACHE{$id};
 667         $logger->debug("Fetching org unit $id");
 668         my $evt = undef;
 669
 670         my $org = $self->simplereq(
 671                 'open-ils.cstore',
 672                 'open-ils.cstore.direct.actor.org_unit.retrieve', $id );
 673         $evt = OpenILS::Event->new( 'ACTOR_ORG_UNIT_NOT_FOUND', id => $id ) unless $org;
 674         $ORG_CACHE{$id}  = $org;
 675
 676         return ($org, $evt);
 677 }
 678
 679 sub fetch_stat_cat {
 680         my( $self, $type, $id ) = @_;
 681         my( $cat, $evt );
 682         $logger->debug("Fetching $type stat cat: $id");
 683         $cat = $self->simplereq(
 684                 'open-ils.cstore',
 685                 "open-ils.cstore.direct.$type.stat_cat.retrieve", $id );
 686
 687         my $e = 'ASSET_STAT_CAT_NOT_FOUND';
 688         $e = 'ACTOR_STAT_CAT_NOT_FOUND' if $type eq 'actor';
 689
 690         $evt = OpenILS::Event->new( $e, id => $id ) unless $cat;
 691         return ( $cat, $evt );
 692 }
 693
 694 sub fetch_stat_cat_entry {
 695         my( $self, $type, $id ) = @_;
 696         my( $entry, $evt );
 697         $logger->debug("Fetching $type stat cat entry: $id");
 698         $entry = $self->simplereq(
 699                 'open-ils.cstore',
 700                 "open-ils.cstore.direct.$type.stat_cat_entry.retrieve", $id );
 701
 702         my $e = 'ASSET_STAT_CAT_ENTRY_NOT_FOUND';
 703         $e = 'ACTOR_STAT_CAT_ENTRY_NOT_FOUND' if $type eq 'actor';
 704
 705         $evt = OpenILS::Event->new( $e, id => $id ) unless $entry;
 706         return ( $entry, $evt );
 707 }
 708
 709 sub fetch_stat_cat_entry_default {
 710     my( $self, $type, $id ) = @_;
 711     my( $entry_default, $evt );
 712     $logger->debug("Fetching $type stat cat entry default: $id");
 713     $entry_default = $self->simplereq(
 714         'open-ils.cstore',
 715         "open-ils.cstore.direct.$type.stat_cat_entry_default.retrieve", $id );
 716
 717     my $e = 'ASSET_STAT_CAT_ENTRY_DEFAULT_NOT_FOUND';
 718     $e = 'ACTOR_STAT_CAT_ENTRY_DEFAULT_NOT_FOUND' if $type eq 'actor';
 719
 720     $evt = OpenILS::Event->new( $e, id => $id ) unless $entry_default;
 721     return ( $entry_default, $evt );
 722 }
 723
 724 sub fetch_stat_cat_entry_default_by_stat_cat_and_org {
 725     my( $self, $type, $stat_cat, $orgId ) = @_;
 726     my $entry_default;
 727     $logger->info("### Fetching $type stat cat entry default with stat_cat $stat_cat owned by org_unit $orgId");
 728     $entry_default = $self->simplereq(
 729         'open-ils.cstore',
 730         "open-ils.cstore.direct.$type.stat_cat_entry_default.search.atomic",
 731         { stat_cat => $stat_cat, owner => $orgId } );
 732
 733     $entry_default = $entry_default->[0];
 734     return ($entry_default, undef) if $entry_default;
 735
 736     my $e = 'ASSET_STAT_CAT_ENTRY_DEFAULT_NOT_FOUND';
 737     $e = 'ACTOR_STAT_CAT_ENTRY_DEFAULT_NOT_FOUND' if $type eq 'actor';
 738     return (undef, OpenILS::Event->new($e) );
 739 }
 740
 741 sub find_org {
 742         my( $self, $org_tree, $orgid )  = @_;
 743     return undef unless $org_tree and defined $orgid;
 744         return $org_tree if ( $org_tree->id eq $orgid );
 745         return undef unless ref($org_tree->children);
 746         for my $c (@{$org_tree->children}) {
 747                 my $o = $self->find_org($c, $orgid);
 748                 return $o if $o;
 749         }
 750         return undef;
 751 }
 752
 753 sub fetch_non_cat_type_by_name_and_org {
 754         my( $self, $name, $orgId ) = @_;
 755         $logger->debug("Fetching non cat type $name at org $orgId");
 756         my $types = $self->simplereq(
 757                 'open-ils.cstore',
 758                 'open-ils.cstore.direct.config.non_cataloged_type.search.atomic',
 759                 { name => $name, owning_lib => $orgId } );
 760         return ($types->[0], undef) if($types and @$types);
 761         return (undef, OpenILS::Event->new('CONFIG_NON_CATALOGED_TYPE_NOT_FOUND') );
 762 }
 763
 764 sub fetch_non_cat_type {
 765         my( $self, $id ) = @_;
 766         $logger->debug("Fetching non cat type $id");
 767         my( $type, $evt );
 768         $type = $self->simplereq(
 769                 'open-ils.cstore',
 770                 'open-ils.cstore.direct.config.non_cataloged_type.retrieve', $id );
 771         $evt = OpenILS::Event->new('CONFIG_NON_CATALOGED_TYPE_NOT_FOUND') unless $type;
 772         return ($type, $evt);
 773 }
 774
 775 sub DB_UPDATE_FAILED {
 776         my( $self, $payload ) = @_;
 777         return OpenILS::Event->new('DATABASE_UPDATE_FAILED',
 778                 payload => ($payload) ? $payload : undef );
 779 }
 780
 781 sub fetch_booking_reservation {
 782         my( $self, $id ) = @_;
 783         my( $res, $evt );
 784
 785         $res = $self->simplereq(
 786                 'open-ils.cstore',
 787                 'open-ils.cstore.direct.booking.reservation.retrieve', $id
 788         );
 789
 790         # simplereq doesn't know how to flesh so ...
 791         if ($res) {
 792                 $res->usr(
 793                         $self->simplereq(
 794                                 'open-ils.cstore',
 795                                 'open-ils.cstore.direct.actor.user.retrieve', $res->usr
 796                         )
 797                 );
 798
 799                 $res->target_resource_type(
 800                         $self->simplereq(
 801                                 'open-ils.cstore',
 802                                 'open-ils.cstore.direct.booking.resource_type.retrieve', $res->target_resource_type
 803                         )
 804                 );
 805
 806                 if ($res->current_resource) {
 807                         $res->current_resource(
 808                                 $self->simplereq(
 809                                         'open-ils.cstore',
 810                                         'open-ils.cstore.direct.booking.resource.retrieve', $res->current_resource
 811                                 )
 812                         );
 813
 814                         if ($self->is_true( $res->target_resource_type->catalog_item )) {
 815                                 $res->current_resource->catalog_item( $self->fetch_copy_by_barcode( $res->current_resource->barcode ) );
 816                         }
 817                 }
 818
 819                 if ($res->target_resource) {
 820                         $res->target_resource(
 821                                 $self->simplereq(
 822                                         'open-ils.cstore',
 823                                         'open-ils.cstore.direct.booking.resource.retrieve', $res->target_resource
 824                                 )
 825                         );
 826
 827                         if ($self->is_true( $res->target_resource_type->catalog_item )) {
 828                                 $res->target_resource->catalog_item( $self->fetch_copy_by_barcode( $res->target_resource->barcode ) );
 829                         }
 830                 }
 831
 832         } else {
 833                 $evt = OpenILS::Event->new('RESERVATION_NOT_FOUND');
 834         }
 835
 836         return ($res, $evt);
 837 }
 838
 839 sub fetch_circ_duration_by_name {
 840         my( $self, $name ) = @_;
 841         my( $dur, $evt );
 842         $dur = $self->simplereq(
 843                 'open-ils.cstore',
 844                 'open-ils.cstore.direct.config.rules.circ_duration.search.atomic', { name => $name } );
 845         $dur = $dur->[0];
 846         $evt = OpenILS::Event->new('CONFIG_RULES_CIRC_DURATION_NOT_FOUND') unless $dur;
 847         return ($dur, $evt);
 848 }
 849
 850 sub fetch_recurring_fine_by_name {
 851         my( $self, $name ) = @_;
 852         my( $obj, $evt );
 853         $obj = $self->simplereq(
 854                 'open-ils.cstore',
 855                 'open-ils.cstore.direct.config.rules.recurring_fine.search.atomic', { name => $name } );
 856         $obj = $obj->[0];
 857         $evt = OpenILS::Event->new('CONFIG_RULES_RECURRING_FINE_NOT_FOUND') unless $obj;
 858         return ($obj, $evt);
 859 }
 860
 861 sub fetch_max_fine_by_name {
 862         my( $self, $name ) = @_;
 863         my( $obj, $evt );
 864         $obj = $self->simplereq(
 865                 'open-ils.cstore',
 866                 'open-ils.cstore.direct.config.rules.max_fine.search.atomic', { name => $name } );
 867         $obj = $obj->[0];
 868         $evt = OpenILS::Event->new('CONFIG_RULES_MAX_FINE_NOT_FOUND') unless $obj;
 869         return ($obj, $evt);
 870 }
 871
 872 sub fetch_hard_due_date_by_name {
 873         my( $self, $name ) = @_;
 874         my( $obj, $evt );
 875         $obj = $self->simplereq(
 876                 'open-ils.cstore',
 877                 'open-ils.cstore.direct.config.hard_due_date.search.atomic', { name => $name } );
 878         $obj = $obj->[0];
 879         $evt = OpenILS::Event->new('CONFIG_RULES_HARD_DUE_DATE_NOT_FOUND') unless $obj;
 880         return ($obj, $evt);
 881 }
 882
 883 sub storagereq {
 884         my( $self, $method, @params ) = @_;
 885         return $self->simplereq(
 886                 'open-ils.storage', $method, @params );
 887 }
 888
 889 sub storagereq_xact {
 890         my($self, $method, @params) = @_;
 891         my $ses = $self->start_db_session();
 892         my $val = $ses->request($method, @params)->gather(1);
 893         $self->rollback_db_session($ses);
 894     return $val;
 895 }
 896
 897 sub cstorereq {
 898         my( $self, $method, @params ) = @_;
 899         return $self->simplereq(
 900                 'open-ils.cstore', $method, @params );
 901 }
 902
 903 sub event_equals {
 904         my( $self, $e, $name ) =  @_;
 905         if( $e and ref($e) eq 'HASH' and
 906                 defined($e->{textcode}) and $e->{textcode} eq $name ) {
 907                 return 1 ;
 908         }
 909         return 0;
 910 }
 911
 912 sub logmark {
 913         my( undef, $f, $l ) = caller(0);
 914         my( undef, undef, undef, $s ) = caller(1);
 915         $s =~ s/.*:://g;
 916         $f =~ s/.*\///g;
 917         $logger->debug("LOGMARK: $f:$l:$s");
 918 }
 919
 920 # takes a copy id
 921 sub fetch_open_circulation {
 922         my( $self, $cid ) = @_;
 923         $self->logmark;
 924
 925         my $e = OpenILS::Utils::CStoreEditor->new;
 926     my $circ = $e->search_action_circulation({
 927         target_copy => $cid,
 928         stop_fines_time => undef,
 929         checkin_time => undef
 930     })->[0];
 931
 932     return ($circ, $e->event);
 933 }
 934
 935 my $copy_statuses;
 936 sub copy_status_from_name {
 937         my( $self, $name ) = @_;
 938         $copy_statuses = $self->fetch_copy_statuses unless $copy_statuses;
 939         for my $status (@$copy_statuses) {
 940                 return $status if( $status->name =~ /$name/i );
 941         }
 942         return undef;
 943 }
 944
 945 sub copy_status_to_name {
 946         my( $self, $sid ) = @_;
 947         $copy_statuses = $self->fetch_copy_statuses unless $copy_statuses;
 948         for my $status (@$copy_statuses) {
 949                 return $status->name if( $status->id == $sid );
 950         }
 951         return undef;
 952 }
 953
 954
 955 sub copy_status {
 956         my( $self, $arg ) = @_;
 957         return $arg if ref $arg;
 958         $copy_statuses = $self->fetch_copy_statuses unless $copy_statuses;
 959         my ($stat) = grep { $_->id == $arg } @$copy_statuses;
 960         return $stat;
 961 }
 962
 963 sub fetch_open_transit_by_copy {
 964         my( $self, $copyid ) = @_;
 965         my($transit, $evt);
 966         $transit = $self->cstorereq(
 967                 'open-ils.cstore.direct.action.transit_copy.search',
 968                 { target_copy => $copyid, dest_recv_time => undef });
 969         $evt = OpenILS::Event->new('ACTION_TRANSIT_COPY_NOT_FOUND') unless $transit;
 970         return ($transit, $evt);
 971 }
 972
 973 sub unflesh_copy {
 974         my( $self, $copy ) = @_;
 975         return undef unless $copy;
 976         $copy->status( $copy->status->id ) if ref($copy->status);
 977         $copy->location( $copy->location->id ) if ref($copy->location);
 978         $copy->circ_lib( $copy->circ_lib->id ) if ref($copy->circ_lib);
 979         return $copy;
 980 }
 981
 982 sub unflesh_reservation {
 983         my( $self, $reservation ) = @_;
 984         return undef unless $reservation;
 985         $reservation->usr( $reservation->usr->id ) if ref($reservation->usr);
 986         $reservation->target_resource_type( $reservation->target_resource_type->id ) if ref($reservation->target_resource_type);
 987         $reservation->target_resource( $reservation->target_resource->id ) if ref($reservation->target_resource);
 988         $reservation->current_resource( $reservation->current_resource->id ) if ref($reservation->current_resource);
 989         return $reservation;
 990 }
 991
 992 # un-fleshes a copy and updates it in the DB
 993 # returns a DB_UPDATE_FAILED event on error
 994 # returns undef on success
 995 sub update_copy {
 996         my( $self, %params ) = @_;
 997
 998         my $copy                = $params{copy} || die "update_copy(): copy required";
 999         my $editor      = $params{editor} || die "update_copy(): copy editor required";
1000         my $session = $params{session};
1001
1002         $logger->debug("Updating copy in the database: " . $copy->id);
1003
1004         $self->unflesh_copy($copy);
1005         $copy->editor( $editor );
1006         $copy->edit_date( 'now' );
1007
1008         my $s;
1009         my $meth = 'open-ils.storage.direct.asset.copy.update';
1010
1011         $s = $session->request( $meth, $copy )->gather(1) if $session;
1012         $s = $self->storagereq( $meth, $copy ) unless $session;
1013
1014         $logger->debug("Update of copy ".$copy->id." returned: $s");
1015
1016         return $self->DB_UPDATE_FAILED($copy) unless $s;
1017         return undef;
1018 }
1019
1020 sub update_reservation {
1021         my( $self, %params ) = @_;
1022
1023         my $reservation = $params{reservation}  || die "update_reservation(): reservation required";
1024         my $editor              = $params{editor} || die "update_reservation(): copy editor required";
1025         my $session             = $params{session};
1026
1027         $logger->debug("Updating copy in the database: " . $reservation->id);
1028
1029         $self->unflesh_reservation($reservation);
1030
1031         my $s;
1032         my $meth = 'open-ils.cstore.direct.booking.reservation.update';
1033
1034         $s = $session->request( $meth, $reservation )->gather(1) if $session;
1035         $s = $self->cstorereq( $meth, $reservation ) unless $session;
1036
1037         $logger->debug("Update of copy ".$reservation->id." returned: $s");
1038
1039         return $self->DB_UPDATE_FAILED($reservation) unless $s;
1040         return undef;
1041 }
1042
1043 sub fetch_billable_xact {
1044         my( $self, $id ) = @_;
1045         my($xact, $evt);
1046         $logger->debug("Fetching billable transaction %id");
1047         $xact = $self->cstorereq(
1048                 'open-ils.cstore.direct.money.billable_transaction.retrieve', $id );
1049         $evt = OpenILS::Event->new('MONEY_BILLABLE_TRANSACTION_NOT_FOUND') unless $xact;
1050         return ($xact, $evt);
1051 }
1052
1053 sub fetch_billable_xact_summary {
1054         my( $self, $id ) = @_;
1055         my($xact, $evt);
1056         $logger->debug("Fetching billable transaction summary %id");
1057         $xact = $self->cstorereq(
1058                 'open-ils.cstore.direct.money.billable_transaction_summary.retrieve', $id );
1059         $evt = OpenILS::Event->new('MONEY_BILLABLE_TRANSACTION_NOT_FOUND') unless $xact;
1060         return ($xact, $evt);
1061 }
1062
1063 sub fetch_fleshed_copy {
1064         my( $self, $id ) = @_;
1065         my( $copy, $evt );
1066         $logger->info("Fetching fleshed copy $id");
1067         $copy = $self->cstorereq(
1068                 "open-ils.cstore.direct.asset.copy.retrieve", $id,
1069                 { flesh => 1,
1070                   flesh_fields => { acp => [ qw/ circ_lib location status stat_cat_entries / ] }
1071                 }
1072         );
1073         $evt = OpenILS::Event->new('ASSET_COPY_NOT_FOUND', id => $id) unless $copy;
1074         return ($copy, $evt);
1075 }
1076
1077
1078 # returns the org that owns the callnumber that the copy
1079 # is attached to
1080 sub fetch_copy_owner {
1081         my( $self, $copyid ) = @_;
1082         my( $copy, $cn, $evt );
1083         $logger->debug("Fetching copy owner $copyid");
1084         ($copy, $evt) = $self->fetch_copy($copyid);
1085         return (undef,$evt) if $evt;
1086         ($cn, $evt) = $self->fetch_callnumber($copy->call_number);
1087         return (undef,$evt) if $evt;
1088         return ($cn->owning_lib);
1089 }
1090
1091 sub fetch_copy_note {
1092         my( $self, $id ) = @_;
1093         my( $note, $evt );
1094         $logger->debug("Fetching copy note $id");
1095         $note = $self->cstorereq(
1096                 'open-ils.cstore.direct.asset.copy_note.retrieve', $id );
1097         $evt = OpenILS::Event->new('ASSET_COPY_NOTE_NOT_FOUND', id => $id ) unless $note;
1098         return ($note, $evt);
1099 }
1100
1101 sub fetch_call_numbers_by_title {
1102         my( $self, $titleid ) = @_;
1103         $logger->info("Fetching call numbers by title $titleid");
1104         return $self->cstorereq(
1105                 'open-ils.cstore.direct.asset.call_number.search.atomic',
1106                 { record => $titleid, deleted => 'f' });
1107                 #'open-ils.storage.direct.asset.call_number.search.record.atomic', $titleid);
1108 }
1109
1110 sub fetch_copies_by_call_number {
1111         my( $self, $cnid ) = @_;
1112         $logger->info("Fetching copies by call number $cnid");
1113         return $self->cstorereq(
1114                 'open-ils.cstore.direct.asset.copy.search.atomic', { call_number => $cnid, deleted => 'f' } );
1115                 #'open-ils.storage.direct.asset.copy.search.call_number.atomic', $cnid );
1116 }
1117
1118 sub fetch_user_by_barcode {
1119         my( $self, $bc ) = @_;
1120         my $cardid = $self->cstorereq(
1121                 'open-ils.cstore.direct.actor.card.id_list', { barcode => $bc } );
1122         return (undef, OpenILS::Event->new('ACTOR_CARD_NOT_FOUND', barcode => $bc)) unless $cardid;
1123         my $user = $self->cstorereq(
1124                 'open-ils.cstore.direct.actor.user.search', { card => $cardid } );
1125         return (undef, OpenILS::Event->new('ACTOR_USER_NOT_FOUND', card => $cardid)) unless $user;
1126         return ($user);
1127
1128 }
1129
1130 sub fetch_bill {
1131         my( $self, $billid ) = @_;
1132         $logger->debug("Fetching billing $billid");
1133         my $bill = $self->cstorereq(
1134                 'open-ils.cstore.direct.money.billing.retrieve', $billid );
1135         my $evt = OpenILS::Event->new('MONEY_BILLING_NOT_FOUND') unless $bill;
1136         return($bill, $evt);
1137 }
1138
1139 sub walk_org_tree {
1140         my( $self, $node, $callback ) = @_;
1141         return unless $node;
1142         $callback->($node);
1143         if( $node->children ) {
1144                 $self->walk_org_tree($_, $callback) for @{$node->children};
1145         }
1146 }
1147
1148 sub is_true {
1149         my( $self, $item ) = @_;
1150         return 1 if $item and $item !~ /^f$/i;
1151         return 0;
1152 }
1153
1154
1155 sub patientreq {
1156     my ($self, $client, $service, $method, @params) = @_;
1157     my ($response, $err);
1158
1159     my $session = create OpenSRF::AppSession($service);
1160     my $request = $session->request($method, @params);
1161
1162     my $spurt = 10;
1163     my $give_up = time + 1000;
1164
1165     try {
1166         while (time < $give_up) {
1167             $response = $request->recv("timeout" => $spurt);
1168             last if $request->complete;
1169
1170             $client->status(new OpenSRF::DomainObject::oilsContinueStatus);
1171         }
1172     } catch Error with {
1173         $err = shift;
1174     };
1175
1176     if ($err) {
1177         warn "received error : service=$service : method=$method : params=".Dumper(\@params) . "\n $err";
1178         throw $err ("Call to $service for method $method \n failed with exception: $err : " );
1179     }
1180
1181     return $response->content;
1182 }
1183
1184 # This logic now lives in storage
1185 sub __patron_money_owed {
1186         my( $self, $patronid ) = @_;
1187         my $ses = OpenSRF::AppSession->create('open-ils.storage');
1188         my $req = $ses->request(
1189                 'open-ils.storage.money.billable_transaction.summary.search',
1190                 { usr => $patronid, xact_finish => undef } );
1191
1192         my $total = 0;
1193         my $data;
1194         while( $data = $req->recv ) {
1195                 $data = $data->content;
1196                 $total += $data->balance_owed;
1197         }
1198         return $total;
1199 }
1200
1201 sub patron_money_owed {
1202         my( $self, $userid ) = @_;
1203         my $ses = $self->start_db_session();
1204         my $val = $ses->request(
1205                 'open-ils.storage.actor.user.total_owed', $userid)->gather(1);
1206         $self->rollback_db_session($ses);
1207         return $val;
1208 }
1209
1210 sub patron_total_items_out {
1211         my( $self, $userid ) = @_;
1212         my $ses = $self->start_db_session();
1213         my $val = $ses->request(
1214                 'open-ils.storage.actor.user.total_out', $userid)->gather(1);
1215         $self->rollback_db_session($ses);
1216         return $val;
1217 }
1218
1219
1220
1221
1222 #---------------------------------------------------------------------
1223 # Returns  ($summary, $event)
1224 #---------------------------------------------------------------------
1225 sub fetch_mbts {
1226         my $self = shift;
1227         my $id  = shift;
1228         my $e = shift || OpenILS::Utils::CStoreEditor->new;
1229         $id = $id->id if ref($id);
1230
1231     my $xact = $e->retrieve_money_billable_transaction_summary($id)
1232             or return (undef, $e->event);
1233
1234     return ($xact);
1235 }
1236
1237
1238 #---------------------------------------------------------------------
1239 # Given a list of money.billable_transaction objects, this creates
1240 # transaction summary objects for each
1241 #--------------------------------------------------------------------
1242 sub make_mbts {
1243         my $self = shift;
1244     my $e = shift;
1245         my @xacts = @_;
1246         return () if (!@xacts);
1247     return @{$e->search_money_billable_transaction_summary({id => [ map { $_->id } @xacts ]})};
1248 }
1249
1250
1251 sub ou_ancestor_setting_value {
1252     my($self, $org_id, $name, $e) = @_;
1253     $e = $e || OpenILS::Utils::CStoreEditor->new;
1254     my $set = $self->ou_ancestor_setting($org_id, $name, $e);
1255     return $set->{value} if $set;
1256     return undef;
1257 }
1258
1259
1260 # If an authentication token is provided AND this org unit setting has a
1261 # view_perm, then make sure the user referenced by the auth token has
1262 # that permission.  This means that if you call this method without an
1263 # authtoken param, you can get whatever org unit setting values you want.
1264 # API users beware.
1265 #
1266 # NOTE: If you supply an editor ($e) arg AND an auth token arg, the editor's
1267 # authtoken is checked, but the $auth arg is NOT checked.  To say that another
1268 # way, be sure NOT to pass an editor argument if you want your token checked.
1269 # Otherwise the auth arg is just a flag saying "check the editor".
1270
1271 sub ou_ancestor_setting {
1272     my( $self, $orgid, $name, $e, $auth ) = @_;
1273     $e = $e || OpenILS::Utils::CStoreEditor->new(
1274         (defined $auth) ? (authtoken => $auth) : ()
1275     );
1276     my $coust = $e->retrieve_config_org_unit_setting_type([
1277         $name, {flesh => 1, flesh_fields => {coust => ['view_perm']}}
1278     ]);
1279
1280     if ($auth && $coust && $coust->view_perm) {
1281         # And you can't have permission if you don't have a valid session.
1282         return undef if not $e->checkauth;
1283         # And now that we know you MIGHT have permission, we check it.
1284         return undef if not $e->allowed($coust->view_perm->code, $orgid);
1285     }
1286
1287     my $query = {from => ['actor.org_unit_ancestor_setting', $name, $orgid]};
1288     my $setting = $e->json_query($query)->[0];
1289     return undef unless $setting;
1290     return {org => $setting->{org_unit}, value => OpenSRF::Utils::JSON->JSON2perl($setting->{value})};
1291 }
1292
1293
1294 # returns the ISO8601 string representation of the requested epoch in GMT
1295 sub epoch2ISO8601 {
1296     my( $self, $epoch ) = @_;
1297     my ($sec,$min,$hour,$mday,$mon,$year) = gmtime($epoch);
1298     $year += 1900; $mon += 1;
1299     my $date = sprintf(
1300         '%s-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d-00',
1301         $year, $mon, $mday, $hour, $min, $sec);
1302     return $date;
1303 }
1304
1305 sub find_highest_perm_org {
1306         my ( $self, $perm, $userid, $start_org, $org_tree ) = @_;
1307         my $org = $self->find_org($org_tree, $start_org );
1308
1309         my $lastid = -1;
1310         while( $org ) {
1311                 last if ($self->check_perms( $userid, $org->id, $perm )); # perm failed
1312                 $lastid = $org->id;
1313                 $org = $self->find_org( $org_tree, $org->parent_ou() );
1314         }
1315
1316         return $lastid;
1317 }
1318
1319
1320 # returns the org_unit ID's
1321 sub user_has_work_perm_at {
1322     my($self, $e, $perm, $options, $user_id) = @_;
1323     $options ||= {};
1324     $user_id = (defined $user_id) ? $user_id : $e->requestor->id;
1325
1326     my $func = 'permission.usr_has_perm_at';
1327     $func = $func.'_all' if $$options{descendants};
1328
1329     my $orgs = $e->json_query({from => [$func, $user_id, $perm]});
1330     $orgs = [map { $_->{ (keys %$_)[0] } } @$orgs];
1331
1332     return $orgs unless $$options{objects};
1333
1334     return $e->search_actor_org_unit({id => $orgs});
1335 }
1336
1337 sub get_user_work_ou_ids {
1338     my($self, $e, $userid) = @_;
1339     my $work_orgs = $e->json_query({
1340         select => {puwoum => ['work_ou']},
1341         from => 'puwoum',
1342         where => {usr => $e->requestor->id}});
1343
1344     return [] unless @$work_orgs;
1345     my @work_orgs;
1346     push(@work_orgs, $_->{work_ou}) for @$work_orgs;
1347
1348     return \@work_orgs;
1349 }
1350
1351
1352 my $org_types;
1353 sub get_org_types {
1354         my($self, $client) = @_;
1355         return $org_types if $org_types;
1356         return $org_types = OpenILS::Utils::CStoreEditor->new->retrieve_all_actor_org_unit_type();
1357 }
1358
1359 my %ORG_TREE;
1360 sub get_org_tree {
1361         my $self = shift;
1362         my $locale = shift || '';
1363         my $cache = OpenSRF::Utils::Cache->new("global", 0);
1364         my $tree = $ORG_TREE{$locale} || $cache->get_cache("orgtree.$locale");
1365         return $tree if $tree;
1366
1367         my $ses = OpenILS::Utils::CStoreEditor->new;
1368         $ses->session->session_locale($locale);
1369         $tree = $ses->search_actor_org_unit(
1370                 [
1371                         {"parent_ou" => undef },
1372                         {
1373                                 flesh                           => -1,
1374                                 flesh_fields    => { aou =>  ['children'] },
1375                                 order_by                        => { aou => 'name'}
1376                         }
1377                 ]
1378         )->[0];
1379
1380     $ORG_TREE{$locale} = $tree;
1381         $cache->put_cache("orgtree.$locale", $tree);
1382         return $tree;
1383 }
1384
1385 sub get_org_descendants {
1386         my($self, $org_id, $depth) = @_;
1387
1388         my $select = {
1389                 transform => 'actor.org_unit_descendants',
1390                 column => 'id',
1391                 result_field => 'id',
1392         };
1393         $select->{params} = [$depth] if defined $depth;
1394
1395         my $org_list = OpenILS::Utils::CStoreEditor->new->json_query({
1396                 select => {aou => [$select]},
1397         from => 'aou',
1398                 where => {id => $org_id}
1399         });
1400         my @orgs;
1401         push(@orgs, $_->{id}) for @$org_list;
1402         return \@orgs;
1403 }
1404
1405 sub get_org_ancestors {
1406         my($self, $org_id, $use_cache) = @_;
1407
1408     my ($cache, $orgs);
1409
1410     if ($use_cache) {
1411         $cache = OpenSRF::Utils::Cache->new("global", 0);
1412         $orgs = $cache->get_cache("org.ancestors.$org_id");
1413         return $orgs if $orgs;
1414     }
1415
1416         my $org_list = OpenILS::Utils::CStoreEditor->new->json_query({
1417                 select => {
1418                         aou => [{
1419                                 transform => 'actor.org_unit_ancestors',
1420                                 column => 'id',
1421                                 result_field => 'id',
1422                                 params => []
1423                         }],
1424                 },
1425                 from => 'aou',
1426                 where => {id => $org_id}
1427         });
1428
1429         $orgs = [ map { $_->{id} } @$org_list ];
1430
1431     $cache->put_cache("org.ancestors.$org_id", $orgs) if $use_cache;
1432         return $orgs;
1433 }
1434
1435 sub get_org_full_path {
1436         my($self, $org_id, $depth) = @_;
1437
1438     my $query = {
1439         select => {
1440                         aou => [{
1441                                 transform => 'actor.org_unit_full_path',
1442                                 column => 'id',
1443                                 result_field => 'id',
1444                         }],
1445                 },
1446                 from => 'aou',
1447                 where => {id => $org_id}
1448         };
1449
1450     $query->{select}->{aou}->[0]->{params} = [$depth] if defined $depth;
1451         my $org_list = OpenILS::Utils::CStoreEditor->new->json_query($query);
1452     return [ map {$_->{id}} @$org_list ];
1453 }
1454
1455 # returns the ID of the org unit ancestor at the specified depth
1456 sub org_unit_ancestor_at_depth {
1457     my($class, $org_id, $depth) = @_;
1458     my $resp = OpenILS::Utils::CStoreEditor->new->json_query(
1459         {from => ['actor.org_unit_ancestor_at_depth', $org_id, $depth]})->[0];
1460     return ($resp) ? $resp->{id} : undef;
1461 }
1462
1463 # returns the user's configured locale as a string.  Defaults to en-US if none is configured.
1464 sub get_user_locale {
1465         my($self, $user_id, $e) = @_;
1466         $e ||= OpenILS::Utils::CStoreEditor->new;
1467
1468         # first, see if the user has an explicit locale set
1469         my $setting = $e->search_actor_user_setting(
1470                 {usr => $user_id, name => 'global.locale'})->[0];
1471         return OpenSRF::Utils::JSON->JSON2perl($setting->value) if $setting;
1472
1473         my $user = $e->retrieve_actor_user($user_id) or return $e->event;
1474         return $self->get_org_locale($user->home_ou, $e);
1475 }
1476
1477 # returns org locale setting
1478 sub get_org_locale {
1479         my($self, $org_id, $e) = @_;
1480         $e ||= OpenILS::Utils::CStoreEditor->new;
1481
1482         my $locale;
1483         if(defined $org_id) {
1484                 $locale = $self->ou_ancestor_setting_value($org_id, 'global.default_locale', $e);
1485                 return $locale if $locale;
1486         }
1487
1488         # system-wide default
1489         my $sclient = OpenSRF::Utils::SettingsClient->new;
1490         $locale = $sclient->config_value('default_locale');
1491     return $locale if $locale;
1492
1493         # if nothing else, fallback to locale=cowboy
1494         return 'en-US';
1495 }
1496
1497
1498 # xml-escape non-ascii characters
1499 sub entityize {
1500     my($self, $string, $form) = @_;
1501         $form ||= "";
1502
1503         # If we're going to convert non-ASCII characters to XML entities,
1504         # we had better be dealing with a UTF8 string to begin with
1505         $string = decode_utf8($string);
1506
1507         if ($form eq 'D') {
1508                 $string = NFD($string);
1509         } else {
1510                 $string = NFC($string);
1511         }
1512
1513         # Convert raw ampersands to entities
1514         $string =~ s/&(?!\S+;)/&amp;/gso;
1515
1516         # Convert Unicode characters to entities
1517         $string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
1518
1519         return $string;
1520 }
1521
1522 # x0000-x0008 isn't legal in XML documents
1523 # XXX Perhaps this should just go into our standard entityize method
1524 sub strip_ctrl_chars {
1525         my ($self, $string) = @_;
1526
1527         $string =~ s/([\x{0000}-\x{0008}])//sgoe;
1528         return $string;
1529 }
1530
1531 sub get_copy_price {
1532         my($self, $e, $copy, $volume) = @_;
1533
1534         $copy->price(0) if $copy->price and $copy->price < 0;
1535
1536         return $copy->price if $copy->price and $copy->price > 0;
1537
1538
1539         my $owner;
1540         if(ref $volume) {
1541                 if($volume->id == OILS_PRECAT_CALL_NUMBER) {
1542                         $owner = $copy->circ_lib;
1543                 } else {
1544                         $owner = $volume->owning_lib;
1545                 }
1546         } else {
1547                 if($copy->call_number == OILS_PRECAT_CALL_NUMBER) {
1548                         $owner = $copy->circ_lib;
1549                 } else {
1550                         $owner = $e->retrieve_asset_call_number($copy->call_number)->owning_lib;
1551                 }
1552         }
1553
1554         my $default_price = $self->ou_ancestor_setting_value(
1555                 $owner, OILS_SETTING_DEF_ITEM_PRICE, $e) || 0;
1556
1557         return $default_price unless defined $copy->price;
1558
1559         # price is 0.  Use the default?
1560     my $charge_on_0 = $self->ou_ancestor_setting_value(
1561         $owner, OILS_SETTING_CHARGE_LOST_ON_ZERO, $e) || 0;
1562
1563         return $default_price if $charge_on_0;
1564         return 0;
1565 }
1566
1567 # given a transaction ID, this returns the context org_unit for the transaction
1568 sub xact_org {
1569     my($self, $xact_id, $e) = @_;
1570     $e ||= OpenILS::Utils::CStoreEditor->new;
1571
1572     my $loc = $e->json_query({
1573         "select" => {circ => ["circ_lib"]},
1574         from     => "circ",
1575         "where"  => {id => $xact_id},
1576     });
1577
1578     return $loc->[0]->{circ_lib} if @$loc;
1579
1580     $loc = $e->json_query({
1581         "select" => {bresv => ["request_lib"]},
1582         from     => "bresv",
1583         "where"  => {id => $xact_id},
1584     });
1585
1586     return $loc->[0]->{request_lib} if @$loc;
1587
1588     $loc = $e->json_query({
1589         "select" => {mg => ["billing_location"]},
1590         from     => "mg",
1591         "where"  => {id => $xact_id},
1592     });
1593
1594     return $loc->[0]->{billing_location};
1595 }
1596
1597
1598 sub find_event_def_by_hook {
1599     my($self, $hook, $context_org, $e) = @_;
1600
1601     $e ||= OpenILS::Utils::CStoreEditor->new;
1602
1603     my $orgs = $self->get_org_ancestors($context_org);
1604
1605     # search from the context org up
1606     for my $org_id (reverse @$orgs) {
1607
1608         my $def = $e->search_action_trigger_event_definition(
1609             {hook => $hook, owner => $org_id})->[0];
1610
1611         return $def if $def;
1612     }
1613
1614     return undef;
1615 }
1616
1617
1618
1619 # If an event_def ID is not provided, use the hook and context org to find the
1620 # most appropriate event.  create the event, fire it, then return the resulting
1621 # event with fleshed template_output and error_output
1622 sub fire_object_event {
1623     my($self, $event_def, $hook, $object, $context_org, $granularity, $user_data, $client) = @_;
1624
1625     my $e = OpenILS::Utils::CStoreEditor->new;
1626     my $def;
1627
1628     my $auto_method = "open-ils.trigger.event.autocreate.by_definition";
1629
1630     if($event_def) {
1631         $def = $e->retrieve_action_trigger_event_definition($event_def)
1632             or return $e->event;
1633
1634         $auto_method .= '.include_inactive';
1635
1636     } else {
1637
1638         # find the most appropriate event def depending on context org
1639         $def = $self->find_event_def_by_hook($hook, $context_org, $e)
1640             or return $e->event;
1641     }
1642
1643     my $final_resp;
1644
1645     if($def->group_field) {
1646         # we have a list of objects
1647         $object = [$object] unless ref $object eq 'ARRAY';
1648
1649         my @event_ids;
1650         $user_data ||= [];
1651         for my $i (0..$#$object) {
1652             my $obj = $$object[$i];
1653             my $udata = $$user_data[$i];
1654             my $event_id = $self->simplereq(
1655                 'open-ils.trigger', $auto_method, $def->id, $obj, $context_org, $udata);
1656             push(@event_ids, $event_id);
1657         }
1658
1659         $logger->info("EVENTS = " . OpenSRF::Utils::JSON->perl2JSON(\@event_ids));
1660
1661         my $resp;
1662         if (not defined $client) {
1663             $resp = $self->simplereq(
1664                 'open-ils.trigger',
1665                 'open-ils.trigger.event_group.fire',
1666                 \@event_ids);
1667         } else {
1668             $resp = $self->patientreq(
1669                 $client,
1670                 "open-ils.trigger", "open-ils.trigger.event_group.fire",
1671                 \@event_ids
1672             );
1673         }
1674
1675         if($resp and $resp->{events} and @{$resp->{events}}) {
1676
1677             $e->xact_begin;
1678             $final_resp = $e->retrieve_action_trigger_event([
1679                 $resp->{events}->[0]->id,
1680                 {flesh => 1, flesh_fields => {atev => ['template_output', 'error_output']}}
1681             ]);
1682             $e->rollback;
1683         }
1684
1685     } else {
1686
1687         $object = $$object[0] if ref $object eq 'ARRAY';
1688
1689         my $event_id;
1690         my $resp;
1691
1692         if (not defined $client) {
1693             $event_id = $self->simplereq(
1694                 'open-ils.trigger',
1695                 $auto_method, $def->id, $object, $context_org, $user_data
1696             );
1697
1698             $resp = $self->simplereq(
1699                 'open-ils.trigger',
1700                 'open-ils.trigger.event.fire',
1701                 $event_id
1702             );
1703         } else {
1704             $event_id = $self->patientreq(
1705                 $client,
1706                 'open-ils.trigger',
1707                 $auto_method, $def->id, $object, $context_org, $user_data
1708             );
1709
1710             $resp = $self->patientreq(
1711                 $client,
1712                 'open-ils.trigger',
1713                 'open-ils.trigger.event.fire',
1714                 $event_id
1715             );
1716         }
1717
1718         if($resp and $resp->{event}) {
1719             $e->xact_begin;
1720             $final_resp = $e->retrieve_action_trigger_event([
1721                 $resp->{event}->id,
1722                 {flesh => 1, flesh_fields => {atev => ['template_output', 'error_output']}}
1723             ]);
1724             $e->rollback;
1725         }
1726     }
1727
1728     return $final_resp;
1729 }
1730
1731
1732 sub create_events_for_hook {
1733     my($self, $hook, $obj, $org_id, $granularity, $user_data, $wait) = @_;
1734     my $ses = OpenSRF::AppSession->create('open-ils.trigger');
1735     my $req = $ses->request('open-ils.trigger.event.autocreate',
1736         $hook, $obj, $org_id, $granularity, $user_data);
1737     return undef unless $wait;
1738     my $resp = $req->recv;
1739     return $resp->content if $resp;
1740 }
1741
1742 sub create_uuid_string {
1743     return create_UUID_as_string();
1744 }
1745
1746 sub create_circ_chain_summary {
1747     my($class, $e, $circ_id) = @_;
1748     my $sum = $e->json_query({from => ['action.summarize_circ_chain', $circ_id]})->[0];
1749     return undef unless $sum;
1750     my $obj = Fieldmapper::action::circ_chain_summary->new;
1751     $obj->$_($sum->{$_}) for keys %$sum;
1752     return $obj;
1753 }
1754
1755
1756 # Returns "mra" attribute key/value pairs for a set of bre's
1757 # Takes a list of bre IDs, returns a hash of hashes,
1758 # {bre_id1 => {key1 => {code => value1, label => label1}, ...}...}
1759 my $ccvm_cache;
1760 sub get_bre_attrs {
1761     my ($class, $bre_ids, $e) = @_;
1762     $e = $e || OpenILS::Utils::CStoreEditor->new;
1763
1764     my $attrs = {};
1765     return $attrs unless defined $bre_ids;
1766     $bre_ids = [$bre_ids] unless ref $bre_ids;
1767
1768     my $mra = $e->json_query({
1769         select => {
1770             mra => [
1771                 {
1772                     column => 'id',
1773                     alias => 'bre'
1774                 }, {
1775                     column => 'attrs',
1776                     transform => 'each',
1777                     result_field => 'key',
1778                     alias => 'key'
1779                 },{
1780                     column => 'attrs',
1781                     transform => 'each',
1782                     result_field => 'value',
1783                     alias => 'value'
1784                 }
1785             ]
1786         },
1787         from => 'mra',
1788         where => {id => $bre_ids}
1789     });
1790
1791     return $attrs unless $mra;
1792
1793     $ccvm_cache = $ccvm_cache || $e->search_config_coded_value_map({id => {'!=' => undef}});
1794
1795     for my $id (@$bre_ids) {
1796         $attrs->{$id} = {};
1797         for my $mra (grep { $_->{bre} eq $id } @$mra) {
1798             my $ctype = $mra->{key};
1799             my $code = $mra->{value};
1800             $attrs->{$id}->{$ctype} = {code => $code};
1801             if($code) {
1802                 my ($ccvm) = grep { $_->ctype eq $ctype and $_->code eq $code } @$ccvm_cache;
1803                 $attrs->{$id}->{$ctype}->{label} = $ccvm->value if $ccvm;
1804             }
1805         }
1806     }
1807
1808     return $attrs;
1809 }
1810
1811 # Shorter version of bib_container_items_via_search() below, only using
1812 # the queryparser record_list filter instead of the container filter.
1813 sub bib_record_list_via_search {
1814     my ($class, $search_query, $search_args) = @_;
1815
1816     # First, Use search API to get container items sorted in any way that crad
1817     # sorters support.
1818     my $search_result = $class->simplereq(
1819         "open-ils.search", "open-ils.search.biblio.multiclass.query",
1820         $search_args, $search_query
1821     );
1822
1823     unless ($search_result) {
1824         # empty result sets won't cause this, but actual errors should.
1825         $logger->warn("bib_record_list_via_search() got nothing from search");
1826         return;
1827     }
1828
1829     # Throw away other junk from search, keeping only bib IDs.
1830     return [ map { pop @$_ } @{$search_result->{ids}} ];
1831 }
1832
1833 # 'no_flesh' avoids fleshing the target_biblio_record_entry
1834 sub bib_container_items_via_search {
1835     my ($class, $container_id, $search_query, $search_args, $no_flesh) = @_;
1836
1837     # First, Use search API to get container items sorted in any way that crad
1838     # sorters support.
1839     my $search_result = $class->simplereq(
1840         "open-ils.search", "open-ils.search.biblio.multiclass.query",
1841         $search_args, $search_query
1842     );
1843     unless ($search_result) {
1844         # empty result sets won't cause this, but actual errors should.
1845         $logger->warn("bib_container_items_via_search() got nothing from search");
1846         return;
1847     }
1848
1849     # Throw away other junk from search, keeping only bib IDs.
1850     my $id_list = [ map { pop @$_ } @{$search_result->{ids}} ];
1851
1852     return [] unless @$id_list;
1853
1854     # Now get the bib container items themselves...
1855     my $e = new OpenILS::Utils::CStoreEditor;
1856     unless ($e) {
1857         $logger->warn("bib_container_items_via_search() couldn't get cstoreeditor");
1858         return;
1859     }
1860
1861     my @flesh_fields = qw/notes/;
1862     push(@flesh_fields, 'target_biblio_record_entry') unless $no_flesh;
1863
1864     my $items = $e->search_container_biblio_record_entry_bucket_item([
1865         {
1866             "target_biblio_record_entry" => $id_list,
1867             "bucket" => $container_id
1868         }, {
1869             flesh => 1,
1870             flesh_fields => {"cbrebi" => \@flesh_fields}
1871         }
1872     ]);
1873     unless ($items) {
1874         $logger->warn(
1875             "bib_container_items_via_search() couldn't get bucket items: " .
1876             $e->die_event->{textcode}
1877         );
1878         return;
1879     }
1880
1881     # ... and put them in the same order that the search API said they
1882     # should be in.
1883     my %ordering_hash = map {
1884         ($no_flesh) ? $_->target_biblio_record_entry : $_->target_biblio_record_entry->id,
1885         $_
1886     } @$items;
1887
1888     return [map { $ordering_hash{$_} } @$id_list];
1889 }
1890
1891 # returns undef on success, Event on error
1892 sub log_user_activity {
1893     my ($class, $user_id, $who, $what, $e, $async) = @_;
1894
1895     my $commit = 0;
1896     if (!$e) {
1897         $e = OpenILS::Utils::CStoreEditor->new(xact => 1);
1898         $commit = 1;
1899     }
1900
1901     my $res = $e->json_query({
1902         from => [
1903             'actor.insert_usr_activity',
1904             $user_id, $who, $what, OpenSRF::AppSession->ingress
1905         ]
1906     });
1907
1908     if ($res) { # call returned OK
1909
1910         $e->commit   if $commit and @$res;
1911         $e->rollback if $commit and !@$res;
1912
1913     } else {
1914         return $e->die_event;
1915     }
1916
1917     return undef;
1918 }
1919
1920 # I hate to put this here exactly, but this code needs to be shared between
1921 # the TPAC's mod_perl module and open-ils.serial.
1922 #
1923 # There is a reason every part of the query *except* those parts dealing
1924 # with scope are moved here from the code's origin in TPAC.  The serials
1925 # use case does *not* want the same scoping logic.
1926 #
1927 # Also, note that for the serials uses case, we may filter in OPAC visible
1928 # status and copy/call_number deletedness, but we don't filter on any
1929 # particular values for serial.item.status or serial.item.date_received.
1930 # Since we're only using this *after* winnowing down the set of issuances
1931 # that copies should be related to, I'm not sure we need any such serial.item
1932 # filters.
1933
1934 sub basic_opac_copy_query {
1935     ######################################################################
1936     # Pass a defined value for either $rec_id OR ($iss_id AND $dist_id), #
1937     # not both.                                                          #
1938     ######################################################################
1939     my ($self,$rec_id,$iss_id,$dist_id,$copy_limit,$copy_offset,$staff) = @_;
1940
1941     return {
1942         select => {
1943             acp => ['id', 'barcode', 'circ_lib', 'create_date',
1944                     'age_protect', 'holdable'],
1945             acpl => [
1946                 {column => 'name', alias => 'copy_location'},
1947                 {column => 'holdable', alias => 'location_holdable'}
1948             ],
1949             ccs => [
1950                 {column => 'name', alias => 'copy_status'},
1951                 {column => 'holdable', alias => 'status_holdable'}
1952             ],
1953             acn => [
1954                 {column => 'label', alias => 'call_number_label'},
1955                 {column => 'id', alias => 'call_number'}
1956             ],
1957             circ => ['due_date'],
1958             acnp => [
1959                 {column => 'label', alias => 'call_number_prefix_label'},
1960                 {column => 'id', alias => 'call_number_prefix'}
1961             ],
1962             acns => [
1963                 {column => 'label', alias => 'call_number_suffix_label'},
1964                 {column => 'id', alias => 'call_number_suffix'}
1965             ],
1966             bmp => [
1967                 {column => 'label', alias => 'part_label'},
1968             ],
1969             ($iss_id ? (sitem => ["issuance"]) : ())
1970         },
1971
1972         from => {
1973             acp => {
1974                 ($iss_id ? (
1975                     sitem => {
1976                         fkey => 'id',
1977                         field => 'unit',
1978                         filter => {issuance => $iss_id},
1979                         join => {
1980                             sstr => { }
1981                         }
1982                     }
1983                 ) : ()),
1984                 acn => {
1985                     join => {
1986                         acnp => { fkey => 'prefix' },
1987                         acns => { fkey => 'suffix' }
1988                     },
1989                     filter => [
1990                         {deleted => 'f'},
1991                         ($rec_id ? {record => $rec_id} : ())
1992                     ],
1993                 },
1994                 circ => { # If the copy is circulating, retrieve the open circ
1995                     type => 'left',
1996                     filter => {checkin_time => undef}
1997                 },
1998                 acpl => {
1999                     ($staff ? () : (filter => { opac_visible => 't' }))
2000                 },
2001                 ccs => {
2002                     ($staff ? () : (filter => { opac_visible => 't' }))
2003                 },
2004                 aou => {},
2005                 acpm => {
2006                     type => 'left',
2007                     join => {
2008                         bmp => { type => 'left' }
2009                     }
2010                 }
2011             }
2012         },
2013
2014         where => {
2015             '+acp' => {
2016                 deleted => 'f',
2017                 ($staff ? () : (opac_visible => 't'))
2018             },
2019             ($dist_id ? ( '+sstr' => { distribution => $dist_id } ) : ()),
2020             ($staff ? () : ( '+aou' => { opac_visible => 't' } ))
2021         },
2022
2023         order_by => [
2024             {class => 'aou', field => 'name'},
2025             {class => 'acn', field => 'label'}
2026         ],
2027
2028         limit => $copy_limit,
2029         offset => $copy_offset
2030     };
2031 }
2032
2033 # Compare two dates, date1 and date2. If date2 is not defined, then
2034 # DateTime->now will be used. Assumes dates are in ISO8601 format as
2035 # supported by DateTime::Format::ISO8601. (A future enhancement might
2036 # be to support other formats.)
2037 #
2038 # Returns -1 if $date1 < $date2
2039 # Returns 0 if $date1 == $date2
2040 # Returns 1 if $date1 > $date2
2041 sub datecmp {
2042     my $self = shift;
2043     my $date1 = shift;
2044     my $date2 = shift;
2045
2046     # Check for timezone offsets and limit them to 2 digits:
2047     if ($date1 && $date1 =~ /(?:-|\+)\d\d\d\d$/) {
2048         $date1 = substr($date1, 0, length($date1) - 2);
2049     }
2050     if ($date2 && $date2 =~ /(?:-|\+)\d\d\d\d$/) {
2051         $date2 = substr($date2, 0, length($date2) - 2);
2052     }
2053
2054     # check date1:
2055     unless (UNIVERSAL::isa($date1, "DateTime")) {
2056         $date1 = DateTime::Format::ISO8601->parse_datetime($date1);
2057     }
2058
2059     # Check for date2:
2060     unless ($date2) {
2061         $date2 = DateTime->now;
2062     } else {
2063         unless (UNIVERSAL::isa($date2, "DateTime")) {
2064             $date2 = DateTime::Format::ISO8601->parse_datetime($date2);
2065         }
2066     }
2067
2068     return DateTime->compare($date1, $date2);
2069 }
2070
2071
2072 1;
2073