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 sub retrieve_org_funds {
 289     my($self, $conn, $auth, $org_id_list, $options) = @_;
 290     my $e = new_editor(authtoken=>$auth);
 291     return $e->event unless $e->checkauth;
 292     $options ||= {};
 293
 294     my $limit_perm = ($$options{limit_perm}) ? $$options{limit_perm} : 'ADMIN_FUND';
 295     return OpenILS::Event->new('BAD_PARAMS')
 296         unless $limit_perm =~ /(ADMIN|MANAGE|VIEW)_FUND/;
 297
 298     my $org_ids = ($org_id_list and @$org_id_list) ? $org_id_list :
 299         $U->user_has_work_perm_at($e, $limit_perm, {descendants =>1});
 300     return undef unless @$org_ids;
 301     my $funds = $e->search_acq_fund({org => $org_ids});
 302
 303     for my $fund (@$funds) {
 304         $fund->summary(retrieve_fund_summary_impl($e, $fund))
 305             if $$options{flesh_summary};
 306         $conn->respond($fund);
 307     }
 308
 309     return undef;
 310 }
 311
 312 __PACKAGE__->register_method(
 313         method => 'retrieve_fund_summary',
 314         api_name        => 'open-ils.acq.fund.summary.retrieve',
 315         signature => {
 316         desc => 'Returns a summary of credits/debits/encumbrances for a fund',
 317         params => [
 318             {desc => 'Authentication token', type => 'string'},
 319             {desc => 'fund id', type => 'number' }
 320         ],
 321         return => {desc => 'A hash of summary information, Event on failure'}
 322     }
 323 );
 324
 325 sub retrieve_fund_summary {
 326     my($self, $conn, $auth, $fund_id) = @_;
 327     my $e = new_editor(authtoken=>$auth);
 328     return $e->event unless $e->checkauth;
 329     my $fund = $e->retrieve_acq_fund($fund_id) or return $e->event;
 330     return $e->event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
 331     return retrieve_fund_summary_impl($e, $fund);
 332 }
 333
 334
 335 sub retrieve_fund_summary_impl {
 336     my($e, $fund) = @_;
 337
 338     my $at = $e->search_acq_fund_allocation_total({fund => $fund->id})->[0];
 339     my $dt = $e->search_acq_fund_debit_total({fund => $fund->id})->[0];
 340     my $et = $e->search_acq_fund_encumbrance_total({fund => $fund->id})->[0];
 341     my $st = $e->search_acq_fund_spent_total({fund => $fund->id})->[0];
 342     my $cb = $e->search_acq_fund_combined_balance({fund => $fund->id})->[0];
 343     my $sb = $e->search_acq_fund_spent_balance({fund => $fund->id})->[0];
 344
 345     return {
 346         allocation_total => ($at) ? $at->amount : 0,
 347         debit_total => ($dt) ? $dt->amount : 0,
 348         encumbrance_total => ($et) ? $et->amount : 0,
 349         spent_total => ($st) ? $st->amount : 0,
 350         combined_balance => ($cb) ? $cb->amount : 0,
 351         spent_balance => ($sb) ? $sb->amount : 0,
 352     };
 353 }
 354
 355
 356 # ---------------------------------------------------------------
 357 # fund Allocations
 358 # ---------------------------------------------------------------
 359
 360 __PACKAGE__->register_method(
 361         method => 'create_fund_alloc',
 362         api_name        => 'open-ils.acq.fund_allocation.create',
 363         signature => {
 364         desc => 'Creates a new fund_allocation',
 365         params => [
 366             {desc => 'Authentication token', type => 'string'},
 367             {desc => 'fund allocation object to create', type => 'object'}
 368         ],
 369         return => {desc => 'The ID of the new fund_allocation'}
 370     }
 371 );
 372
 373 sub create_fund_alloc {
 374     my($self, $conn, $auth, $fund_alloc) = @_;
 375     my $e = new_editor(xact=>1, authtoken=>$auth);
 376     return $e->die_event unless $e->checkauth;
 377
 378     # this action is equivalent to both debiting a funding source and crediting a fund
 379
 380     my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source)
 381         or return $e->die_event;
 382     return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner);
 383
 384     my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event;
 385     return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
 386
 387     $fund_alloc->allocator($e->requestor->id);
 388     $e->create_acq_fund_allocation($fund_alloc) or return $e->die_event;
 389     $e->commit;
 390     return $fund_alloc->id;
 391 }
 392
 393
 394 __PACKAGE__->register_method(
 395         method => 'delete_fund_alloc',
 396         api_name        => 'open-ils.acq.fund_allocation.delete',
 397         signature => {
 398         desc => 'Deletes a fund_allocation',
 399         params => [
 400             {desc => 'Authentication token', type => 'string'},
 401             {desc => 'fund Alocation ID', type => 'number'}
 402         ],
 403         return => {desc => '1 on success, Event on failure'}
 404     }
 405 );
 406
 407 sub delete_fund_alloc {
 408     my($self, $conn, $auth, $fund_alloc_id) = @_;
 409     my $e = new_editor(xact=>1, authtoken=>$auth);
 410     return $e->die_event unless $e->checkauth;
 411
 412     my $fund_alloc = $e->retrieve_acq_fund_allocation($fund_alloc_id) or return $e->die_event;
 413
 414     my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source)
 415         or return $e->die_event;
 416     return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner, $source);
 417
 418     my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event;
 419     return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
 420
 421     $e->delete_acq_fund_allocation($fund_alloc) or return $e->die_event;
 422     $e->commit;
 423     return 1;
 424 }
 425
 426 __PACKAGE__->register_method(
 427         method => 'retrieve_fund_alloc',
 428         api_name        => 'open-ils.acq.fund_allocation.retrieve',
 429         signature => {
 430         desc => 'Retrieves a new fund_allocation',
 431         params => [
 432             {desc => 'Authentication token', type => 'string'},
 433             {desc => 'fund Allocation ID', type => 'number'}
 434         ],
 435         return => {desc => 'The fund allocation object on success, Event on failure'}
 436     }
 437 );
 438
 439 sub retrieve_fund_alloc {
 440     my($self, $conn, $auth, $fund_alloc_id) = @_;
 441     my $e = new_editor(authtoken=>$auth);
 442     return $e->event unless $e->checkauth;
 443     my $fund_alloc = $e->retrieve_acq_fund_allocation($fund_alloc_id) or return $e->event;
 444
 445     my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source)
 446         or return $e->die_event;
 447     return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner, $source);
 448
 449     my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event;
 450     return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
 451
 452     return $fund_alloc;
 453 }
 454
 455
 456 __PACKAGE__->register_method(
 457         method => 'retrieve_funding_source_allocations',
 458         api_name        => 'open-ils.acq.funding_source.allocations.retrieve',
 459         signature => {
 460         desc => 'Retrieves a new fund_allocation',
 461         params => [
 462             {desc => 'Authentication token', type => 'string'},
 463             {desc => 'fund Allocation ID', type => 'number'}
 464         ],
 465         return => {desc => 'The fund allocation object on success, Event on failure'}
 466     }
 467 );
 468
 469 sub retrieve_funding_source_allocations {
 470     my($self, $conn, $auth, $fund_alloc_id) = @_;
 471     my $e = new_editor(authtoken=>$auth);
 472     return $e->event unless $e->checkauth;
 473     my $fund_alloc = $e->retrieve_acq_fund_allocation($fund_alloc_id) or return $e->event;
 474
 475     my $source = $e->retrieve_acq_funding_source($fund_alloc->funding_source)
 476         or return $e->die_event;
 477     return $e->die_event unless $e->allowed('MANAGE_FUNDING_SOURCE', $source->owner, $source);
 478
 479     my $fund = $e->retrieve_acq_fund($fund_alloc->fund) or return $e->die_event;
 480     return $e->die_event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
 481
 482     return $fund_alloc;
 483 }
 484
 485 # ----------------------------------------------------------------------------
 486 # Currency
 487 # ----------------------------------------------------------------------------
 488
 489 __PACKAGE__->register_method(
 490         method => 'retrieve_all_currency_type',
 491         api_name        => 'open-ils.acq.currency_type.all.retrieve',
 492     stream => 1,
 493         signature => {
 494         desc => 'Retrieves all currency_type objects',
 495         params => [
 496             {desc => 'Authentication token', type => 'string'},
 497         ],
 498         return => {desc => 'List of currency_type objects', type => 'list'}
 499     }
 500 );
 501
 502 sub retrieve_all_currency_type {
 503     my($self, $conn, $auth, $fund_alloc_id) = @_;
 504     my $e = new_editor(authtoken=>$auth);
 505     return $e->event unless $e->checkauth;
 506     return $e->event unless $e->allowed('GENERAL_ACQ');
 507     $conn->respond($_) for @{$e->retrieve_all_acq_currency_type()};
 508 }
 509
 510 sub currency_conversion_impl {
 511     my($src_currency, $dest_currency, $amount) = @_;
 512     my $result = new_editor()->json_query({
 513         select => {
 514             acqct => [{
 515                 params => [$dest_currency, $amount],
 516                 transform => 'acq.exchange_ratio',
 517                 column => 'code',
 518                 alias => 'value'
 519             }]
 520         },
 521         where => {code => $src_currency},
 522         from => 'acqct'
 523     });
 524
 525     return $result->[0]->{value};
 526 }
 527
 528
 529 # ----------------------------------------------------------------------------
 530 # Purchase Orders
 531 # ----------------------------------------------------------------------------
 532
 533 __PACKAGE__->register_method(
 534         method => 'create_purchase_order',
 535         api_name        => 'open-ils.acq.purchase_order.create',
 536         signature => {
 537         desc => 'Creates a new purchase order',
 538         params => [
 539             {desc => 'Authentication token', type => 'string'},
 540             {desc => 'purchase_order to create', type => 'object'}
 541         ],
 542         return => {desc => 'The purchase order id, Event on failure'}
 543     }
 544 );
 545
 546 sub create_purchase_order {
 547     my($self, $conn, $auth, $po, $args) = @_;
 548     $args ||= {};
 549
 550     my $e = new_editor(xact=>1, authtoken=>$auth);
 551     return $e->die_event unless $e->checkauth;
 552     return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
 553
 554     # create the PO
 555     $po->ordering_agency($e->requestor->ws_ou);
 556     my $evt = create_purchase_order_impl($e, $po);
 557     return $evt if $evt;
 558
 559     my $progress = 0;
 560     my $total_debits = 0;
 561     my $total_copies = 0;
 562
 563     my $respond = sub {
 564         $conn->respond({
 565             @_,
 566             progress => ++$progress,
 567             total_debits => $total_debits,
 568             total_copies => $total_copies,
 569         });
 570     };
 571
 572     if($$args{lineitems}) {
 573
 574         for my $li_id (@{$$args{lineitems}}) {
 575
 576             my $li = $e->retrieve_acq_lineitem([
 577                 $li_id,
 578                 {flesh => 1, flesh_fields => {jub => ['attributes']}}
 579             ]) or return $e->die_event;
 580
 581             # point the lineitems at the new PO
 582             $li->purchase_order($po->id);
 583             $li->editor($e->requestor->id);
 584             $li->edit_time('now');
 585             $e->update_acq_lineitem($li) or return $e->die_event;
 586
 587             # create the bibs/volumes/copies in the Evergreen database
 588             if($$args{create_assets}) {
 589                 # args = {circ_modifier => code}
 590                 my ($count, $evt) = create_lineitem_assets_impl($e, $li_id, $args);
 591                 return $evt if $evt;
 592                 $total_copies+= $count;
 593                 $respond->(action => 'create_assets');
 594             }
 595
 596             # create the debits
 597             if($$args{create_debits}) {
 598                 # args = {encumberance => true}
 599                 my ($total, $evt) = create_li_debit_impl($e, $li, $args);
 600                 return $evt if $evt;
 601                 $total_debits += $total;
 602                 $respond->(action => 'create_debit');
 603             }
 604         }
 605     }
 606
 607     $e->commit;
 608     $respond->(complete => 1, purchase_order => $po->id);
 609     return undef;
 610 }
 611
 612
 613 __PACKAGE__->register_method(
 614         method => 'create_po_assets',
 615         api_name        => 'open-ils.acq.purchase_order.assets.create',
 616         signature => {
 617         desc => q/Creates assets for each lineitem in the purchase order/,
 618         params => [
 619             {desc => 'Authentication token', type => 'string'},
 620             {desc => 'The purchase order id', type => 'number'},
 621             {desc => q/Options hash./}
 622         ],
 623         return => {desc => 'Streams a total versus completed counts object, event on error'}
 624     }
 625 );
 626
 627 sub create_po_assets {
 628     my($self, $conn, $auth, $po_id, $options) = @_;
 629     my $e = new_editor(authtoken=>$auth, xact=>1);
 630     return $e->die_event unless $e->checkauth;
 631
 632     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event;
 633     return $e->die_event unless
 634         $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
 635
 636     my $li_ids = $e->search_acq_lineitem({purchase_order=>$po_id},{idlist=>1});
 637     my $total = @$li_ids;
 638     my $count = 0;
 639
 640     for my $li_id (@$li_ids) {
 641         my ($num, $evt) = create_lineitem_assets_impl($e, $li_id);
 642         return $evt if $evt;
 643         $conn->respond({total=>$count, progress=>++$count});
 644     }
 645
 646     $po->edit_time('now');
 647     $e->update_acq_purchase_order($po) or return $e->die_event;
 648     $e->commit;
 649
 650     return {complete=>1};
 651 }
 652
 653 __PACKAGE__->register_method(
 654         method => 'create_lineitem_assets',
 655         api_name        => 'open-ils.acq.lineitem.assets.create',
 656         signature => {
 657         desc => q/Creates the bibliographic data, volume, and copies associated with a lineitem./,
 658         params => [
 659             {desc => 'Authentication token', type => 'string'},
 660             {desc => 'The lineitem id', type => 'number'},
 661             {desc => q/Options hash./}
 662         ],
 663         return => {desc => 'ID of newly created bib record, Event on error'}
 664     }
 665 );
 666
 667 sub create_lineitem_assets {
 668     my($self, $conn, $auth, $li_id, $options) = @_;
 669     my $e = new_editor(authtoken=>$auth, xact=>1);
 670     return $e->die_event unless $e->checkauth;
 671     my ($count, $resp) = create_lineitem_assets_impl($e, $li_id, $options);
 672     return $resp if $resp;
 673     $e->commit;
 674     return $count;
 675 }
 676
 677 sub create_lineitem_assets_impl {
 678     my($e, $li_id, $options) = @_;
 679     $options ||= {};
 680     my $evt;
 681
 682     my $li = $e->retrieve_acq_lineitem([
 683         $li_id,
 684         {   flesh => 1,
 685             flesh_fields => {jub => ['purchase_order', 'attributes']}
 686         }
 687     ]) or return (undef, $e->die_event);
 688
 689     # -----------------------------------------------------------------
 690     # first, create the bib record if necessary
 691     # -----------------------------------------------------------------
 692     unless($li->eg_bib_id) {
 693
 694        my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 695             $e, $li->marc, undef, undef, undef, 1); #$rec->bib_source
 696
 697         if($U->event_code($record)) {
 698             $e->rollback;
 699             return (undef, $record);
 700         }
 701
 702         $li->editor($e->requestor->id);
 703         $li->edit_time('now');
 704         $li->eg_bib_id($record->id);
 705         $e->update_acq_lineitem($li) or return (undef, $e->die_event);
 706     }
 707
 708     my $li_details = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
 709
 710     # -----------------------------------------------------------------
 711     # for each lineitem_detail, create the volume if necessary, create
 712     # a copy, and link them all together.
 713     # -----------------------------------------------------------------
 714     my %volcache;
 715     for my $li_detail_id (@{$li_details}) {
 716
 717         my $li_detail = $e->retrieve_acq_lineitem_detail($li_detail_id)
 718             or return (undef, $e->die_event);
 719
 720         # Create the volume object if necessary
 721         my $volume = $volcache{$li_detail->cn_label};
 722         unless($volume and $volume->owning_lib == $li_detail->owning_lib) {
 723             ($volume, $evt) =
 724                 OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
 725                     $e, $li_detail->cn_label, $li->eg_bib_id, $li_detail->owning_lib);
 726             return (undef, $evt) if $evt;
 727             $volcache{$volume->id} = $volume;
 728         }
 729
 730         my $copy = Fieldmapper::asset::copy->new;
 731         $copy->isnew(1);
 732         $copy->loan_duration(2);
 733         $copy->fine_level(2);
 734         $copy->status(OILS_COPY_STATUS_ON_ORDER);
 735         $copy->barcode($li_detail->barcode);
 736         $copy->location($li_detail->location);
 737         $copy->call_number($volume->id);
 738         $copy->circ_lib($volume->owning_lib);
 739         $copy->circ_modifier($$options{circ_modifier} || 'book');
 740
 741         $evt = OpenILS::Application::Cat::AssetCommon->create_copy($e, $volume, $copy);
 742         return (undef, $evt) if $evt;
 743
 744         $li_detail->eg_copy_id($copy->id);
 745         $e->update_acq_lineitem_detail($li_detail) or return (undef, $e->die_event);
 746     }
 747
 748     return (scalar @{$li_details});
 749 }
 750
 751
 752
 753
 754 sub create_purchase_order_impl {
 755     my($e, $p_order) = @_;
 756
 757     $p_order->creator($e->requestor->id);
 758     $p_order->editor($e->requestor->id);
 759     $p_order->owner($e->requestor->id);
 760     $p_order->edit_time('now');
 761
 762     return $e->die_event unless
 763         $e->allowed('CREATE_PURCHASE_ORDER', $p_order->ordering_agency);
 764
 765     my $provider = $e->retrieve_acq_provider($p_order->provider)
 766         or return $e->die_event;
 767     return $e->die_event unless
 768         $e->allowed('MANAGE_PROVIDER', $provider->owner, $provider);
 769
 770     $e->create_acq_purchase_order($p_order) or return $e->die_event;
 771     return undef;
 772 }
 773
 774
 775 # returns (price, type), where type=1 is local, type=2 is provider, type=3 is marc
 776 sub get_li_price {
 777     my $li = shift;
 778     my $attrs = $li->attributes;
 779     my ($marc_estimated, $local_estimated, $local_actual, $prov_estimated, $prov_actual);
 780
 781     for my $attr (@$attrs) {
 782         if($attr->attr_name eq 'estimated_price') {
 783             $local_estimated = $attr->attr_value
 784                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 785             $prov_estimated = $attr->attr_value
 786                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 787             $marc_estimated = $attr->attr_value
 788                 if $attr->attr_type eq 'lineitem_marc_attr_definition';
 789
 790         } elsif($attr->attr_name eq 'actual_price') {
 791             $local_actual = $attr->attr_value
 792                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 793             $prov_actual = $attr->attr_value
 794                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 795         }
 796     }
 797
 798     return ($local_actual, 1) if $local_actual;
 799     return ($prov_actual, 2) if $prov_actual;
 800     return ($local_estimated, 1) if $local_estimated;
 801     return ($prov_estimated, 2) if $prov_estimated;
 802     return ($marc_estimated, 3);
 803 }
 804
 805
 806 __PACKAGE__->register_method(
 807         method => 'create_purchase_order_debits',
 808         api_name        => 'open-ils.acq.purchase_order.debits.create',
 809         signature => {
 810         desc => 'Creates debits associated with a PO',
 811         params => [
 812             {desc => 'Authentication token', type => 'string'},
 813             {desc => 'purchase_order whose debits to create', type => 'number'},
 814             {desc => 'arguments hash.  Options include: encumbrance=bool', type => 'object'},
 815         ],
 816         return => {desc => 'The total amount of all created debits, Event on error'}
 817     }
 818 );
 819
 820 sub create_purchase_order_debits {
 821     my($self, $conn, $auth, $po_id, $args) = @_;
 822     my $e = new_editor(xact=>1, authtoken=>$auth);
 823     return $e->die_event unless $e->checkauth;
 824
 825     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
 826
 827     my $li_ids = $e->search_acq_lineitem(
 828         {purchase_order => $po_id},
 829         {idlist => 1}
 830     );
 831
 832     for my $li_id (@$li_ids) {
 833         my $li = $e->retrieve_acq_lineitem([
 834             $li_id,
 835             {   flesh => 1,
 836                 flesh_fields => {jub => ['attributes']},
 837             }
 838         ]);
 839
 840         my ($total, $evt) = create_li_debit_impl($e, $li);
 841         return $evt if $evt;
 842     }
 843     $e->commit;
 844     return 1;
 845 }
 846
 847 sub create_li_debit_impl {
 848     my($e, $li, $args) = @_;
 849     $args ||= {};
 850
 851     my ($price, $ptype) = get_li_price($li);
 852
 853     unless($price) {
 854         $e->rollback;
 855         return (undef, OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
 856     }
 857
 858     unless($li->provider) {
 859         $e->rollback;
 860         return (undef, OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
 861     }
 862
 863     my $lid_ids = $e->search_acq_lineitem_detail(
 864         {lineitem => $li->id},
 865         {idlist=>1}
 866     );
 867
 868     my $total = 0;
 869     for my $lid_id (@$lid_ids) {
 870
 871         my $lid = $e->retrieve_acq_lineitem_detail([
 872             $lid_id,
 873             {   flesh => 1,
 874                 flesh_fields => {acqlid => ['fund']}
 875             }
 876         ]);
 877
 878         my $debit = Fieldmapper::acq::fund_debit->new;
 879         $debit->fund($lid->fund->id);
 880         $debit->origin_amount($price);
 881
 882         if($ptype == 2) { # price from vendor
 883             $debit->origin_currency_type($li->provider->currency_type);
 884             $debit->amount(currency_conversion_impl(
 885                 $li->provider->currency_type, $lid->fund->currency_type, $price));
 886         } else {
 887             $debit->origin_currency_type($lid->fund->currency_type);
 888             $debit->amount($price);
 889         }
 890
 891         $debit->encumbrance($args->{encumbrance});
 892         $debit->debit_type('purchase');
 893         $e->create_acq_fund_debit($debit) or return (undef, $e->die_event);
 894
 895         # point the lineitem detail at the fund debit object
 896         $lid->fund_debit($debit->id);
 897         $lid->fund($lid->fund->id);
 898         $e->update_acq_lineitem_detail($lid) or return (undef, $e->die_event);
 899         $total += $debit->amount;
 900     }
 901
 902     return ($total);
 903 }
 904
 905
 906 __PACKAGE__->register_method(
 907         method => 'retrieve_all_user_purchase_order',
 908         api_name        => 'open-ils.acq.purchase_order.user.all.retrieve',
 909     stream => 1,
 910         signature => {
 911         desc => 'Retrieves a purchase order',
 912         params => [
 913             {desc => 'Authentication token', type => 'string'},
 914             {desc => 'purchase_order to retrieve', type => 'number'},
 915             {desc => q/Options hash.  flesh_lineitems: to get the lineitems and lineitem_attrs;
 916                 clear_marc: to clear the MARC data from the lineitem (for reduced bandwidth);
 917                 limit: number of items to return ,defaults to 50;
 918                 offset: offset in the list of items to return
 919                 order_by: sort the result, provide one or more colunm names, separated by commas,
 920                 optionally followed by ASC or DESC as a single string
 921                 li_limit : number of lineitems to return if fleshing line items;
 922                 li_offset : lineitem offset if fleshing line items
 923                 li_order_by : lineitem sort definition if fleshing line items
 924                 flesh_lineitem_detail_count : flesh lineitem_detail_count field
 925                 /,
 926                 type => 'hash'}
 927         ],
 928         return => {desc => 'The purchase order, Event on failure'}
 929     }
 930 );
 931
 932 sub retrieve_all_user_purchase_order {
 933     my($self, $conn, $auth, $options) = @_;
 934     my $e = new_editor(authtoken=>$auth);
 935     return $e->event unless $e->checkauth;
 936     $options ||= {};
 937
 938     # grab purchase orders I have
 939     my $perm_orgs = $U->user_has_work_perm_at($e, 'MANAGE_PROVIDER', {descendants =>1});
 940         return OpenILS::Event->new('PERM_FAILURE', ilsperm => 'MANAGE_PROVIDER')
 941         unless @$perm_orgs;
 942     my $provider_ids = $e->search_acq_provider({owner => $perm_orgs}, {idlist=>1});
 943     my $po_ids = $e->search_acq_purchase_order({provider => $provider_ids}, {idlist=>1});
 944
 945     # grab my purchase orders
 946     push(@$po_ids, @{$e->search_acq_purchase_order({owner => $e->requestor->id}, {idlist=>1})});
 947
 948     return undef unless @$po_ids;
 949
 950     # now get the db to limit/sort for us
 951     $po_ids = $e->search_acq_purchase_order(
 952         [   {id => $po_ids}, {
 953                 limit => $$options{limit} || 50,
 954                 offset => $$options{offset} || 0,
 955                 order_by => {acqpo => $$options{order_by} || 'create_time'}
 956             }
 957         ],
 958         {idlist => 1}
 959     );
 960
 961     $conn->respond(retrieve_purchase_order_impl($e, $_, $options)) for @$po_ids;
 962     return undef;
 963 }
 964
 965
 966 __PACKAGE__->register_method(
 967         method => 'search_purchase_order',
 968         api_name        => 'open-ils.acq.purchase_order.search',
 969     stream => 1,
 970         signature => {
 971         desc => 'Search for a purchase order',
 972         params => [
 973             {desc => 'Authentication token', type => 'string'},
 974             {desc => q/Search hash.  Search fields include id, provider/, type => 'hash'}
 975         ],
 976         return => {desc => 'A stream of POs'}
 977     }
 978 );
 979
 980 sub search_purchase_order {
 981     my($self, $conn, $auth, $search, $options) = @_;
 982     my $e = new_editor(authtoken=>$auth);
 983     return $e->event unless $e->checkauth;
 984     my $po_ids = $e->search_acq_purchase_order($search, {idlist=>1});
 985     for my $po_id (@$po_ids) {
 986         $conn->respond($e->retrieve_acq_purchase_order($po_id))
 987             unless po_perm_failure($e, $po_id);
 988     }
 989
 990     return undef;
 991 }
 992
 993
 994
 995 __PACKAGE__->register_method(
 996         method => 'retrieve_purchase_order',
 997         api_name        => 'open-ils.acq.purchase_order.retrieve',
 998         signature => {
 999         desc => 'Retrieves a purchase order',
1000         params => [
1001             {desc => 'Authentication token', type => 'string'},
1002             {desc => 'purchase_order to retrieve', type => 'number'},
1003             {desc => q/Options hash.  flesh_lineitems, to get the lineitems and lineitem_attrs;
1004                 clear_marc, to clear the MARC data from the lineitem (for reduced bandwidth)
1005                 li_limit : number of lineitems to return if fleshing line items;
1006                 li_offset : lineitem offset if fleshing line items
1007                 li_order_by : lineitem sort definition if fleshing line items
1008                 /,
1009                 type => 'hash'}
1010         ],
1011         return => {desc => 'The purchase order, Event on failure'}
1012     }
1013 );
1014
1015 sub retrieve_purchase_order {
1016     my($self, $conn, $auth, $po_id, $options) = @_;
1017     my $e = new_editor(authtoken=>$auth);
1018     return $e->event unless $e->checkauth;
1019     return $e->event if po_perm_failure($e, $po_id);
1020     return retrieve_purchase_order_impl($e, $po_id, $options);
1021 }
1022
1023
1024 # if the user does not have permission to perform actions on this PO, return the perm failure event
1025 sub po_perm_failure {
1026     my($e, $po_id, $fund_id) = @_;
1027     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event;
1028     my $provider = $e->retrieve_acq_provider($po->provider) or return $e->event;
1029     return $e->event unless $e->allowed('MANAGE_PROVIDER', $provider->owner, $provider);
1030     if($fund_id) {
1031         my $fund = $e->retrieve_acq_fund($po->$fund_id);
1032         return $e->event unless $e->allowed('MANAGE_FUND', $fund->org, $fund);
1033     }
1034     return undef;
1035 }
1036
1037 sub retrieve_purchase_order_impl {
1038     my($e, $po_id, $options) = @_;
1039
1040     $options ||= {};
1041     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->event;
1042
1043     if($$options{flesh_lineitems}) {
1044         my $items = $e->search_acq_lineitem([
1045             {purchase_order => $po_id},
1046             {
1047                 flesh => 1,
1048                 flesh_fields => {
1049                     jub => ['attributes']
1050                 },
1051                 limit => $$options{li_limit} || 50,
1052                 offset => $$options{li_offset} || 0,
1053                 order_by => {jub => $$options{li_order_by} || 'create_time'}
1054             }
1055         ]);
1056
1057         if($$options{clear_marc}) {
1058             $_->clear_marc for @$items;
1059         }
1060
1061         $po->lineitems($items);
1062     }
1063
1064     if($$options{flesh_lineitem_count}) {
1065         my $items = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist=>1});
1066         $po->lineitem_count(scalar(@$items));
1067     }
1068
1069     return $po;
1070 }
1071
1072
1073 1;
1074