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