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

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