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     # let's just always flesh this if it's there. what the hey.
 903     my $flesh = {
 904         "flesh" => 1, "flesh_fields" => {"acqpo" => ["cancel_reason"]}
 905     };
 906
 907     $options ||= {};
 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     my $po = $e->retrieve_acq_purchase_order([$po_id, $flesh])
 915         or return $e->event;
 916
 917     if($$options{flesh_lineitems}) {
 918
 919         my $items = $e->search_acq_lineitem([
 920             {purchase_order => $po_id},
 921             {
 922                 flesh => 1,
 923                 flesh_fields => {
 924                     jub => ['attributes']
 925                 },
 926                 limit => $$options{li_limit} || 50,
 927                 offset => $$options{li_offset} || 0,
 928                 order_by => {jub => $$options{li_order_by} || 'create_time'}
 929             }
 930         ]);
 931
 932         if($$options{clear_marc}) {
 933             $_->clear_marc for @$items;
 934         }
 935
 936         $po->lineitems($items);
 937         $po->lineitem_count(scalar(@$items));
 938
 939     } elsif( $$options{flesh_lineitem_count} ) {
 940
 941         my $items = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist=>1});
 942         $po->lineitem_count(scalar(@$items));
 943     }
 944
 945     if($$options{flesh_price_summary}) {
 946         my ($enc, $spent) = build_price_summary($e, $po_id);
 947         $po->amount_encumbered($enc);
 948         $po->amount_spent($spent);
 949     }
 950
 951     return $po;
 952 }
 953
 954
 955 __PACKAGE__->register_method(
 956         method => 'format_po',
 957         api_name        => 'open-ils.acq.purchase_order.format'
 958 );
 959
 960 sub format_po {
 961     my($self, $conn, $auth, $po_id, $format) = @_;
 962     my $e = new_editor(authtoken=>$auth);
 963     return $e->event unless $e->checkauth;
 964
 965     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event;
 966     return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency);
 967
 968     my $hook = "format.po.$format";
 969     return $U->fire_object_event(undef, $hook, $po, $po->ordering_agency);
 970 }
 971
 972 __PACKAGE__->register_method(
 973         method => 'format_lineitem',
 974         api_name        => 'open-ils.acq.lineitem.format'
 975 );
 976
 977 sub format_lineitem {
 978     my($self, $conn, $auth, $li_id, $format, $user_data) = @_;
 979     my $e = new_editor(authtoken=>$auth);
 980     return $e->event unless $e->checkauth;
 981
 982     my $li = $e->retrieve_acq_lineitem($li_id) or return $e->event;
 983
 984     my $context_org;
 985     if (defined $li->purchase_order) {
 986         my $po = $e->retrieve_acq_purchase_order($li->purchase_order) or return $e->die_event;
 987         return $e->event unless $e->allowed('VIEW_PURCHASE_ORDER', $po->ordering_agency);
 988         $context_org = $po->ordering_agency;
 989     } else {
 990         my $pl = $e->retrieve_acq_picklist($li->picklist) or return $e->die_event;
 991         if($e->requestor->id != $pl->owner) {
 992             return $e->event unless
 993                 $e->allowed('VIEW_PICKLIST', $pl->org_unit, $pl);
 994         }
 995         $context_org = $pl->org_unit;
 996     }
 997
 998     my $hook = "format.acqli.$format";
 999     return $U->fire_object_event(undef, $hook, $li, $context_org, 'print-on-demand', $user_data);
1000 }
1001
1002 __PACKAGE__->register_method (
1003     method        => 'po_events',
1004     api_name    => 'open-ils.acq.purchase_order.events.owner',
1005     stream      => 1,
1006     signature => q/
1007         Retrieve EDI-related purchase order events (format.po.jedi), by default those which are pending.
1008         @param authtoken Login session key
1009         @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.
1010         @param options Object for tweaking the selection criteria and fleshing options.
1011     /
1012 );
1013
1014 __PACKAGE__->register_method (
1015     method        => 'po_events',
1016     api_name    => 'open-ils.acq.purchase_order.events.ordering_agency',
1017     stream      => 1,
1018     signature => q/
1019         Retrieve EDI-related purchase order events (format.po.jedi), by default those which are pending.
1020         @param authtoken Login session key
1021         @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.
1022         @param options Object for tweaking the selection criteria and fleshing options.
1023     /
1024 );
1025
1026 __PACKAGE__->register_method (
1027     method        => 'po_events',
1028     api_name    => 'open-ils.acq.purchase_order.events.id',
1029     stream      => 1,
1030     signature => q/
1031         Retrieve EDI-related purchase order events (format.po.jedi), by default those which are pending.
1032         @param authtoken Login session key
1033         @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.
1034         @param options Object for tweaking the selection criteria and fleshing options.
1035     /
1036 );
1037
1038 sub po_events {
1039     my($self, $conn, $auth, $search_value, $options) = @_;
1040     my $e = new_editor(authtoken => $auth);
1041     return $e->event unless $e->checkauth;
1042
1043     (my $search_field = $self->api_name) =~ s/.*\.([_a-z]+)$/$1/;
1044     my $obj_type = 'acqpo';
1045
1046     if ($search_field eq 'ordering_agency') {
1047         $search_value = $U->get_org_descendants($search_value);
1048     }
1049
1050     my $query = {
1051         "select"=>{"atev"=>["id"]},
1052         "from"=>"atev",
1053         "where"=>{
1054             "target"=>{
1055                 "in"=>{
1056                     "select"=>{$obj_type=>["id"]},
1057                     "from"=>$obj_type,
1058                     "where"=>{$search_field=>$search_value}
1059                 }
1060             },
1061             "event_def"=>{
1062                 "in"=>{
1063                     "select"=>{atevdef=>["id"]},
1064                     "from"=>"atevdef",
1065                     "where"=>{
1066                         "hook"=>"format.po.jedi"
1067                     }
1068                 }
1069             },
1070             "state"=>"pending"
1071         },
1072         "order_by"=>[{"class"=>"atev", "field"=>"run_time", "direction"=>"desc"}]
1073     };
1074
1075     if ($options && defined $options->{state}) {
1076         $query->{'where'}{'state'} = $options->{state}
1077     }
1078
1079     if ($options && defined $options->{start_time}) {
1080         $query->{'where'}{'start_time'} = $options->{start_time};
1081     }
1082
1083     if ($options && defined $options->{order_by}) {
1084         $query->{'order_by'} = $options->{order_by};
1085     }
1086     my $po_events = $e->json_query($query);
1087
1088     my $flesh_fields = { 'atev' => [ 'event_def' ] };
1089     my $flesh_depth = 1;
1090
1091     for my $id (@$po_events) {
1092         my $event = $e->retrieve_action_trigger_event([
1093             $id->{id},
1094             {flesh => $flesh_depth, flesh_fields => $flesh_fields}
1095         ]);
1096         if (! $event) { next; }
1097
1098         my $po = retrieve_purchase_order_impl(
1099             $e,
1100             $event->target(),
1101             {flesh_lineitem_count=>1,flesh_price_summary=>1}
1102         );
1103
1104         if ($e->allowed( ['CREATE_PURCHASE_ORDER','VIEW_PURCHASE_ORDER'], $po->ordering_agency() )) {
1105             $event->target( $po );
1106             $conn->respond($event);
1107         }
1108     }
1109
1110     return undef;
1111 }
1112
1113 __PACKAGE__->register_method (
1114         method          => 'update_po_events',
1115     api_name    => 'open-ils.acq.purchase_order.event.cancel.batch',
1116     stream      => 1,
1117 );
1118 __PACKAGE__->register_method (
1119         method          => 'update_po_events',
1120     api_name    => 'open-ils.acq.purchase_order.event.reset.batch',
1121     stream      => 1,
1122 );
1123
1124 sub update_po_events {
1125     my($self, $conn, $auth, $event_ids) = @_;
1126     my $e = new_editor(xact => 1, authtoken => $auth);
1127     return $e->die_event unless $e->checkauth;
1128
1129     my $x = 1;
1130     for my $id (@$event_ids) {
1131
1132         # do a little dance to determine what libraries we are ultimately affecting
1133         my $event = $e->retrieve_action_trigger_event([
1134             $id,
1135             {   flesh => 2,
1136                 flesh_fields => {atev => ['event_def'], atevdef => ['hook']}
1137             }
1138         ]) or return $e->die_event;
1139
1140         my $po = retrieve_purchase_order_impl(
1141             $e,
1142             $event->target(),
1143             {}
1144         );
1145
1146         return $e->die_event unless $e->allowed( ['CREATE_PURCHASE_ORDER','VIEW_PURCHASE_ORDER'], $po->ordering_agency() );
1147
1148         if($self->api_name =~ /cancel/) {
1149             $event->state('invalid');
1150         } elsif($self->api_name =~ /reset/) {
1151             $event->clear_start_time;
1152             $event->clear_update_time;
1153             $event->state('pending');
1154         }
1155
1156         $e->update_action_trigger_event($event) or return $e->die_event;
1157         $conn->respond({maximum => scalar(@$event_ids), progress => $x++});
1158     }
1159
1160     $e->commit;
1161     return {complete => 1};
1162 }
1163
1164
1165 __PACKAGE__->register_method (
1166         method          => 'process_fiscal_rollover',
1167     api_name    => 'open-ils.acq.fiscal_rollover.combined',
1168     stream      => 1,
1169         signature => {
1170         desc => q/
1171             Performs a combined fiscal fund rollover process.
1172
1173             Creates a new series of funds for the following year, copying the old years
1174             funds that are marked as propagable. They apply to the funds belonging to
1175             either an org unit or to an org unit and all of its dependent org units.
1176             The procedures may be run repeatedly; if any fund has already been propagated,
1177             both the old and the new funds will be left alone.
1178
1179             Closes out any applicable funds (by org unit or by org unit and dependents)
1180             that are marked as propagable. If such a fund has not already been propagated
1181             to the new year, it will be propagated at closing time.
1182
1183             If a fund is marked as subject to rollover, any unspent balance in the old year's
1184             fund (including money encumbered but not spent) is transferred to the new year's
1185             fund. Otherwise it is deallocated back to the funding source(s).
1186
1187             In either case, any encumbrance debits are transferred to the new fund, along
1188             with the corresponding lineitem details. The old year's fund is marked as inactive
1189             so that new debits may not be charged to it.
1190         /,
1191         params => [
1192             {desc => 'Authentication token', type => 'string'},
1193             {desc => 'Fund Year to roll over', type => 'integer'},
1194             {desc => 'Org unit ID', type => 'integer'},
1195             {desc => 'Include Descendant Orgs (boolean)', type => 'integer'},
1196         ],
1197         return => {desc => 'Returns a stream of all related funds for the next year including fund summary for each'}
1198     }
1199
1200 );
1201
1202 __PACKAGE__->register_method (
1203         method          => 'process_fiscal_rollover',
1204     api_name    => 'open-ils.acq.fiscal_rollover.combined.dry_run',
1205     stream      => 1,
1206         signature => {
1207         desc => q/
1208             @see open-ils.acq.fiscal_rollover.combined
1209             This is the dry-run version.  The action is performed,
1210             new fund information is returned, then all changes are rolled back.
1211         /
1212     }
1213
1214 );
1215
1216 __PACKAGE__->register_method (
1217         method          => 'process_fiscal_rollover',
1218     api_name    => 'open-ils.acq.fiscal_rollover.propagate',
1219     stream      => 1,
1220         signature => {
1221         desc => q/
1222             @see open-ils.acq.fiscal_rollover.combined
1223             This version performs fund propagation only.  I.e, creation of
1224             the following year's funds.  It does not rollover over balances, encumbrances,
1225             or mark the previous year's funds as complete.
1226         /
1227     }
1228 );
1229
1230 __PACKAGE__->register_method (
1231         method          => 'process_fiscal_rollover',
1232     api_name    => 'open-ils.acq.fiscal_rollover.propagate.dry_run',
1233     stream      => 1,
1234         signature => { desc => q/
1235         @see open-ils.acq.fiscal_rollover.propagate
1236         This is the dry-run version.  The action is performed,
1237         new fund information is returned, then all changes are rolled back.
1238     / }
1239 );
1240
1241
1242
1243 sub process_fiscal_rollover {
1244     my( $self, $conn, $auth, $year, $org_id, $descendants, $options ) = @_;
1245
1246     my $e = new_editor(xact=>1, authtoken=>$auth);
1247     return $e->die_event unless $e->checkauth;
1248     return $e->die_event unless $e->allowed('ADMIN_FUND', $org_id);
1249     $options ||= {};
1250
1251     my $combined = ($self->api_name =~ /combined/);
1252
1253     my $org_ids = ($descendants) ?
1254         [
1255             map
1256             { $_->{id} } # fetch my descendants
1257             @{$e->json_query({from => ['actor.org_unit_descendants', $org_id]})}
1258         ]
1259         : [$org_id];
1260
1261     # Create next year's funds
1262     # Note, it's safe to run this more than once.
1263     # IOW, it will not create duplicate new funds.
1264     $e->json_query({
1265         from => [
1266             ($descendants) ?
1267                 'acq.propagate_funds_by_org_tree' :
1268                 'acq.propagate_funds_by_org_unit',
1269             $year, $e->requestor->id, $org_id
1270         ]
1271     });
1272
1273     if($combined) {
1274
1275         # Roll the uncumbrances over to next year's funds
1276         # Mark the funds for $year as inactive
1277
1278         $e->json_query({
1279             from => [
1280                 ($descendants) ?
1281                     'acq.rollover_funds_by_org_tree' :
1282                     'acq.rollover_funds_by_org_unit',
1283                 $year, $e->requestor->id, $org_id
1284             ]
1285         });
1286     }
1287
1288     # Fetch all funds for the specified org units for the subsequent year
1289     my $fund_ids = $e->search_acq_fund([
1290         {
1291             year => int($year) + 1,
1292             org => $org_ids,
1293             propagate => 't'
1294         }, {
1295             limit => $$options{limit} || 20,
1296             offset => $$options{offset} || 0,
1297         }
1298         ],
1299         {idlist => 1}
1300     );
1301
1302     foreach (@$fund_ids) {
1303         my $fund = $e->retrieve_acq_fund($_) or return $e->die_event;
1304         $fund->summary(retrieve_fund_summary_impl($e, $fund));
1305
1306         my $amount = 0;
1307         if($combined and $U->is_true($fund->rollover)) {
1308             # see how much money was rolled over
1309
1310             my $sum = $e->json_query({
1311                 select => {acqftr => [{column => 'dest_amount', transform => 'sum'}]},
1312                 from => 'acqftr',
1313                 where => {dest_fund => $fund->id, note => 'Rollover'}
1314             })->[0];
1315
1316             $amount = $sum->{dest_amount} if $sum;
1317         }
1318
1319         $conn->respond({fund => $fund, rollover_amount => $amount});
1320     }
1321
1322     $self->api_name =~ /dry_run/ and $e->rollback or $e->commit;
1323     return undef;
1324 }
1325
1326
1327 1;
1328