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