Open-ILS/src/perlmods/OpenILS/Application/Acq/Financials.pm

   1 package OpenILS::Application::Acq::Financials;
   2 use base qw/OpenILS::Application/;
   3 use strict; use warnings;
   4
   5 use OpenSRF::Utils::Logger qw(:logger);
   6 use OpenILS::Utils::Fieldmapper;
   7 use OpenILS::Utils::CStoreEditor q/:funcs/;
   8 use OpenILS::Const qw/:const/;
   9 use OpenSRF::Utils::SettingsClient;
  10 use OpenILS::Event;
  11 use OpenILS::Application::AppUtils;
  12 use OpenILS::Application::Acq::Lineitem;
  13 my $U = 'OpenILS::Application::AppUtils';
  14
  15 # ----------------------------------------------------------------------------
  16 # Funding Sources
  17 # ----------------------------------------------------------------------------
  18
  19 __PACKAGE__->register_method(
  20         method => 'create_funding_source',
  21         api_name        => 'open-ils.acq.funding_source.create',
  22         signature => {
  23         desc => 'Creates a new funding_source',
  24         params => [
  25             {desc => 'Authentication token', type => 'string'},
  26             {desc => 'funding source object to create', type => 'object'}
  27         ],
  28         return => {desc => 'The ID of the new funding_source'}
  29     }
  30 );
  31
  32 sub create_funding_source {
  33     my($self, $conn, $auth, $funding_source) = @_;
  34     my $e = new_editor(xact=>1, authtoken=>$auth);
  35     return $e->die_event unless $e->checkauth;
  36     return $e->die_event unless $e->allowed('ADMIN_FUNDING_SOURCE', $funding_source->owner);
  37     $e->create_acq_funding_source($funding_source) or return $e->die_event;
  38     $e->commit;
  39     return $funding_source->id;
  40 }
  41
  42
  43 __PACKAGE__->register_method(
  44         method => 'delete_funding_source',
  45         api_name        => 'open-ils.acq.funding_source.delete',
  46         signature => {
  47         desc => 'Deletes a funding_source',
  48         params => [
  49             {desc => 'Authentication token', type => 'string'},
  50             {desc => 'funding source ID', type => 'number'}
  51         ],
  52         return => {desc => '1 on success, Event on failure'}
  53     }
  54 );
  55
  56 sub delete_funding_source {
  57     my($self, $conn, $auth, $funding_source_id) = @_;
  58     my $e = new_editor(xact=>1, authtoken=>$auth);
  59     return $e->die_event unless $e->checkauth;
  60     my $funding_source = $e->retrieve_acq_funding_source($funding_source_id) or return $e->die_event;
  61     return $e->die_event unless $e->allowed('ADMIN_FUNDING_SOURCE', $funding_source->owner, $funding_source);
  62     $e->delete_acq_funding_source($funding_source) or return $e->die_event;
  63     $e->commit;
  64     return 1;
  65 }
  66
  67 __PACKAGE__->register_method(
  68         method => 'retrieve_funding_source',
  69         api_name        => 'open-ils.acq.funding_source.retrieve',
  70         signature => {
  71         desc => 'Retrieves a new funding_source',
  72         params => [
  73             {desc => 'Authentication token', type => 'string'},
  74             {desc => 'funding source ID', type => 'number'}
  75         ],
  76         return => {desc => 'The funding_source object on success, Event on failure'}
  77     }
  78 );
  79
  80 sub retrieve_funding_source {
  81     my($self, $conn, $auth, $funding_source_id, $options) = @_;
  82     my $e = new_editor(authtoken=>$auth);
  83     return $e->event unless $e->checkauth;
  84     $options ||= {};
  85
  86     my $flesh = {flesh => 1, flesh_fields => {acqfs => []}};
  87     push(@{$flesh->{flesh_fields}->{acqfs}}, 'credits') if $$options{flesh_credits};
  88     push(@{$flesh->{flesh_fields}->{acqfs}}, 'allocations') if $$options{flesh_allocations};
  89
  90     my $funding_source = $e->retrieve_acq_funding_source([$funding_source_id, $flesh]) or return $e->event;
  91
  92     return $e->event unless $e->allowed(
  93         ['ADMIN_FUNDING_SOURCE','MANAGE_FUNDING_SOURCE', 'VIEW_FUNDING_SOURCE'],
  94         $funding_source->owner, $funding_source);
  95
  96     $funding_source->summary(retrieve_funding_source_summary_impl($e, $funding_source))
  97         if $$options{flesh_summary};
  98     return $funding_source;
  99 }
 100
 101 __PACKAGE__->register_method(
 102         method => 'retrieve_org_funding_sources',
 103         api_name        => 'open-ils.acq.funding_source.org.retrieve',
 104     stream => 1,
 105         signature => {
 106         desc => 'Retrieves all the funding_sources associated with an org unit that the requestor has access to see',
 107         params => [
 108             {desc => 'Authentication token', type => 'string'},
 109             {desc => 'List of org Unit IDs.  If no IDs are provided, this method returns the
 110                 full set of funding sources this user has permission to view', type => 'number'},
 111             {desc => q/Limiting permission.  this permission is used find the work-org tree from which
 112                 the list of orgs is generated if no org ids are provided.
 113                 The default is ADMIN_FUNDING_SOURCE/, type => 'string'},
 114         ],
 115         return => {desc => 'The funding_source objects on success, empty array otherwise'}
 116     }
 117 );
 118
 119 sub retrieve_org_funding_sources {
 120     my($self, $conn, $auth, $org_id_list, $options) = @_;
 121     my $e = new_editor(authtoken=>$auth);
 122     return $e->event unless $e->checkauth;
 123     $options ||= {};
 124
 125     my $limit_perm = ($$options{limit_perm}) ? $$options{limit_perm} : 'ADMIN_FUNDING_SOURCE';
 126     return OpenILS::Event->new('BAD_PARAMS')
 127         unless $limit_perm =~ /(ADMIN|MANAGE|VIEW)_FUNDING_SOURCE/;
 128
 129     my $org_ids = ($org_id_list and @$org_id_list) ? $org_id_list :
 130         $U->user_has_work_perm_at($e, $limit_perm, {descendants =>1});
 131
 132     return [] unless @$org_ids;
 133     my $sources = $e->search_acq_funding_source({owner => $org_ids});
 134
 135     for my $source (@$sources) {
 136         $source->summary(retrieve_funding_source_summary_impl($e, $source))
 137             if $$options{flesh_summary};
 138         $conn->respond($source);
 139     }
 140
 141     return undef;
 142 }
 143
 144 sub retrieve_funding_source_summary_impl {
 145     my($e, $source) = @_;
 146     my $at = $e->search_acq_funding_source_allocation_total({funding_source => $source->id})->[0];
 147     my $b = $e->search_acq_funding_source_balance({funding_source => $source->id})->[0];
 148     my $ct = $e->search_acq_funding_source_credit_total({funding_source => $source->id})->[0];
 149     return {
 150         allocation_total => ($at) ? $at->amount : 0,
 151         balance => ($b) ? $b->amount : 0,
 152         credit_total => ($ct) ? $ct->amount : 0,
 153     };
 154 }
 155
 156
 157 __PACKAGE__->register_method(
 158         method => 'create_funding_source_credit',
 159         api_name        => 'open-ils.acq.funding_source_credit.create',
 160         signature => {
 161         desc => 'Create a new funding source credit',
 162         params => [
 163             {desc => 'Authentication token', type => 'string'},
 164             {desc => 'funding source credit object', type => 'object'}
 165         ],
 166         return => {desc => 'The ID of the new funding source credit on success, Event on failure'}
 167     }
 168 );
 169
 170 sub create_funding_source_credit {
 171     my($self, $conn, $auth, $fs_credit) = @_;
 172     my $e = new_editor(authtoken=>$auth, xact=>1);
 173     return $e->event unless $e->checkauth;
 174
 175     my $fs = $e->retrieve_acq_funding_source($fs_credit->funding_source)
 176         or return $e->die_event;
 177     return $e->die_event unless $e->allowed(['MANAGE_FUNDING_SOURCE'], $fs->owner, $fs);
 178
 179     $e->create_acq_funding_source_credit($fs_credit) or return $e->die_event;
 180     $e->commit;
 181     return $fs_credit->id;
 182 }
 183
 184
 185 # ---------------------------------------------------------------
 186 # funds
 187 # ---------------------------------------------------------------
 188
 189 __PACKAGE__->register_method(
 190         method => 'create_fund',
 191         api_name        => 'open-ils.acq.fund.create',
 192         signature => {
 193         desc => 'Creates a new fund',
 194         params => [
 195             {desc => 'Authentication token', type => 'string'},
 196             {desc => 'fund object to create', type => 'object'}
 197         ],
 198         return => {desc => 'The ID of the newly created fund object'}
 199     }
 200 );
 201
 202 sub create_fund {
 203     my($self, $conn, $auth, $fund) = @_;
 204     my $e = new_editor(xact=>1, authtoken=>$auth);
 205     return $e->die_event unless $e->checkauth;
 206     return $e->die_event unless $e->allowed('ADMIN_FUND', $fund->org);
 207     $e->create_acq_fund($fund) or return $e->die_event;
 208     $e->commit;
 209     return $fund->id;
 210 }
 211
 212
 213 __PACKAGE__->register_method(
 214         method => 'delete_fund',
 215         api_name        => 'open-ils.acq.fund.delete',
 216         signature => {
 217         desc => 'Deletes a fund',
 218         params => [
 219             {desc => 'Authentication token', type => 'string'},
 220             {desc => 'fund ID', type => 'number'}
 221         ],
 222         return => {desc => '1 on success, Event on failure'}
 223     }
 224 );
 225
 226 sub delete_fund {
 227     my($self, $conn, $auth, $fund_id) = @_;
 228     my $e = new_editor(xact=>1, authtoken=>$auth);
 229     return $e->die_event unless $e->checkauth;
 230     my $fund = $e->retrieve_acq_fund($fund_id) or return $e->die_event;
 231     return $e->die_event unless $e->allowed('ADMIN_FUND', $fund->org, $fund);
 232     $e->delete_acq_fund($fund) or return $e->die_event;
 233     $e->commit;
 234     return 1;
 235 }
 236
 237 __PACKAGE__->register_method(
 238         method => 'retrieve_fund',
 239         api_name        => 'open-ils.acq.fund.retrieve',
 240         signature => {
 241         desc => 'Retrieves a new fund',
 242         params => [
 243             {desc => 'Authentication token', type => 'string'},
 244             {desc => 'fund ID', type => 'number'}
 245         ],
 246         return => {desc => 'The fund object on success, Event on failure'}
 247     }
 248 );
 249
 250 sub retrieve_fund {
 251     my($self, $conn, $auth, $fund_id, $options) = @_;
 252     my $e = new_editor(authtoken=>$auth);
 253     return $e->event unless $e->checkauth;
 254     $options ||= {};
 255
 256     my $flesh = {flesh => 2, flesh_fields => {acqf => []}};
 257     if ($options->{"flesh_tags"}) {
 258         push @{$flesh->{"flesh_fields"}->{"acqf"}}, "tags";
 259         $flesh->{"flesh_fields"}->{"acqftm"} = ["tag"];
 260     }
 261     push(@{$flesh->{flesh_fields}->{acqf}}, 'debits') if $$options{flesh_debits};
 262     push(@{$flesh->{flesh_fields}->{acqf}}, 'allocations') if $$options{flesh_allocations};
 263     push(@{$flesh->{flesh_fields}->{acqfa}}, 'funding_source') if $$options{flesh_allocation_sources};
 264
 265     my $fund = $e->retrieve_acq_fund([$fund_id, $flesh]) or return $e->event;
 266     return $e->event unless $e->allowed(['ADMIN_FUND','MANAGE_FUND', 'VIEW_FUND'], $fund->org, $fund);
 267     $fund->summary(retrieve_fund_summary_impl($e, $fund))
 268         if $$options{flesh_summary};
 269     return $fund;
 270 }
 271
 272 __PACKAGE__->register_method(
 273         method => 'retrieve_org_funds',
 274         api_name        => 'open-ils.acq.fund.org.retrieve',
 275     stream => 1,
 276         signature => {
 277         desc => 'Retrieves all the funds associated with an org unit',
 278         params => [
 279             {desc => 'Authentication token', type => 'string'},
 280             {desc => 'List of org Unit IDs.  If no IDs are provided, this method returns the
 281                 full set of funding sources this user has permission to view', type => 'number'},
 282             {desc => q/Options hash.
 283                 "limit_perm" -- this permission is used find the work-org tree from which
 284                 the list of orgs is generated if no org ids are provided.  The default is ADMIN_FUND.
 285                 "flesh_summary" -- if true, the summary field on each fund is fleshed
 286                 The default is ADMIN_FUND/, type => 'string'},
 287         ],
 288         return => {desc => 'The fund objects on success, Event on failure'}
 289     }
 290 );
 291
 292 __PACKAGE__->register_method(
 293         method => 'retrieve_org_funds',
 294         api_name        => 'open-ils.acq.fund.org.years.retrieve');
 295
 296
 297 sub retrieve_org_funds {
 298     my($self, $conn, $auth, $filter, $options) = @_;
 299     my $e = new_editor(authtoken=>$auth);
 300     return $e->event unless $e->checkauth;
 301     $filter ||= {};
 302     $options ||= {};
 303
 304     my $limit_perm = ($$options{limit_perm}) ? $$options{limit_perm} : 'ADMIN_FUND';
 305     return OpenILS::Event->new('BAD_PARAMS')
 306         unless $limit_perm =~ /(ADMIN|MANAGE|VIEW)_FUND/;
 307
 308     $filter->{org}  = $filter->{org} ||
 309         $U->user_has_work_perm_at($e, $limit_perm, {descendants =>1});
 310     return undef unless @{$filter->{org}};
 311
 312     my $query = [
 313         $filter,
 314         {
 315             limit => $$options{limit} || 50,
 316             offset => $$options{offset} || 0,
 317             order_by => $$options{order_by} || {acqf => 'name'}
 318         }
 319     ];
 320
 321     if($self->api_name =~ /years/) {
 322         # return the distinct set of fund years covered by the selected funds
 323         my $data = $e->json_query({
 324             select => {
 325                 acqf => [{column => 'year', transform => 'distinct'}]
 326             },
 327             from => 'acqf',
 328             where => $filter}
 329         );
 330
 331         return [map { $_->{year} } @$data];
 332     }
 333
 334     my $funds = $e->search_acq_fund($query);
 335
 336     for my $fund (@$funds) {
 337         $fund->summary(retrieve_fund_summary_impl($e, $fund))
 338             if $$options{flesh_summary};
 339         $conn->respond($fund);
 340     }
 341
 342     return undef;
 343 }
 344
 345 __PACKAGE__->register_method(
 346         method => 'retrieve_fund_summary',
 347         api_name        => 'open-ils.acq.fund.summary.retrieve',
 348         signature => {
 349         desc => 'Returns a summary of credits/debits/encumbrances for a fund',
 350         params => [
 351             {desc => 'Authentication token', type => 'string'},
 352             {desc => 'fund id', type => 'number' }
 353         ],
 354         return => {desc => 'A hash of summary information, Event on failure'}
 355     }
 356 );
 357
 358 sub retrieve_fund_summary {
 359     my($self, $conn, $auth, $fund_id) = @_;
 360     my $e = new_editor(authtoken=>$auth);
 361     return $e->event unless $e->checkauth;
 362     my $fund = $e->retrieve_acq_fund($fund_id) or return $e->event;
 363     return $e->event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
 364     return retrieve_fund_summary_impl($e, $fund);
 365 }
 366
 367
 368 sub retrieve_fund_summary_impl {
 369     my($e, $fund) = @_;
 370
 371     my $at = $e->search_acq_fund_allocation_total({fund => $fund->id})->[0];
 372     my $dt = $e->search_acq_fund_debit_total({fund => $fund->id})->[0];
 373     my $et = $e->search_acq_fund_encumbrance_total({fund => $fund->id})->[0];
 374     my $st = $e->search_acq_fund_spent_total({fund => $fund->id})->[0];
 375     my $cb = $e->search_acq_fund_combined_balance({fund => $fund->id})->[0];
 376     my $sb = $e->search_acq_fund_spent_balance({fund => $fund->id})->[0];
 377
 378     return {
 379         allocation_total => ($at) ? $at->amount : 0,
 380         debit_total => ($dt) ? $dt->amount : 0,
 381         encumbrance_total => ($et) ? $et->amount : 0,
 382         spent_total => ($st) ? $st->amount : 0,
 383         combined_balance => ($cb) ? $cb->amount : 0,
 384         spent_balance => ($sb) ? $sb->amount : 0,
 385     };
 386 }
 387
 388 __PACKAGE__->register_method(
 389         method => 'transfer_money_between_funds',
 390         api_name        => 'open-ils.acq.funds.transfer_money',
 391         signature => {
 392         desc => 'Method for transfering money between funds',
 393         params => [
 394             {desc => 'Authentication token', type => 'string'},
 395             {desc => 'Originating fund ID', type => 'number'},
 396             {desc => 'Amount of money to transfer away from the originating fund, in the same currency as said fund', type => 'number'},
 397             {desc => 'Destination fund ID', type => 'number'},
 398             {desc => 'Amount of money to transfer to the destination fund, in the same currency as said fund.  If null, uses the same amount specified with the Originating Fund, and attempts a currency conversion if appropriate.', type => 'number'},
 399             {desc => 'Transfer Note', type => 'string'}
 400         ],
 401         return => {desc => '1 on success, Event on failure'}
 402     }
 403 );
 404
 405 sub transfer_money_between_funds {
 406     my($self, $conn, $auth, $ofund_id, $ofund_amount, $dfund_id, $dfund_amount, $note) = @_;
 407     my $e = new_editor(xact=>1, authtoken=>$auth);
 408     return $e->die_event unless $e->checkauth;
 409     my $ofund = $e->retrieve_acq_fund($ofund_id) or return $e->event;
 410     return $e->die_event unless $e->allowed(['ADMIN_FUND','MANAGE_FUND'], $ofund->org, $ofund);
 411     my $dfund = $e->retrieve_acq_fund($dfund_id) or return $e->event;
 412     return $e->die_event unless $e->allowed(['ADMIN_FUND','MANAGE_FUND'], $dfund->org, $dfund);
 413
 414     if (!defined $dfund_amount) {
 415         my $ratio = 1;
 416         if ($ofund->currency_type ne $dfund->currency_type) {
 417             my $exchange_rate = $e->json_query({
 418                 "select"=>{"acqexr"=>["ratio"]},
 419                 "from"=>"acqexr",
 420                 "where"=>{
 421                     "from_currency"=>$ofund->currency_type,
 422                     "to_currency"=>$dfund->currency_type
 423                 }
 424             });
 425             if (scalar(@$exchange_rate)<1) {
 426                 $logger->error('Unable to find exchange rate for ' . $ofund->currency_type . ' to ' . $dfund->currency_type);
 427                 return $e->die_event;
 428             }
 429             $ratio = @{$exchange_rate}[0]->{ratio};
 430         }
 431         $dfund_amount = $ofund_amount * $ratio;
 432     } else {
 433         return $e->die_event unless $e->allowed("ACQ_XFER_MANUAL_DFUND_AMOUNT");
 434     }
 435
 436     $e->json_query({
 437         from => [
 438             'acq.transfer_fund',
 439             $ofund_id, $ofund_amount, $dfund_id, $dfund_amount, $e->requestor->id, $note
 440         ]
 441     });
 442
 443     $e->commit;
 444
 445     return 1;
 446 }
 447
 448
 449
 450 # ---------------------------------------------------------------
 451 # fund Allocations
 452 # ---------------------------------------------------------------
 453
 454 __PACKAGE__->register_method(
 455         method => 'create_fund_alloc',
 456         api_name        => 'open-ils.acq.fund_allocation.create',
 457         signature => {
 458         desc => 'Creates a new fund_allocation',
 459         params => [
 460             {desc => 'Authentication token', type => 'string'},
 461             {desc => 'fund allocation object to create', type => 'object'}
 462         ],
 463         return => {desc => 'The ID of the new fund_allocation'}
 464     }
 465 );
 466
 467 sub create_fund_alloc {
 468     my($self, $conn, $auth, $fund_alloc) = @_;
 469     my $e = new_editor(xact=>1, authtoken=>$auth);
 470     return $e->die_event unless $e->checkauth;
 471
 472     # this action is equivalent to both debiting a funding source and crediting a fund
 473
 474     my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source)
 475         or return $e->die_event;
 476     return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner);
 477
 478     my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event;
 479     return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
 480
 481     $fund_alloc->allocator($e->requestor->id);
 482     $e->create_acq_fund_allocation($fund_alloc) or return $e->die_event;
 483     $e->commit;
 484     return $fund_alloc->id;
 485 }
 486
 487
 488 __PACKAGE__->register_method(
 489         method => 'delete_fund_alloc',
 490         api_name        => 'open-ils.acq.fund_allocation.delete',
 491         signature => {
 492         desc => 'Deletes a fund_allocation',
 493         params => [
 494             {desc => 'Authentication token', type => 'string'},
 495             {desc => 'fund Alocation ID', type => 'number'}
 496         ],
 497         return => {desc => '1 on success, Event on failure'}
 498     }
 499 );
 500
 501 sub delete_fund_alloc {
 502     my($self, $conn, $auth, $fund_alloc_id) = @_;
 503     my $e = new_editor(xact=>1, authtoken=>$auth);
 504     return $e->die_event unless $e->checkauth;
 505
 506     my $fund_alloc = $e->retrieve_acq_fund_allocation($fund_alloc_id) or return $e->die_event;
 507
 508     my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source)
 509         or return $e->die_event;
 510     return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner, $source);
 511
 512     my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event;
 513     return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
 514
 515     $e->delete_acq_fund_allocation($fund_alloc) or return $e->die_event;
 516     $e->commit;
 517     return 1;
 518 }
 519
 520 __PACKAGE__->register_method(
 521         method => 'retrieve_fund_alloc',
 522         api_name        => 'open-ils.acq.fund_allocation.retrieve',
 523         signature => {
 524         desc => 'Retrieves a new fund_allocation',
 525         params => [
 526             {desc => 'Authentication token', type => 'string'},
 527             {desc => 'fund Allocation ID', type => 'number'}
 528         ],
 529         return => {desc => 'The fund allocation object on success, Event on failure'}
 530     }
 531 );
 532
 533 sub retrieve_fund_alloc {
 534     my($self, $conn, $auth, $fund_alloc_id) = @_;
 535     my $e = new_editor(authtoken=>$auth);
 536     return $e->event unless $e->checkauth;
 537     my $fund_alloc = $e->retrieve_acq_fund_allocation($fund_alloc_id) or return $e->event;
 538
 539     my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source)
 540         or return $e->die_event;
 541     return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner, $source);
 542
 543     my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event;
 544     return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
 545
 546     return $fund_alloc;
 547 }
 548
 549
 550 __PACKAGE__->register_method(
 551         method => 'retrieve_funding_source_allocations',
 552         api_name        => 'open-ils.acq.funding_source.allocations.retrieve',
 553         signature => {
 554         desc => 'Retrieves a new fund_allocation',
 555         params => [
 556             {desc => 'Authentication token', type => 'string'},
 557             {desc => 'fund Allocation ID', type => 'number'}
 558         ],
 559         return => {desc => 'The fund allocation object on success, Event on failure'}
 560     }
 561 );
 562
 563 sub retrieve_funding_source_allocations {
 564     my($self, $conn, $auth, $fund_alloc_id) = @_;
 565     my $e = new_editor(authtoken=>$auth);
 566     return $e->event unless $e->checkauth;
 567     my $fund_alloc = $e->retrieve_acq_fund_allocation($fund_alloc_id) or return $e->event;
 568
 569     my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source)
 570         or return $e->die_event;
 571     return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner, $source);
 572
 573     my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event;
 574     return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
 575
 576     return $fund_alloc;
 577 }
 578
 579 # ----------------------------------------------------------------------------
 580 # Currency
 581 # ----------------------------------------------------------------------------
 582
 583 __PACKAGE__->register_method(
 584         method => 'retrieve_all_currency_type',
 585         api_name        => 'open-ils.acq.currency_type.all.retrieve',
 586     stream => 1,
 587         signature => {
 588         desc => 'Retrieves all currency_type objects',
 589         params => [
 590             {desc => 'Authentication token', type => 'string'},
 591         ],
 592         return => {desc => 'List of currency_type objects', type => 'list'}
 593     }
 594 );
 595
 596 sub retrieve_all_currency_type {
 597     my($self, $conn, $auth, $fund_alloc_id) = @_;
 598     my $e = new_editor(authtoken=>$auth);
 599     return $e->event unless $e->checkauth;
 600     return $e->event unless $e->allowed('GENERAL_ACQ');
 601     $conn->respond($_) for @{$e->retrieve_all_acq_currency_type()};
 602 }
 603
 604 __PACKAGE__->register_method(
 605         method => 'create_lineitem_assets',
 606         api_name        => 'open-ils.acq.lineitem.assets.create',
 607         signature => {
 608         desc => q/Creates the bibliographic data, volume, and copies associated with a lineitem./,
 609         params => [
 610             {desc => 'Authentication token', type => 'string'},
 611             {desc => 'The lineitem id', type => 'number'},
 612             {desc => q/Options hash./}
 613         ],
 614         return => {desc => 'ID of newly created bib record, Event on error'}
 615     }
 616 );
 617
 618 sub create_lineitem_assets {
 619     my($self, $conn, $auth, $li_id, $options) = @_;
 620     my $e = new_editor(authtoken=>$auth, xact=>1);
 621     return $e->die_event unless $e->checkauth;
 622     my ($count, $resp) = create_lineitem_assets_impl($e, $li_id, $options);
 623     return $resp if $resp;
 624     $e->commit;
 625     return $count;
 626 }
 627
 628 sub create_lineitem_assets_impl {
 629     my($e, $li_id, $options) = @_;
 630     $options ||= {};
 631     my $evt;
 632
 633     my $li = $e->retrieve_acq_lineitem([
 634         $li_id,
 635         {   flesh => 1,
 636             flesh_fields => {jub => ['purchase_order', 'attributes']}
 637         }
 638     ]) or return (undef, $e->die_event);
 639
 640     # -----------------------------------------------------------------
 641     # first, create the bib record if necessary
 642     # -----------------------------------------------------------------
 643     unless($li->eg_bib_id) {
 644
 645        my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 646             $e, $li->marc); #$rec->bib_source
 647
 648         if($U->event_code($record)) {
 649             $e->rollback;
 650             return (undef, $record);
 651         }
 652
 653         $li->editor($e->requestor->id);
 654         $li->edit_time('now');
 655         $li->eg_bib_id($record->id);
 656         $e->update_acq_lineitem($li) or return (undef, $e->die_event);
 657     }
 658
 659     my $li_details = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
 660
 661     # -----------------------------------------------------------------
 662     # for each lineitem_detail, create the volume if necessary, create
 663     # a copy, and link them all together.
 664     # -----------------------------------------------------------------
 665     my %volcache;
 666     for my $li_detail_id (@{$li_details}) {
 667
 668         my $li_detail = $e->retrieve_acq_lineitem_detail($li_detail_id)
 669             or return (undef, $e->die_event);
 670
 671         # Create the volume object if necessary
 672         my $volume = $volcache{$li_detail->cn_label};
 673         unless($volume and $volume->owning_lib == $li_detail->owning_lib) {
 674             ($volume, $evt) =
 675                 OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
 676                     $e, $li_detail->cn_label, $li->eg_bib_id, $li_detail->owning_lib);
 677             return (undef, $evt) if $evt;
 678             $volcache{$volume->id} = $volume;
 679         }
 680
 681         my $copy = Fieldmapper::asset::copy->new;
 682         $copy->isnew(1);
 683         $copy->loan_duration(2);
 684         $copy->fine_level(2);
 685         $copy->status(OILS_COPY_STATUS_ON_ORDER);
 686         $copy->barcode($li_detail->barcode);
 687         $copy->location($li_detail->location);
 688         $copy->call_number($volume->id);
 689         $copy->circ_lib($volume->owning_lib);
 690         $copy->circ_modifier($$options{circ_modifier} || 'book');
 691
 692         $evt = OpenILS::Application::Cat::AssetCommon->create_copy($e, $volume, $copy);
 693         return (undef, $evt) if $evt;
 694
 695         $li_detail->eg_copy_id($copy->id);
 696         $e->update_acq_lineitem_detail($li_detail) or return (undef, $e->die_event);
 697     }
 698
 699     return (scalar @{$li_details});
 700 }
 701
 702
 703
 704
 705 sub create_purchase_order_impl {
 706     my($e, $p_order) = @_;
 707
 708     $p_order->creator($e->requestor->id);
 709     $p_order->editor($e->requestor->id);
 710     $p_order->owner($e->requestor->id);
 711     $p_order->edit_time('now');
 712
 713     return $e->die_event unless
 714         $e->allowed('CREATE_PURCHASE_ORDER', $p_order->ordering_agency);
 715
 716     my $provider = $e->retrieve_acq_provider($p_order->provider)
 717         or return $e->die_event;
 718     return $e->die_event unless
 719         $e->allowed('MANAGE_PROVIDER', $provider->owner, $provider);
 720
 721     $e->create_acq_purchase_order($p_order) or return $e->die_event;
 722     return undef;
 723 }
 724
 725
 726 __PACKAGE__->register_method(
 727         method => 'retrieve_all_user_purchase_order',
 728         api_name        => 'open-ils.acq.purchase_order.user.all.retrieve',
 729     stream => 1,
 730         signature => {
 731         desc => 'Retrieves a purchase order',
 732         params => [
 733             {desc => 'Authentication token', type => 'string'},
 734             {desc => 'purchase_order to retrieve', type => 'number'},
 735             {desc => q/Options hash.  flesh_lineitems: to get the lineitems and lineitem_attrs;
 736                 clear_marc: to clear the MARC data from the lineitem (for reduced bandwidth);
 737                 limit: number of items to return ,defaults to 50;
 738                 offset: offset in the list of items to return
 739                 order_by: sort the result, provide one or more colunm names, separated by commas,
 740                 optionally followed by ASC or DESC as a single string
 741                 li_limit : number of lineitems to return if fleshing line items;
 742                 li_offset : lineitem offset if fleshing line items
 743                 li_order_by : lineitem sort definition if fleshing line items
 744                 flesh_lineitem_detail_count : flesh lineitem_detail_count field
 745                 /,
 746                 type => 'hash'}
 747         ],
 748         return => {desc => 'The purchase order, Event on failure'}
 749     }
 750 );
 751
 752 sub retrieve_all_user_purchase_order {
 753     my($self, $conn, $auth, $options) = @_;
 754     my $e = new_editor(authtoken=>$auth);
 755     return $e->event unless $e->checkauth;
 756     $options ||= {};
 757
 758     # grab purchase orders I have
 759     my $perm_orgs = $U->user_has_work_perm_at($e, 'MANAGE_PROVIDER', {descendants =>1});
 760         return OpenILS::Event->new('PERM_FAILURE', ilsperm => 'MANAGE_PROVIDER')
 761         unless @$perm_orgs;
 762     my $provider_ids = $e->search_acq_provider({owner => $perm_orgs}, {idlist=>1});
 763     my $po_ids = $e->search_acq_purchase_order({provider => $provider_ids}, {idlist=>1});
 764
 765     # grab my purchase orders
 766     push(@$po_ids, @{$e->search_acq_purchase_order({owner => $e->requestor->id}, {idlist=>1})});
 767
 768     return undef unless @$po_ids;
 769
 770     # now get the db to limit/sort for us
 771     $po_ids = $e->search_acq_purchase_order(
 772         [   {id => $po_ids}, {
 773                 limit => $$options{limit} || 50,
 774                 offset => $$options{offset} || 0,
 775                 order_by => {acqpo => $$options{order_by} || 'create_time'}
 776             }
 777         ],
 778         {idlist => 1}
 779     );
 780
 781     $conn->respond(retrieve_purchase_order_impl($e, $_, $options)) for @$po_ids;
 782     return undef;
 783 }
 784
 785
 786 __PACKAGE__->register_method(
 787         method => 'search_purchase_order',
 788         api_name        => 'open-ils.acq.purchase_order.search',
 789     stream => 1,
 790         signature => {
 791         desc => 'Search for a purchase order',
 792         params => [
 793             {desc => 'Authentication token', type => 'string'},
 794             {desc => q/Search hash.  Search fields include id, provider/, type => 'hash'}
 795         ],
 796         return => {desc => 'A stream of POs'}
 797     }
 798 );
 799
 800 sub search_purchase_order {
 801     my($self, $conn, $auth, $search, $options) = @_;
 802     my $e = new_editor(authtoken=>$auth);
 803     return $e->event unless $e->checkauth;
 804     my $po_ids = $e->search_acq_purchase_order($search, {idlist=>1});
 805     for my $po_id (@$po_ids) {
 806         $conn->respond($e->retrieve_acq_purchase_order($po_id))
 807             unless po_perm_failure($e, $po_id);
 808     }
 809
 810     return undef;
 811 }
 812
 813
 814
 815 __PACKAGE__->register_method(
 816         method    => 'retrieve_purchase_order',
 817         api_name  => 'open-ils.acq.purchase_order.retrieve',
 818         stream    => 1,
 819         signature => {
 820                       desc      => 'Retrieves a purchase order',
 821                       params    => [
 822                                     {desc => 'Authentication token', type => 'string'},
 823                                     {desc => 'purchase_order to retrieve', type => 'number'},
 824                                     {desc => q/Options hash.  flesh_lineitems, to get the lineitems and lineitem_attrs;
 825                 clear_marc, to clear the MARC data from the lineitem (for reduced bandwidth)
 826                 li_limit : number of lineitems to return if fleshing line items;
 827                 li_offset : lineitem offset if fleshing line items
 828                 li_order_by : lineitem sort definition if fleshing line items
 829                 /,
 830                                      type => 'hash'}
 831                                    ],
 832                       return => {desc => 'The purchase order, Event on failure'}
 833                      }
 834 );
 835
 836 sub retrieve_purchase_order {
 837     my($self, $conn, $auth, $po_id, $options) = @_;
 838     my $e = new_editor(authtoken=>$auth);
 839     return $e->event unless $e->checkauth;
 840
 841     $po_id = [ $po_id ] unless ref $po_id;
 842     for ( @{$po_id} ) {
 843         my $rv;
 844         if ( po_perm_failure($e, $_) )
 845           { $rv = $e->event }
 846         else
 847           { $rv =  retrieve_purchase_order_impl($e, $_, $options) }
 848
 849         $conn->respond($rv);
 850     }
 851 }
 852
 853
 854 # if the user does not have permission to perform actions on this PO, return the perm failure event
 855 sub po_perm_failure {
 856     my($e, $po_id, $fund_id) = @_;
 857     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event;
 858     return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency, $po);
 859     return undef;
 860 }
 861
 862 sub build_price_summary {
 863     my ($e, $po_id) = @_;
 864
 865     # TODO: Add summary value for estimated amount (pre-encumber)
 866
 867     # fetch the fund debits for this purchase order
 868     my $debits = $e->json_query({
 869         "select" => {"acqfdeb" => [qw/encumbrance amount/]},
 870         "from" => {
 871             "acqlid" => {
 872                 "jub" => {
 873                     "fkey" => "lineitem",
 874                     "field" => "id",
 875                     "join" => {
 876                         "acqpo" => {
 877                             "fkey" => "purchase_order", "field" => "id"
 878                         }
 879                     }
 880                 },
 881                 "acqfdeb" => {"fkey" => "fund_debit", "field" => "id"}
 882             }
 883         },
 884         "where" => {"+acqpo" => {"id" => $po_id}}
 885     });
 886
 887     my ($enc, $spent) = (0, 0);
 888     for my $deb (@$debits) {
 889         if($U->is_true($deb->{encumbrance})) {
 890             $enc += $deb->{amount};
 891         } else {
 892             $spent += $deb->{amount};
 893         }
 894     }
 895     ($enc, $spent);
 896 }
 897
 898
 899 sub retrieve_purchase_order_impl {
 900     my($e, $po_id, $options) = @_;
 901
 902     my $flesh = {"flesh" => 1, "flesh_fields" => {"acqpo" => []}};
 903
 904     $options ||= {};
 905     unless ($options->{"no_flesh_cancel_reason"}) {
 906         push @{$flesh->{"flesh_fields"}->{"acqpo"}}, "cancel_reason";
 907     }
 908     if ($options->{"flesh_notes"}) {
 909         push @{$flesh->{"flesh_fields"}->{"acqpo"}}, "notes";
 910     }
 911     if ($options->{"flesh_provider"}) {
 912         push @{$flesh->{"flesh_fields"}->{"acqpo"}}, "provider";
 913     }
 914
 915     my $args = (@{$flesh->{"flesh_fields"}->{"acqpo"}}) ?
 916         [$po_id, $flesh] : $po_id;
 917
 918     my $po = $e->retrieve_acq_purchase_order($args)
 919         or return $e->event;
 920
 921     if($$options{flesh_lineitems}) {
 922
 923         my $items = $e->search_acq_lineitem([
 924             {purchase_order => $po_id},
 925             {
 926                 flesh => 1,
 927                 flesh_fields => {
 928                     jub => ['attributes']
 929                 },
 930                 limit => $$options{li_limit} || 50,
 931                 offset => $$options{li_offset} || 0,
 932                 order_by => {jub => $$options{li_order_by} || 'create_time'}
 933             }
 934         ]);
 935
 936         if($$options{clear_marc}) {
 937             $_->clear_marc for @$items;
 938         }
 939
 940         $po->lineitems($items);
 941         $po->lineitem_count(scalar(@$items));
 942
 943     } elsif( $$options{flesh_lineitem_count} ) {
 944
 945         my $items = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist=>1});
 946         $po->lineitem_count(scalar(@$items));
 947     }
 948
 949     if($$options{flesh_price_summary}) {
 950         my ($enc, $spent) = build_price_summary($e, $po_id);
 951         $po->amount_encumbered($enc);
 952         $po->amount_spent($spent);
 953     }
 954
 955     return $po;
 956 }
 957
 958
 959 __PACKAGE__->register_method(
 960         method => 'format_po',
 961         api_name        => 'open-ils.acq.purchase_order.format'
 962 );
 963
 964 sub format_po {
 965     my($self, $conn, $auth, $po_id, $format) = @_;
 966     my $e = new_editor(authtoken=>$auth);
 967     return $e->event unless $e->checkauth;
 968
 969     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event;
 970     return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency);
 971
 972     my $hook = "format.po.$format";
 973     return $U->fire_object_event(undef, $hook, $po, $po->ordering_agency);
 974 }
 975
 976 __PACKAGE__->register_method(
 977         method => 'format_lineitem',
 978         api_name        => 'open-ils.acq.lineitem.format'
 979 );
 980
 981 sub format_lineitem {
 982     my($self, $conn, $auth, $li_id, $format, $user_data) = @_;
 983     my $e = new_editor(authtoken=>$auth);
 984     return $e->event unless $e->checkauth;
 985
 986     my $li = $e->retrieve_acq_lineitem($li_id) or return $e->event;
 987
 988     my $context_org;
 989     if (defined $li->purchase_order) {
 990         my $po = $e->retrieve_acq_purchase_order($li->purchase_order) or return $e->die_event;
 991         return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency);
 992         $context_org = $po->ordering_agency;
 993     } else {
 994         my $pl = $e->retrieve_acq_picklist($li->picklist) or return $e->die_event;
 995         if($e->requestor->id != $pl->owner) {
 996             return $e->event unless
 997                 $e->allowed('VIEW_PICKLIST', $pl->org_unit, $pl);
 998         }
 999         $context_org = $pl->org_unit;
1000     }
1001
1002     my $hook = "format.acqli.$format";
1003     return $U->fire_object_event(undef, $hook, $li, $context_org, 'print-on-demand', $user_data);
1004 }
1005
1006 __PACKAGE__->register_method (
1007     method        => 'po_events',
1008     api_name    => 'open-ils.acq.purchase_order.events.owner',
1009     stream      => 1,
1010     signature => q/
1011         Retrieve EDI-related purchase order events (format.po.jedi), by default those which are pending.
1012         @param authtoken Login session key
1013         @param owner Id or array of id's for the purchase order Owner field.  Filters the events to just those pertaining to PO's meeting this criteria.
1014         @param options Object for tweaking the selection criteria and fleshing options.
1015     /
1016 );
1017
1018 __PACKAGE__->register_method (
1019     method        => 'po_events',
1020     api_name    => 'open-ils.acq.purchase_order.events.ordering_agency',
1021     stream      => 1,
1022     signature => q/
1023         Retrieve EDI-related purchase order events (format.po.jedi), by default those which are pending.
1024         @param authtoken Login session key
1025         @param owner Id or array of id's for the purchase order Ordering Agency field.  Filters the events to just those pertaining to PO's meeting this criteria.
1026         @param options Object for tweaking the selection criteria and fleshing options.
1027     /
1028 );
1029
1030 __PACKAGE__->register_method (
1031     method        => 'po_events',
1032     api_name    => 'open-ils.acq.purchase_order.events.id',
1033     stream      => 1,
1034     signature => q/
1035         Retrieve EDI-related purchase order events (format.po.jedi), by default those which are pending.
1036         @param authtoken Login session key
1037         @param owner Id or array of id's for the purchase order Id field.  Filters the events to just those pertaining to PO's meeting this criteria.
1038         @param options Object for tweaking the selection criteria and fleshing options.
1039     /
1040 );
1041
1042 sub po_events {
1043     my($self, $conn, $auth, $search_value, $options) = @_;
1044     my $e = new_editor(authtoken => $auth);
1045     return $e->event unless $e->checkauth;
1046
1047     (my $search_field = $self->api_name) =~ s/.*\.([_a-z]+)$/$1/;
1048     my $obj_type = 'acqpo';
1049
1050     if ($search_field eq 'ordering_agency') {
1051         $search_value = $U->get_org_descendants($search_value);
1052     }
1053
1054     my $query = {
1055         "select"=>{"atev"=>["id"]},
1056         "from"=>"atev",
1057         "where"=>{
1058             "target"=>{
1059                 "in"=>{
1060                     "select"=>{$obj_type=>["id"]},
1061                     "from"=>$obj_type,
1062                     "where"=>{$search_field=>$search_value}
1063                 }
1064             },
1065             "event_def"=>{
1066                 "in"=>{
1067                     "select"=>{atevdef=>["id"]},
1068                     "from"=>"atevdef",
1069                     "where"=>{
1070                         "hook"=>"format.po.jedi"
1071                     }
1072                 }
1073             },
1074             "state"=>"pending"
1075         },
1076         "order_by"=>[{"class"=>"atev", "field"=>"run_time", "direction"=>"desc"}]
1077     };
1078
1079     if ($options && defined $options->{state}) {
1080         $query->{'where'}{'state'} = $options->{state}
1081     }
1082
1083     if ($options && defined $options->{start_time}) {
1084         $query->{'where'}{'start_time'} = $options->{start_time};
1085     }
1086
1087     if ($options && defined $options->{order_by}) {
1088         $query->{'order_by'} = $options->{order_by};
1089     }
1090     my $po_events = $e->json_query($query);
1091
1092     my $flesh_fields = { 'atev' => [ 'event_def' ] };
1093     my $flesh_depth = 1;
1094
1095     for my $id (@$po_events) {
1096         my $event = $e->retrieve_action_trigger_event([
1097             $id->{id},
1098             {flesh => $flesh_depth, flesh_fields => $flesh_fields}
1099         ]);
1100         if (! $event) { next; }
1101
1102         my $po = retrieve_purchase_order_impl(
1103             $e,
1104             $event->target(),
1105             {flesh_lineitem_count=>1,flesh_price_summary=>1}
1106         );
1107
1108         if ($e->allowed( ['CREATE_PURCHASE_ORDER','VIEW_PURCHASE_ORDER'], $po->ordering_agency() )) {
1109             $event->target( $po );
1110             $conn->respond($event);
1111         }
1112     }
1113
1114     return undef;
1115 }
1116
1117 __PACKAGE__->register_method (
1118         method          => 'update_po_events',
1119     api_name    => 'open-ils.acq.purchase_order.event.cancel.batch',
1120     stream      => 1,
1121 );
1122 __PACKAGE__->register_method (
1123         method          => 'update_po_events',
1124     api_name    => 'open-ils.acq.purchase_order.event.reset.batch',
1125     stream      => 1,
1126 );
1127
1128 sub update_po_events {
1129     my($self, $conn, $auth, $event_ids) = @_;
1130     my $e = new_editor(xact => 1, authtoken => $auth);
1131     return $e->die_event unless $e->checkauth;
1132
1133     my $x = 1;
1134     for my $id (@$event_ids) {
1135
1136         # do a little dance to determine what libraries we are ultimately affecting
1137         my $event = $e->retrieve_action_trigger_event([
1138             $id,
1139             {   flesh => 2,
1140                 flesh_fields => {atev => ['event_def'], atevdef => ['hook']}
1141             }
1142         ]) or return $e->die_event;
1143
1144         my $po = retrieve_purchase_order_impl(
1145             $e,
1146             $event->target(),
1147             {}
1148         );
1149
1150         return $e->die_event unless $e->allowed( ['CREATE_PURCHASE_ORDER','VIEW_PURCHASE_ORDER'], $po->ordering_agency() );
1151
1152         if($self->api_name =~ /cancel/) {
1153             $event->state('invalid');
1154         } elsif($self->api_name =~ /reset/) {
1155             $event->clear_start_time;
1156             $event->clear_update_time;
1157             $event->state('pending');
1158         }
1159
1160         $e->update_action_trigger_event($event) or return $e->die_event;
1161         $conn->respond({maximum => scalar(@$event_ids), progress => $x++});
1162     }
1163
1164     $e->commit;
1165     return {complete => 1};
1166 }
1167
1168
1169 __PACKAGE__->register_method (
1170         method          => 'process_fiscal_rollover',
1171     api_name    => 'open-ils.acq.fiscal_rollover.combined',
1172     stream      => 1,
1173         signature => {
1174         desc => q/
1175             Performs a combined fiscal fund rollover process.
1176
1177             Creates a new series of funds for the following year, copying the old years
1178             funds that are marked as propagable. They apply to the funds belonging to
1179             either an org unit or to an org unit and all of its dependent org units.
1180             The procedures may be run repeatedly; if any fund has already been propagated,
1181             both the old and the new funds will be left alone.
1182
1183             Closes out any applicable funds (by org unit or by org unit and dependents)
1184             that are marked as propagable. If such a fund has not already been propagated
1185             to the new year, it will be propagated at closing time.
1186
1187             If a fund is marked as subject to rollover, any unspent balance in the old year's
1188             fund (including money encumbered but not spent) is transferred to the new year's
1189             fund. Otherwise it is deallocated back to the funding source(s).
1190
1191             In either case, any encumbrance debits are transferred to the new fund, along
1192             with the corresponding lineitem details. The old year's fund is marked as inactive
1193             so that new debits may not be charged to it.
1194         /,
1195         params => [
1196             {desc => 'Authentication token', type => 'string'},
1197             {desc => 'Fund Year to roll over', type => 'integer'},
1198             {desc => 'Org unit ID', type => 'integer'},
1199             {desc => 'Include Descendant Orgs (boolean)', type => 'integer'},
1200         ],
1201         return => {desc => 'Returns a stream of all related funds for the next year including fund summary for each'}
1202     }
1203
1204 );
1205
1206 __PACKAGE__->register_method (
1207         method          => 'process_fiscal_rollover',
1208     api_name    => 'open-ils.acq.fiscal_rollover.combined.dry_run',
1209     stream      => 1,
1210         signature => {
1211         desc => q/
1212             @see open-ils.acq.fiscal_rollover.combined
1213             This is the dry-run version.  The action is performed,
1214             new fund information is returned, then all changes are rolled back.
1215         /
1216     }
1217
1218 );
1219
1220 __PACKAGE__->register_method (
1221         method          => 'process_fiscal_rollover',
1222     api_name    => 'open-ils.acq.fiscal_rollover.propagate',
1223     stream      => 1,
1224         signature => {
1225         desc => q/
1226             @see open-ils.acq.fiscal_rollover.combined
1227             This version performs fund propagation only.  I.e, creation of
1228             the following year's funds.  It does not rollover over balances, encumbrances,
1229             or mark the previous year's funds as complete.
1230         /
1231     }
1232 );
1233
1234 __PACKAGE__->register_method (
1235         method          => 'process_fiscal_rollover',
1236     api_name    => 'open-ils.acq.fiscal_rollover.propagate.dry_run',
1237     stream      => 1,
1238         signature => { desc => q/
1239         @see open-ils.acq.fiscal_rollover.propagate
1240         This is the dry-run version.  The action is performed,
1241         new fund information is returned, then all changes are rolled back.
1242     / }
1243 );
1244
1245
1246
1247 sub process_fiscal_rollover {
1248     my( $self, $conn, $auth, $year, $org_id, $descendants, $options ) = @_;
1249
1250     my $e = new_editor(xact=>1, authtoken=>$auth);
1251     return $e->die_event unless $e->checkauth;
1252     return $e->die_event unless $e->allowed('ADMIN_FUND', $org_id);
1253     $options ||= {};
1254
1255     my $combined = ($self->api_name =~ /combined/);
1256
1257     my $org_ids = ($descendants) ?
1258         [
1259             map
1260             { $_->{id} } # fetch my descendants
1261             @{$e->json_query({from => ['actor.org_unit_descendants', $org_id]})}
1262         ]
1263         : [$org_id];
1264
1265     # Create next year's funds
1266     # Note, it's safe to run this more than once.
1267     # IOW, it will not create duplicate new funds.
1268     $e->json_query({
1269         from => [
1270             ($descendants) ?
1271                 'acq.propagate_funds_by_org_tree' :
1272                 'acq.propagate_funds_by_org_unit',
1273             $year, $e->requestor->id, $org_id
1274         ]
1275     });
1276
1277     if($combined) {
1278
1279         # Roll the uncumbrances over to next year's funds
1280         # Mark the funds for $year as inactive
1281
1282         $e->json_query({
1283             from => [
1284                 ($descendants) ?
1285                     'acq.rollover_funds_by_org_tree' :
1286                     'acq.rollover_funds_by_org_unit',
1287                 $year, $e->requestor->id, $org_id
1288             ]
1289         });
1290     }
1291
1292     # Fetch all funds for the specified org units for the subsequent year
1293     my $fund_ids = $e->search_acq_fund([
1294         {
1295             year => int($year) + 1,
1296             org => $org_ids,
1297             propagate => 't'
1298         }, {
1299             limit => $$options{limit} || 20,
1300             offset => $$options{offset} || 0,
1301         }
1302         ],
1303         {idlist => 1}
1304     );
1305
1306     foreach (@$fund_ids) {
1307         my $fund = $e->retrieve_acq_fund($_) or return $e->die_event;
1308         $fund->summary(retrieve_fund_summary_impl($e, $fund));
1309
1310         my $amount = 0;
1311         if($combined and $U->is_true($fund->rollover)) {
1312             # see how much money was rolled over
1313
1314             my $sum = $e->json_query({
1315                 select => {acqftr => [{column => 'dest_amount', transform => 'sum'}]},
1316                 from => 'acqftr',
1317                 where => {dest_fund => $fund->id, note => 'Rollover'}
1318             })->[0];
1319
1320             $amount = $sum->{dest_amount} if $sum;
1321         }
1322
1323         $conn->respond({fund => $fund, rollover_amount => $amount});
1324     }
1325
1326     $self->api_name =~ /dry_run/ and $e->rollback or $e->commit;
1327     return undef;
1328 }
1329
1330
1331 1;
1332