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

   1 package OpenILS::Application::Acq::BatchManager;
   2 use OpenSRF::AppSession;
   3 use OpenSRF::EX qw/:try/;
   4 use strict; use warnings;
   5
   6 sub new {
   7     my($class, %args) = @_;
   8     my $self = bless(\%args, $class);
   9     $self->{args} = {
  10         lid => 0,
  11         li => 0,
  12         copies => 0,
  13         bibs => 0,
  14         progress => 0,
  15         debits_accrued => 0,
  16         purchase_order => undef,
  17         picklist => undef,
  18         complete => 0,
  19         indexed => 0,
  20         total => 0
  21     };
  22     $self->{ingest_queue} = [];
  23     $self->{cache} = {};
  24     $self->throttle(5) unless $self->throttle;
  25     return $self;
  26 }
  27
  28 sub conn {
  29     my($self, $val) = @_;
  30     $self->{conn} = $val if $val;
  31     return $self->{conn};
  32 }
  33 sub throttle {
  34     my($self, $val) = @_;
  35     $self->{throttle} = $val if $val;
  36     return $self->{throttle};
  37 }
  38 sub respond {
  39     my($self, %other_args) = @_;
  40     if($self->throttle and not %other_args) {
  41         return unless (
  42             ($self->{args}->{progress} - $self->{last_respond_progress}) >= $self->throttle
  43         );
  44     }
  45     $self->conn->respond({ %{$self->{args}}, %other_args });
  46     $self->{last_respond_progress} = $self->{args}->{progress};
  47 }
  48 sub respond_complete {
  49     my($self, %other_args) = @_;
  50     $self->complete;
  51     $self->conn->respond_complete({ %{$self->{args}}, %other_args });
  52     return undef;
  53 }
  54 sub total {
  55     my($self, $val) = @_;
  56     $self->{args}->{total} = $val if defined $val;
  57     $self->{args}->{maximum} = $self->{args}->{total};
  58     return $self->{args}->{total};
  59 }
  60 sub purchase_order {
  61     my($self, $val) = @_;
  62     $self->{args}->{purchase_order} = $val if $val;
  63     return $self;
  64 }
  65 sub picklist {
  66     my($self, $val) = @_;
  67     $self->{args}->{picklist} = $val if $val;
  68     return $self;
  69 }
  70 sub add_lid {
  71     my $self = shift;
  72     $self->{args}->{lid} += 1;
  73     $self->{args}->{progress} += 1;
  74     return $self;
  75 }
  76 sub add_li {
  77     my $self = shift;
  78     $self->{args}->{li} += 1;
  79     $self->{args}->{progress} += 1;
  80     return $self;
  81 }
  82 sub add_copy {
  83     my $self = shift;
  84     $self->{args}->{copies} += 1;
  85     $self->{args}->{progress} += 1;
  86     return $self;
  87 }
  88 sub add_bib {
  89     my $self = shift;
  90     $self->{args}->{bibs} += 1;
  91     $self->{args}->{progress} += 1;
  92     return $self;
  93 }
  94 sub add_debit {
  95     my($self, $amount) = @_;
  96     $self->{args}->{debits_accrued} += $amount;
  97     $self->{args}->{progress} += 1;
  98     return $self;
  99 }
 100 sub editor {
 101     my($self, $editor) = @_;
 102     $self->{editor} = $editor if defined $editor;
 103     return $self->{editor};
 104 }
 105 sub complete {
 106     my $self = shift;
 107     $self->{args}->{complete} = 1;
 108     return $self;
 109 }
 110
 111 sub ingest_ses {
 112     my($self, $val) = @_;
 113     $self->{ingest_ses} = $val if $val;
 114     return $self->{ingest_ses};
 115 }
 116
 117 sub push_ingest_queue {
 118     my($self, $rec_id) = @_;
 119
 120     $self->ingest_ses(OpenSRF::AppSession->connect('open-ils.ingest'))
 121         unless $self->ingest_ses;
 122
 123     my $req = $self->ingest_ses->request('open-ils.ingest.full.biblio.record', $rec_id);
 124
 125     push(@{$self->{ingest_queue}}, $req);
 126 }
 127
 128 sub process_ingest_records {
 129     my $self = shift;
 130     return unless @{$self->{ingest_queue}};
 131
 132     for my $req (@{$self->{ingest_queue}}) {
 133
 134         try {
 135             $req->gather(1);
 136             $self->{args}->{indexed} += 1;
 137             $self->{args}->{progress} += 1;
 138         } otherwise {};
 139
 140         $self->respond;
 141     }
 142     $self->ingest_ses->disconnect;
 143 }
 144
 145
 146 sub cache {
 147     my($self, $org, $key, $val) = @_;
 148     $self->{cache}->{$org} = {} unless $self->{cache}->{org};
 149     $self->{cache}->{$org}->{$key} = $val if defined $val;
 150     return $self->{cache}->{$org}->{$key};
 151 }
 152
 153
 154 package OpenILS::Application::Acq::Order;
 155 use base qw/OpenILS::Application/;
 156 use strict; use warnings;
 157 # ----------------------------------------------------------------------------
 158 # Break up each component of the order process and pieces into managable
 159 # actions that can be shared across different workflows
 160 # ----------------------------------------------------------------------------
 161 use OpenILS::Event;
 162 use OpenSRF::Utils::Logger qw(:logger);
 163 use OpenSRF::Utils::JSON;
 164 use OpenILS::Utils::Fieldmapper;
 165 use OpenILS::Utils::CStoreEditor q/:funcs/;
 166 use OpenILS::Const qw/:const/;
 167 use OpenSRF::EX q/:try/;
 168 use OpenILS::Application::AppUtils;
 169 use OpenILS::Application::Cat::BibCommon;
 170 use OpenILS::Application::Cat::AssetCommon;
 171 use MARC::Record;
 172 use MARC::Batch;
 173 use MARC::File::XML;
 174 my $U = 'OpenILS::Application::AppUtils';
 175
 176
 177 # ----------------------------------------------------------------------------
 178 # Lineitem
 179 # ----------------------------------------------------------------------------
 180 sub create_lineitem {
 181     my($mgr, %args) = @_;
 182     my $li = Fieldmapper::acq::lineitem->new;
 183     $li->creator($mgr->editor->requestor->id);
 184     $li->selector($li->creator);
 185     $li->editor($li->creator);
 186     $li->create_time('now');
 187     $li->edit_time('now');
 188     $li->state('new');
 189     $li->$_($args{$_}) for keys %args;
 190     $li->clear_id;
 191     $mgr->add_li;
 192     return $mgr->editor->create_acq_lineitem($li);
 193 }
 194
 195 sub update_lineitem {
 196     my($mgr, $li) = @_;
 197     $li->edit_time('now');
 198     $li->editor($mgr->editor->requestor->id);
 199     $mgr->add_li;
 200     return $li if $mgr->editor->update_acq_lineitem($li);
 201     return undef;
 202 }
 203
 204 sub delete_lineitem {
 205     my($mgr, $li) = @_;
 206     $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
 207
 208     # delete the attached lineitem_details
 209     my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
 210     for my $lid_id (@$lid_ids) {
 211         return 0 unless delete_lineitem_detail($mgr, $lid_id);
 212     }
 213
 214     $mgr->add_li;
 215     return $mgr->editor->delete_acq_lineitem($li);
 216 }
 217
 218 # begins and commit transactions as it goes
 219 sub create_lineitem_list_assets {
 220     my($mgr, $li_ids) = @_;
 221     # create the bibs/volumes/copies and ingest the records
 222     for my $li_id (@$li_ids) {
 223         $mgr->editor->xact_begin;
 224         my $data = create_lineitem_assets($mgr, $li_id) or return undef;
 225         $mgr->editor->xact_commit;
 226         $mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib};
 227         $mgr->respond;
 228     }
 229     $mgr->process_ingest_records;
 230     return 1;
 231 }
 232
 233 # ----------------------------------------------------------------------------
 234 # if all of the lineitem details for this lineitem have
 235 # been received, mark the lineitem as received
 236 # returns 1 on non-received, li on received, 0 on error
 237 # ----------------------------------------------------------------------------
 238 sub check_lineitem_received {
 239     my($mgr, $li_id) = @_;
 240
 241     my $non_recv = $mgr->editor->search_acq_lineitem_detail(
 242         {recv_time => undef, lineitem => $li_id}, {idlist=>1});
 243
 244     return 1 if @$non_recv;
 245
 246     my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 247     $li->state('received');
 248     return update_lineitem($mgr, $li);
 249 }
 250
 251 sub receive_lineitem {
 252     my($mgr, $li_id, $skip_complete_check) = @_;
 253     my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
 254
 255     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 256         {lineitem => $li_id, recv_time => undef}, {idlist => 1});
 257
 258     for my $lid_id (@$lid_ids) {
 259        receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
 260     }
 261
 262     $mgr->add_li;
 263     $li->state('received');
 264     update_lineitem($mgr, $li) or return 0;
 265     return 1 if $skip_complete_check;
 266
 267     return check_purchase_order_received($mgr, $li->purchase_order);
 268 }
 269
 270 sub rollback_receive_lineitem {
 271     my($mgr, $li_id) = @_;
 272     my $li = $mgr->editor->retrieve_acq_lineitem($li_id) or return 0;
 273
 274     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 275         {lineitem => $li_id, recv_time => {'!=' => undef}}, {idlist => 1});
 276
 277     for my $lid_id (@$lid_ids) {
 278        rollback_receive_lineitem_detail($mgr, $lid_id, 1) or return 0;
 279     }
 280
 281     $mgr->add_li;
 282     $li->state('on-order');
 283     return update_lineitem($mgr, $li);
 284 }
 285
 286 # ----------------------------------------------------------------------------
 287 # Lineitem Detail
 288 # ----------------------------------------------------------------------------
 289 sub create_lineitem_detail {
 290     my($mgr, %args) = @_;
 291     my $lid = Fieldmapper::acq::lineitem_detail->new;
 292     $lid->$_($args{$_}) for keys %args;
 293     $lid->clear_id;
 294     $mgr->editor->create_acq_lineitem_detail($lid) or return 0;
 295     $mgr->add_lid;
 296
 297     # create some default values
 298     unless($lid->barcode) {
 299         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
 300         $lid->barcode($pfx.$lid->id);
 301     }
 302
 303     unless($lid->cn_label) {
 304         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
 305         $lid->cn_label($pfx.$lid->id);
 306     }
 307
 308     if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
 309         $lid->location($loc);
 310     }
 311
 312     if(!$lid->circ_modifier and my $mod = get_default_circ_modifier($mgr, $lid->owning_lib)) {
 313         $lid->circ_modifier($mod);
 314     }
 315
 316     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 317     return $lid;
 318 }
 319
 320 sub get_default_circ_modifier {
 321     my($mgr, $org) = @_;
 322     my $mod = $mgr->cache($org, 'def_circ_mod');
 323     return $mod if $mod;
 324     $mod = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier');
 325     return $mgr->cache($org, 'def_circ_mod', $mod) if $mod;
 326     return undef;
 327 }
 328
 329 sub delete_lineitem_detail {
 330     my($mgr, $lid) = @_;
 331     $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
 332     return $mgr->editor->delete_acq_lineitem_detail($lid);
 333 }
 334
 335
 336 sub receive_lineitem_detail {
 337     my($mgr, $lid_id, $skip_complete_check) = @_;
 338     my $e = $mgr->editor;
 339
 340     my $lid = $e->retrieve_acq_lineitem_detail([
 341         $lid_id,
 342         {   flesh => 1,
 343             flesh_fields => {
 344                 acqlid => ['fund_debit']
 345             }
 346         }
 347     ]) or return 0;
 348
 349     return 1 if $lid->recv_time;
 350
 351     $lid->recv_time('now');
 352     $e->update_acq_lineitem_detail($lid) or return 0;
 353
 354     my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
 355     $copy->status(OILS_COPY_STATUS_IN_PROCESS);
 356     $copy->edit_date('now');
 357     $copy->editor($e->requestor->id);
 358     $e->update_asset_copy($copy) or return 0;
 359
 360     if($lid->fund_debit) {
 361         $lid->fund_debit->encumbrance('f');
 362         $e->update_acq_fund_debit($lid->fund_debit) or return 0;
 363     }
 364
 365     $mgr->add_lid;
 366
 367     return 1 if $skip_complete_check;
 368
 369     my $li = check_lineitem_received($mgr, $lid->lineitem) or return 0;
 370     return 1 if $li == 1; # li not received
 371
 372     return check_purchase_order_received($mgr, $li->purchase_order);
 373 }
 374
 375
 376 sub rollback_receive_lineitem_detail {
 377     my($mgr, $lid_id) = @_;
 378     my $e = $mgr->editor;
 379
 380     my $lid = $e->retrieve_acq_lineitem_detail([
 381         $lid_id,
 382         {   flesh => 1,
 383             flesh_fields => {
 384                 acqlid => ['fund_debit']
 385             }
 386         }
 387     ]) or return 0;
 388
 389     return 1 unless $lid->recv_time;
 390
 391     $lid->clear_recv_time;
 392     $e->update_acq_lineitem_detail($lid) or return 0;
 393
 394     my $copy = $e->retrieve_asset_copy($lid->eg_copy_id) or return 0;
 395     $copy->status(OILS_COPY_STATUS_ON_ORDER);
 396     $copy->edit_date('now');
 397     $copy->editor($e->requestor->id);
 398     $e->update_asset_copy($copy) or return 0;
 399
 400     if($lid->fund_debit) {
 401         $lid->fund_debit->encumbrance('t');
 402         $e->update_acq_fund_debit($lid->fund_debit) or return 0;
 403     }
 404
 405     $mgr->add_lid;
 406     return $lid;
 407 }
 408
 409 # ----------------------------------------------------------------------------
 410 # Lineitem Attr
 411 # ----------------------------------------------------------------------------
 412 sub set_lineitem_attr {
 413     my($mgr, %args) = @_;
 414     my $attr_type = $args{attr_type};
 415
 416     # first, see if it's already set.  May just need to overwrite it
 417     my $attr = $mgr->editor->search_acq_lineitem_attr({
 418         lineitem => $args{lineitem},
 419         attr_type => $args{attr_type},
 420         attr_name => $args{attr_name}
 421     })->[0];
 422
 423     if($attr) {
 424         $attr->attr_value($args{attr_value});
 425         return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
 426         return undef;
 427
 428     } else {
 429
 430         $attr = Fieldmapper::acq::lineitem_attr->new;
 431         $attr->$_($args{$_}) for keys %args;
 432
 433         unless($attr->definition) {
 434             my $find = "search_acq_$attr_type";
 435             my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
 436             $attr->definition($attr_def_id);
 437         }
 438         return $mgr->editor->create_acq_lineitem_attr($attr);
 439     }
 440 }
 441
 442 sub get_li_price {
 443     my $li = shift;
 444     my $attrs = $li->attributes;
 445     my ($marc_estimated, $local_estimated, $local_actual, $prov_estimated, $prov_actual);
 446
 447     for my $attr (@$attrs) {
 448         if($attr->attr_name eq 'estimated_price') {
 449             $local_estimated = $attr->attr_value
 450                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 451             $prov_estimated = $attr->attr_value
 452                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 453             $marc_estimated = $attr->attr_value
 454                 if $attr->attr_type eq 'lineitem_marc_attr_definition';
 455
 456         } elsif($attr->attr_name eq 'actual_price') {
 457             $local_actual = $attr->attr_value
 458                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 459             $prov_actual = $attr->attr_value
 460                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 461         }
 462     }
 463
 464     return ($local_actual, 1) if $local_actual;
 465     return ($prov_actual, 2) if $prov_actual;
 466     return ($local_estimated, 1) if $local_estimated;
 467     return ($prov_estimated, 2) if $prov_estimated;
 468     return ($marc_estimated, 3);
 469 }
 470
 471
 472 # ----------------------------------------------------------------------------
 473 # Lineitem Debits
 474 # ----------------------------------------------------------------------------
 475 sub create_lineitem_debits {
 476     my($mgr, $li, $price, $ptype) = @_;
 477
 478     ($price, $ptype) = get_li_price($li) unless $price;
 479
 480     unless($price) {
 481         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
 482         $mgr->editor->rollback;
 483         return 0;
 484     }
 485
 486     unless($li->provider) {
 487         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
 488         $mgr->editor->rollback;
 489         return 0;
 490     }
 491
 492     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 493         {lineitem => $li->id},
 494         {idlist=>1}
 495     );
 496
 497     for my $lid_id (@$lid_ids) {
 498
 499         my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 500             $lid_id,
 501             {   flesh => 1,
 502                 flesh_fields => {acqlid => ['fund']}
 503             }
 504         ]);
 505
 506         create_lineitem_detail_debit($mgr, $li, $lid, $price, $ptype) or return 0;
 507     }
 508
 509     return 1;
 510 }
 511
 512
 513 # flesh li->provider
 514 # flesh lid->fund
 515 # ptype 1=local, 2=provider, 3=marc
 516 sub create_lineitem_detail_debit {
 517     my($mgr, $li, $lid, $price, $ptype) = @_;
 518
 519     unless(ref $li and ref $li->provider) {
 520        $li = $mgr->editor->retrieve_acq_lineitem([
 521             $li,
 522             {   flesh => 1,
 523                 flesh_fields => {jub => ['provider']},
 524             }
 525         ]);
 526     }
 527
 528     unless(ref $lid and ref $lid->fund) {
 529         $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 530             $lid,
 531             {   flesh => 1,
 532                 flesh_fields => {acqlid => ['fund']}
 533             }
 534         ]);
 535     }
 536
 537     my $ctype = $lid->fund->currency_type;
 538     my $amount = $price;
 539
 540     if($ptype == 2) { # price from vendor
 541         $ctype = $li->provider->currency_type;
 542         $amount = currency_conversion($mgr, $ctype, $lid->fund->currency_type, $price);
 543     }
 544
 545     my $debit = create_fund_debit(
 546         $mgr,
 547         fund => $lid->fund->id,
 548         origin_amount => $price,
 549         origin_currency_type => $ctype,
 550         amount => $amount
 551     ) or return 0;
 552
 553     $lid->fund_debit($debit->id);
 554     $lid->fund($lid->fund->id);
 555     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 556     return $debit;
 557 }
 558
 559
 560 # ----------------------------------------------------------------------------
 561 # Fund Debit
 562 # ----------------------------------------------------------------------------
 563 sub create_fund_debit {
 564     my($mgr, %args) = @_;
 565     my $debit = Fieldmapper::acq::fund_debit->new;
 566     $debit->debit_type('purchase');
 567     $debit->encumbrance('t');
 568     $debit->$_($args{$_}) for keys %args;
 569     $debit->clear_id;
 570     $mgr->add_debit($debit->amount);
 571     return $mgr->editor->create_acq_fund_debit($debit);
 572 }
 573
 574 sub currency_conversion {
 575     my($mgr, $src_currency, $dest_currency, $amount) = @_;
 576     my $result = $mgr->editor->json_query(
 577         {from => ['acq.exchange_ratio', $src_currency, $dest_currency, $amount]});
 578     return $result->[0]->{'acq.exchange_ratio'};
 579 }
 580
 581
 582 # ----------------------------------------------------------------------------
 583 # Picklist
 584 # ----------------------------------------------------------------------------
 585 sub create_picklist {
 586     my($mgr, %args) = @_;
 587     my $picklist = Fieldmapper::acq::picklist->new;
 588     $picklist->creator($mgr->editor->requestor->id);
 589     $picklist->owner($picklist->creator);
 590     $picklist->editor($picklist->creator);
 591     $picklist->create_time('now');
 592     $picklist->edit_time('now');
 593     $picklist->org_unit($mgr->editor->requestor->ws_ou);
 594     $picklist->owner($mgr->editor->requestor->id);
 595     $picklist->$_($args{$_}) for keys %args;
 596     $picklist->clear_id;
 597     $mgr->picklist($picklist);
 598     return $mgr->editor->create_acq_picklist($picklist);
 599 }
 600
 601 sub update_picklist {
 602     my($mgr, $picklist) = @_;
 603     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 604     $picklist->edit_time('now');
 605     $picklist->editor($mgr->editor->requestor->id);
 606     $mgr->picklist($picklist);
 607     return $picklist if $mgr->editor->update_acq_picklist($picklist);
 608     return undef;
 609 }
 610
 611 sub delete_picklist {
 612     my($mgr, $picklist) = @_;
 613     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 614
 615     # delete all 'new' lineitems
 616     my $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'}, {idlist => 1});
 617     for my $li_id (@$li_ids) {
 618         my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 619         return 0 unless delete_lineitem($mgr, $li);
 620         $mgr->respond;
 621     }
 622
 623     # detach all non-'new' lineitems
 624     $li_ids = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}}, {idlist => 1});
 625     for my $li_id (@$li_ids) {
 626         my $li = $mgr->editor->retrieve_acq_lineitem($li_id);
 627         $li->clear_picklist;
 628         return 0 unless update_lineitem($mgr, $li);
 629         $mgr->respond;
 630     }
 631
 632     # remove any picklist-specific object perms
 633     my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
 634     for my $op (@$ops) {
 635         return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
 636     }
 637
 638     return $mgr->editor->delete_acq_picklist($picklist);
 639 }
 640
 641 # ----------------------------------------------------------------------------
 642 # Purchase Order
 643 # ----------------------------------------------------------------------------
 644 sub update_purchase_order {
 645     my($mgr, $po) = @_;
 646     $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
 647     $po->editor($mgr->editor->requestor->id);
 648     $po->edit_time('now');
 649     $mgr->purchase_order($po);
 650     return $po if $mgr->editor->update_acq_purchase_order($po);
 651     return undef;
 652 }
 653
 654 sub create_purchase_order {
 655     my($mgr, %args) = @_;
 656     my $po = Fieldmapper::acq::purchase_order->new;
 657     $po->creator($mgr->editor->requestor->id);
 658     $po->editor($mgr->editor->requestor->id);
 659     $po->owner($mgr->editor->requestor->id);
 660     $po->edit_time('now');
 661     $po->create_time('now');
 662     $po->ordering_agency($mgr->editor->requestor->ws_ou);
 663     $po->$_($args{$_}) for keys %args;
 664     $po->clear_id;
 665     $mgr->purchase_order($po);
 666     return $mgr->editor->create_acq_purchase_order($po);
 667 }
 668
 669 # ----------------------------------------------------------------------------
 670 # if all of the lineitems for this PO are received,
 671 # mark the PO as received
 672 # ----------------------------------------------------------------------------
 673 sub check_purchase_order_received {
 674     my($mgr, $po_id) = @_;
 675
 676     my $non_recv_li = $mgr->editor->search_acq_lineitem(
 677         {   purchase_order => $po_id,
 678             state => {'!=' => 'received'}
 679         }, {idlist=>1});
 680
 681     return 1 if @$non_recv_li;
 682
 683     my $po = $mgr->editor->retrieve_acq_purchase_order($po_id);
 684     $po->state('received');
 685     return update_purchase_order($mgr, $po);
 686 }
 687
 688
 689 # ----------------------------------------------------------------------------
 690 # Bib, Callnumber, and Copy data
 691 # ----------------------------------------------------------------------------
 692
 693 sub create_lineitem_assets {
 694     my($mgr, $li_id) = @_;
 695     my $evt;
 696
 697     my $li = $mgr->editor->retrieve_acq_lineitem([
 698         $li_id,
 699         {   flesh => 1,
 700             flesh_fields => {jub => ['purchase_order', 'attributes']}
 701         }
 702     ]) or return 0;
 703
 704     # -----------------------------------------------------------------
 705     # first, create the bib record if necessary
 706     # -----------------------------------------------------------------
 707     my $new_bib = 0;
 708     unless($li->eg_bib_id) {
 709         create_bib($mgr, $li) or return 0;
 710         $new_bib = 1;
 711     }
 712
 713     my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
 714
 715     # -----------------------------------------------------------------
 716     # for each lineitem_detail, create the volume if necessary, create
 717     # a copy, and link them all together.
 718     # -----------------------------------------------------------------
 719     for my $lid_id (@{$li_details}) {
 720
 721         my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
 722         next if $lid->eg_copy_id;
 723
 724         my $org = $lid->owning_lib;
 725         my $label = $lid->cn_label;
 726         my $bibid = $li->eg_bib_id;
 727
 728         my $volume = $mgr->cache($org, "cn.$bibid.$label");
 729         unless($volume) {
 730             $volume = create_volume($mgr, $li, $lid) or return 0;
 731             $mgr->cache($org, "cn.$bibid.$label", $volume);
 732         }
 733         create_copy($mgr, $volume, $lid) or return 0;
 734     }
 735
 736     return { li => $li, new_bib => $new_bib };
 737 }
 738
 739 sub create_bib {
 740     my($mgr, $li) = @_;
 741
 742     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 743         $mgr->editor,
 744         $li->marc,
 745         undef,
 746         undef,
 747         1, # override tcn collisions
 748         1, # no-ingest
 749         undef # $rec->bib_source
 750     );
 751
 752     if($U->event_code($record)) {
 753         $mgr->editor->event($record);
 754         $mgr->editor->rollback;
 755         return 0;
 756     }
 757
 758     $li->eg_bib_id($record->id);
 759     $mgr->add_bib;
 760     return update_lineitem($mgr, $li);
 761 }
 762
 763 sub create_volume {
 764     my($mgr, $li, $lid) = @_;
 765
 766     my ($volume, $evt) =
 767         OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
 768             $mgr->editor,
 769             $lid->cn_label,
 770             $li->eg_bib_id,
 771             $lid->owning_lib
 772         );
 773
 774     if($evt) {
 775         $mgr->editor->event($evt);
 776         return 0;
 777     }
 778
 779     return $volume;
 780 }
 781
 782 sub create_copy {
 783     my($mgr, $volume, $lid) = @_;
 784     my $copy = Fieldmapper::asset::copy->new;
 785     $copy->isnew(1);
 786     $copy->loan_duration(2);
 787     $copy->fine_level(2);
 788     $copy->status(OILS_COPY_STATUS_ON_ORDER);
 789     $copy->barcode($lid->barcode);
 790     $copy->location($lid->location);
 791     $copy->call_number($volume->id);
 792     $copy->circ_lib($volume->owning_lib);
 793     $copy->circ_modifier($lid->circ_modifier);
 794
 795     my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
 796     if($evt) {
 797         $mgr->editor->event($evt);
 798         return 0;
 799     }
 800
 801     $mgr->add_copy;
 802     $lid->eg_copy_id($copy->id);
 803     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 804 }
 805
 806
 807
 808
 809
 810
 811 # ----------------------------------------------------------------------------
 812 # Workflow: Build a selection list from a Z39.50 search
 813 # ----------------------------------------------------------------------------
 814
 815 __PACKAGE__->register_method(
 816         method => 'zsearch',
 817         api_name => 'open-ils.acq.picklist.search.z3950',
 818     stream => 1,
 819         signature => {
 820         desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
 821         params => [
 822             {desc => 'Authentication token', type => 'string'},
 823             {desc => 'Search definition', type => 'object'},
 824             {desc => 'Picklist name, optional', type => 'string'},
 825         ]
 826     }
 827 );
 828
 829 sub zsearch {
 830     my($self, $conn, $auth, $search, $name, $options) = @_;
 831     my $e = new_editor(authtoken=>$auth);
 832     return $e->event unless $e->checkauth;
 833     return $e->event unless $e->allowed('CREATE_PICKLIST');
 834
 835     $search->{limit} ||= 10;
 836     $options ||= {};
 837
 838     my $ses = OpenSRF::AppSession->create('open-ils.search');
 839     my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
 840
 841     my $first = 1;
 842     my $picklist;
 843     my $mgr;
 844     while(my $resp = $req->recv(timeout=>60)) {
 845
 846         if($first) {
 847             my $e = new_editor(requestor=>$e->requestor, xact=>1);
 848             $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
 849             $picklist = zsearch_build_pl($mgr, $name);
 850             $first = 0;
 851         }
 852
 853         my $result = $resp->content;
 854         my $count = $result->{count};
 855         $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
 856
 857         for my $rec (@{$result->{records}}) {
 858
 859             my $li = create_lineitem($mgr,
 860                 picklist => $picklist->id,
 861                 source_label => $result->{service},
 862                 marc => $rec->{marcxml},
 863                 eg_bib_id => $rec->{bibid}
 864             );
 865
 866             if($$options{respond_li}) {
 867                 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
 868                     if $$options{flesh_attrs};
 869                 $li->clear_marc if $$options{clear_marc};
 870                 $mgr->respond(lineitem => $li);
 871             } else {
 872                 $mgr->respond;
 873             }
 874         }
 875     }
 876
 877     $mgr->editor->commit;
 878     return $mgr->respond_complete;
 879 }
 880
 881 sub zsearch_build_pl {
 882     my($mgr, $name) = @_;
 883     $name ||= '';
 884
 885     my $picklist = $mgr->editor->search_acq_picklist({
 886         owner => $mgr->editor->requestor->id,
 887         name => $name
 888     })->[0];
 889
 890     if($name eq '' and $picklist) {
 891         return 0 unless delete_picklist($mgr, $picklist);
 892         $picklist = undef;
 893     }
 894
 895     return update_picklist($mgr, $picklist) if $picklist;
 896     return create_picklist($mgr, name => $name);
 897 }
 898
 899
 900 # ----------------------------------------------------------------------------
 901 # Workflow: Build a selection list / PO by importing a batch of MARC records
 902 # ----------------------------------------------------------------------------
 903
 904 __PACKAGE__->register_method(
 905     method => 'upload_records',
 906     api_name => 'open-ils.acq.process_upload_records',
 907     stream => 1,
 908 );
 909
 910 sub upload_records {
 911     my($self, $conn, $auth, $key) = @_;
 912
 913         my $e = new_editor(authtoken => $auth, xact => 1);
 914     return $e->die_event unless $e->checkauth;
 915     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
 916
 917     my $cache = OpenSRF::Utils::Cache->new;
 918
 919     my $data = $cache->get_cache("vandelay_import_spool_$key");
 920         my $purpose = $data->{purpose};
 921     my $filename = $data->{path};
 922     my $provider = $data->{provider};
 923     my $picklist = $data->{picklist};
 924     my $create_po = $data->{create_po};
 925     my $ordering_agency = $data->{ordering_agency};
 926     my $create_assets = $data->{create_assets};
 927     my $po;
 928     my $evt;
 929
 930     unless(-r $filename) {
 931         $logger->error("unable to read MARC file $filename");
 932         $e->rollback;
 933         return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
 934     }
 935
 936     $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
 937
 938     if($picklist) {
 939         $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
 940         if($picklist->owner != $e->requestor->id) {
 941             return $e->die_event unless
 942                 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
 943         }
 944     }
 945
 946     if($create_po) {
 947         $po = create_purchase_order($mgr,
 948             ordering_agency => $ordering_agency,
 949             provider => $provider->id
 950         ) or return $mgr->editor->die_event;
 951     }
 952
 953     $logger->info("acq processing MARC file=$filename");
 954
 955     my $marctype = 'USMARC'; # ?
 956         my $batch = new MARC::Batch ($marctype, $filename);
 957         $batch->strict_off;
 958
 959         my $count = 0;
 960     my @li_list;
 961
 962         while(1) {
 963
 964             my $err;
 965         my $xml;
 966                 $count++;
 967         my $r;
 968
 969                 try {
 970             $r = $batch->next;
 971         } catch Error with {
 972             $err = shift;
 973                         $logger->warn("Proccessing of record $count in set $key failed with error $err.  Skipping this record");
 974         };
 975
 976         next if $err;
 977         last unless $r;
 978
 979                 try {
 980             ($xml = $r->as_xml_record()) =~ s/\n//sog;
 981             $xml =~ s/^<\?xml.+\?\s*>//go;
 982             $xml =~ s/>\s+</></go;
 983             $xml =~ s/\p{Cc}//go;
 984             $xml = $U->entityize($xml);
 985             $xml =~ s/[\x00-\x1f]//go;
 986
 987                 } catch Error with {
 988                         $err = shift;
 989                         $logger->warn("Proccessing XML of record $count in set $key failed with error $err.  Skipping this record");
 990                 };
 991
 992         next if $err or not $xml;
 993
 994         my %args = (
 995             source_label => $provider->code,
 996             provider => $provider->id,
 997             marc => $xml,
 998         );
 999
1000         $args{picklist} = $picklist->id if $picklist;
1001         if($po) {
1002             $args{purchase_order} = $po->id;
1003             $args{state} = 'on-order';
1004         }
1005
1006         my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
1007         $mgr->respond;
1008         $li->provider($provider); # flesh it, we'll need it later
1009
1010         import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
1011         $mgr->respond;
1012
1013         push(@li_list, $li->id);
1014         $mgr->respond;
1015         }
1016
1017         $e->commit;
1018     unlink($filename);
1019     $cache->delete_cache('vandelay_import_spool_' . $key);
1020
1021     if($create_assets) {
1022         create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event;
1023     }
1024
1025     return $mgr->respond_complete;
1026 }
1027
1028 sub import_lineitem_details {
1029     my($mgr, $ordering_agency, $li) = @_;
1030
1031     my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
1032     return 1 unless @$holdings;
1033     my $org_path = $U->get_org_ancestors($ordering_agency);
1034     $org_path = [ reverse (@$org_path) ];
1035     my $price;
1036
1037     my $idx = 1;
1038     while(1) {
1039         # create a lineitem detail for each copy in the data
1040
1041         my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
1042         last unless defined $compiled;
1043         return 0 unless $compiled;
1044
1045         # this takes the price of the last copy and uses it as the lineitem price
1046         # need to determine if a given record would include different prices for the same item
1047         $price = $$compiled{price};
1048
1049         for(1..$$compiled{quantity}) {
1050             my $lid = create_lineitem_detail($mgr,
1051                 lineitem => $li->id,
1052                 owning_lib => $$compiled{owning_lib},
1053                 cn_label => $$compiled{call_number},
1054                 fund => $$compiled{fund},
1055                 circ_modifier => $$compiled{circ_modifier},
1056                 note => $$compiled{note},
1057                 location => $$compiled{copy_location}
1058             ) or return 0;
1059         }
1060
1061         $mgr->respond;
1062         $idx++;
1063     }
1064
1065     # set the price attr so we'll know the source of the price
1066     set_lineitem_attr(
1067         $mgr,
1068         attr_name => 'estimated_price',
1069         attr_type => 'lineitem_local_attr_definition',
1070         attr_value => $price,
1071         lineitem => $li->id
1072     ) or return 0;
1073
1074     # if we're creating a purchase order, create the debits
1075     if($li->purchase_order) {
1076         create_lineitem_debits($mgr, $li, $price, 2) or return 0;
1077         $mgr->respond;
1078     }
1079
1080     return 1;
1081 }
1082
1083 # return hash on success, 0 on error, undef on no more holdings
1084 sub extract_lineitem_detail_data {
1085     my($mgr, $org_path, $holdings, $index) = @_;
1086
1087     my @data_list = grep { $_->{holding} eq $index } @$holdings;
1088     return undef unless @data_list;
1089
1090     my %compiled = map { $_->{attr} => $_->{data} } @data_list;
1091     my $base_org = $$org_path[0];
1092
1093     my $killme = sub {
1094         my $msg = shift;
1095         $logger->error("Item import extraction error: $msg");
1096         $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
1097         $mgr->editor->rollback;
1098         $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
1099         return 0;
1100     };
1101
1102     $compiled{quantity} ||= 1;
1103
1104     # ---------------------------------------------------------------------
1105     # Fund
1106     my $code = $compiled{fund_code};
1107     return $killme->('no fund code provided') unless $code;
1108
1109     my $fund = $mgr->cache($base_org, "fund.$code");
1110     unless($fund) {
1111         # search up the org tree for the most appropriate fund
1112         for my $org (@$org_path) {
1113             $fund = $mgr->editor->search_acq_fund(
1114                 {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
1115             last if $fund;
1116         }
1117     }
1118     return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
1119     $compiled{fund} = $fund;
1120     $mgr->cache($base_org, "fund.$code", $fund);
1121
1122
1123     # ---------------------------------------------------------------------
1124     # Owning lib
1125     my $sn = $compiled{owning_lib};
1126     return $killme->('no owning_lib defined') unless $sn;
1127     my $org_id =
1128         $mgr->cache($base_org, "orgsn.$sn") ||
1129             $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
1130     return $killme->("invalid owning_lib defined: $sn") unless $org_id;
1131     $compiled{owning_lib} = $org_id;
1132     $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
1133
1134
1135     # ---------------------------------------------------------------------
1136     # Circ Modifier
1137     my $mod;
1138     $code = $compiled{circ_modifier};
1139
1140     if($code) {
1141
1142         $mod = $mgr->cache($base_org, "mod.$code") ||
1143             $mgr->editor->retrieve_config_circ_modifier($code);
1144         return $killme->("invlalid circ_modifier $code") unless $mod;
1145         $mgr->cache($base_org, "mod.$code", $mod);
1146
1147     } else {
1148         # try the default
1149         $mod = get_default_circ_modifier($mgr, $base_org)
1150             or return $killme->('no circ_modifier defined');
1151     }
1152
1153     $compiled{circ_modifier} = $mod;
1154
1155
1156     # ---------------------------------------------------------------------
1157     # Shelving Location
1158     my $name = $compiled{copy_location};
1159     return $killme->('no copy_location defined') unless $name;
1160     my $loc = $mgr->cache($base_org, "copy_loc.$name");
1161     unless($loc) {
1162         for my $org (@$org_path) {
1163             $loc = $mgr->editor->search_asset_copy_location(
1164                 {owning_lib => $org, name => $name}, {idlist => 1})->[0];
1165             last if $loc;
1166         }
1167     }
1168     return $killme->("Invalid copy location $name") unless $loc;
1169     $compiled{copy_location} = $loc;
1170     $mgr->cache($base_org, "copy_loc.$name", $loc);
1171
1172     return \%compiled;
1173 }
1174
1175
1176
1177 # ----------------------------------------------------------------------------
1178 # Workflow: Given an existing purchase order, import/create the bibs,
1179 # callnumber and copy objects
1180 # ----------------------------------------------------------------------------
1181
1182 __PACKAGE__->register_method(
1183         method => 'create_po_assets',
1184         api_name        => 'open-ils.acq.purchase_order.assets.create',
1185         signature => {
1186         desc => q/Creates assets for each lineitem in the purchase order/,
1187         params => [
1188             {desc => 'Authentication token', type => 'string'},
1189             {desc => 'The purchase order id', type => 'number'},
1190         ],
1191         return => {desc => 'Streams a total versus completed counts object, event on error'}
1192     }
1193 );
1194
1195 sub create_po_assets {
1196     my($self, $conn, $auth, $po_id) = @_;
1197
1198     my $e = new_editor(authtoken=>$auth, xact=>1);
1199     return $e->die_event unless $e->checkauth;
1200     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1201
1202     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1203     return $e->die_event unless $e->allowed('IMPORT_PURCHASE_ORDER_ASSETS', $po->ordering_agency);
1204
1205     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1206
1207     # it's ugly, but it's fast.  Get the total count of lineitem detail objects to process
1208     my $lid_total = $e->json_query({
1209         select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1210         from => {
1211             acqlid => {
1212                 jub => {
1213                     fkey => 'lineitem',
1214                     field => 'id',
1215                     join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1216                 }
1217             }
1218         },
1219         where => {'+acqpo' => {id => $po_id}}
1220     })->[0]->{id};
1221
1222     $mgr->total(scalar(@$li_ids) + $lid_total);
1223
1224     create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1225
1226     $e->xact_begin;
1227     update_purchase_order($mgr, $po) or return $e->die_event;
1228     $e->commit;
1229
1230     return $mgr->respond_complete;
1231 }
1232
1233
1234
1235 __PACKAGE__->register_method(
1236         method => 'create_purchase_order_api',
1237         api_name        => 'open-ils.acq.purchase_order.create',
1238         signature => {
1239         desc => 'Creates a new purchase order',
1240         params => [
1241             {desc => 'Authentication token', type => 'string'},
1242             {desc => 'purchase_order to create', type => 'object'}
1243         ],
1244         return => {desc => 'The purchase order id, Event on failure'}
1245     }
1246 );
1247
1248 sub create_purchase_order_api {
1249     my($self, $conn, $auth, $po, $args) = @_;
1250     $args ||= {};
1251
1252     my $e = new_editor(xact=>1, authtoken=>$auth);
1253     return $e->die_event unless $e->checkauth;
1254     return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1255     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1256
1257     # create the PO
1258     my %pargs = (ordering_agency => $e->requestor->ws_ou);
1259     $pargs{provider} = $po->provider if $po->provider;
1260     $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1261
1262     my $li_ids = $$args{lineitems};
1263
1264     if($li_ids) {
1265
1266         for my $li_id (@$li_ids) {
1267
1268             my $li = $e->retrieve_acq_lineitem([
1269                 $li_id,
1270                 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1271             ]) or return $e->die_event;
1272
1273             $li->provider($po->provider);
1274             $li->purchase_order($po->id);
1275             update_lineitem($mgr, $li) or return $e->die_event;
1276             $mgr->respond;
1277
1278             create_lineitem_debits($mgr, $li) or return $e->die_event;
1279         }
1280     }
1281
1282     # commit before starting the asset creation
1283     $e->xact_commit;
1284
1285     if($li_ids and $$args{create_assets}) {
1286         create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1287     }
1288
1289     return $mgr->respond_complete;
1290 }
1291
1292
1293 __PACKAGE__->register_method(
1294         method => 'lineitem_detail_CUD_batch',
1295         api_name => 'open-ils.acq.lineitem_detail.cud.batch',
1296     stream => 1,
1297         signature => {
1298         desc => q/Creates a new purchase order line item detail.
1299             Additionally creates the associated fund_debit/,
1300         params => [
1301             {desc => 'Authentication token', type => 'string'},
1302             {desc => 'List of lineitem_details to create', type => 'array'},
1303         ],
1304         return => {desc => 'Streaming response of current position in the array'}
1305     }
1306 );
1307
1308 sub lineitem_detail_CUD_batch {
1309     my($self, $conn, $auth, $li_details) = @_;
1310
1311     my $e = new_editor(xact=>1, authtoken=>$auth);
1312     return $e->die_event unless $e->checkauth;
1313     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1314
1315     # XXX perms
1316
1317     $mgr->total(scalar(@$li_details));
1318
1319     my %li_cache;
1320
1321     for my $lid (@$li_details) {
1322
1323         my $li = $li_cache{$lid->lineitem} || $e->retrieve_acq_lineitem($lid->lineitem);
1324
1325         if($lid->isnew) {
1326             create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
1327
1328         } elsif($lid->ischanged) {
1329             $e->update_acq_lineitem_detail($lid) or return $e->die_event;
1330
1331         } elsif($lid->isdeleted) {
1332             delete_lineitem_detail($mgr, $lid) or return $e->die_event;
1333         }
1334
1335         $mgr->respond(li => $li);
1336         $li_cache{$lid->lineitem} = $li;
1337     }
1338
1339     $e->commit;
1340     return $mgr->respond_complete;
1341 }
1342
1343
1344 __PACKAGE__->register_method(
1345         method => 'receive_po_api',
1346         api_name        => 'open-ils.acq.purchase_order.receive'
1347 );
1348
1349 sub receive_po_api {
1350     my($self, $conn, $auth, $po_id) = @_;
1351     my $e = new_editor(xact => 1, authtoken => $auth);
1352     return $e->die_event unless $e->checkauth;
1353     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1354
1355     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1356     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1357
1358     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1359
1360     for my $li_id (@$li_ids) {
1361         receive_lineitem($mgr, $li_id) or return $e->die_event;
1362         $mgr->respond;
1363     }
1364
1365     $po->state('received');
1366     update_purchase_order($mgr, $po) or return $e->die_event;
1367
1368     $e->commit;
1369     return $mgr->respond_complete;
1370 }
1371
1372
1373 __PACKAGE__->register_method(
1374         method => 'receive_lineitem_detail_api',
1375         api_name        => 'open-ils.acq.lineitem_detail.receive',
1376         signature => {
1377         desc => 'Mark a lineitem_detail as received',
1378         params => [
1379             {desc => 'Authentication token', type => 'string'},
1380             {desc => 'lineitem detail ID', type => 'number'}
1381         ],
1382         return => {desc => '1 on success, Event on error'}
1383     }
1384 );
1385
1386 sub receive_lineitem_detail_api {
1387     my($self, $conn, $auth, $lid_id) = @_;
1388
1389     my $e = new_editor(xact=>1, authtoken=>$auth);
1390     return $e->die_event unless $e->checkauth;
1391     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1392
1393     my $lid = $e->retrieve_acq_lineitem_detail([
1394         $lid_id, {
1395             flesh => 2,
1396             flesh_fields => {
1397                 acqlid => ['lineitem'],
1398                 jub => ['purchase_order']
1399             }
1400         }
1401     ]);
1402
1403     return $e->die_event unless $e->allowed(
1404         'RECEIVE_PURCHASE_ORDER', $lid->lineitem->purchase_order->ordering_agency);
1405
1406     receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1407     $e->commit;
1408     return 1;
1409 }
1410
1411 __PACKAGE__->register_method(
1412         method => 'receive_lineitem_api',
1413         api_name        => 'open-ils.acq.lineitem.receive',
1414         signature => {
1415         desc => 'Mark a lineitem as received',
1416         params => [
1417             {desc => 'Authentication token', type => 'string'},
1418             {desc => 'lineitem detail ID', type => 'number'}
1419         ],
1420         return => {desc => '1 on success, Event on error'}
1421     }
1422 );
1423
1424 sub receive_lineitem_api {
1425     my($self, $conn, $auth, $li_id) = @_;
1426
1427     my $e = new_editor(xact=>1, authtoken=>$auth);
1428     return $e->die_event unless $e->checkauth;
1429     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1430
1431     my $li = $e->retrieve_acq_lineitem([
1432         $li_id, {
1433             flesh => 1,
1434             flesh_fields => {
1435                 jub => ['purchase_order']
1436             }
1437         }
1438     ]) or return $e->die_event;
1439
1440     return $e->die_event unless $e->allowed(
1441         'RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency);
1442
1443     receive_lineitem($mgr, $li_id) or return $e->die_event;
1444     $e->commit;
1445     return 1;
1446 }
1447
1448
1449 __PACKAGE__->register_method(
1450         method => 'rollback_receive_po_api',
1451         api_name        => 'open-ils.acq.purchase_order.receive.rollback'
1452 );
1453
1454 sub rollback_receive_po_api {
1455     my($self, $conn, $auth, $po_id) = @_;
1456     my $e = new_editor(xact => 1, authtoken => $auth);
1457     return $e->die_event unless $e->checkauth;
1458     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1459
1460     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1461     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1462
1463     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1464
1465     for my $li_id (@$li_ids) {
1466         rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1467         $mgr->respond;
1468     }
1469
1470     $po->state('on-order');
1471     update_purchase_order($mgr, $po) or return $e->die_event;
1472
1473     $e->commit;
1474     return $mgr->respond_complete;
1475 }
1476
1477
1478 __PACKAGE__->register_method(
1479         method => 'rollback_receive_lineitem_detail_api',
1480         api_name        => 'open-ils.acq.lineitem_detail.receive.rollback',
1481         signature => {
1482         desc => 'Mark a lineitem_detail as received',
1483         params => [
1484             {desc => 'Authentication token', type => 'string'},
1485             {desc => 'lineitem detail ID', type => 'number'}
1486         ],
1487         return => {desc => '1 on success, Event on error'}
1488     }
1489 );
1490
1491 sub rollback_receive_lineitem_detail_api {
1492     my($self, $conn, $auth, $lid_id) = @_;
1493
1494     my $e = new_editor(xact=>1, authtoken=>$auth);
1495     return $e->die_event unless $e->checkauth;
1496     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1497
1498     my $lid = $e->retrieve_acq_lineitem_detail([
1499         $lid_id, {
1500             flesh => 2,
1501             flesh_fields => {
1502                 acqlid => ['lineitem'],
1503                 jub => ['purchase_order']
1504             }
1505         }
1506     ]);
1507     my $li = $lid->lineitem;
1508     my $po = $li->purchase_order;
1509
1510     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1511     rollback_receive_lineitem_detail($mgr, $lid_id) or return $e->die_event;
1512
1513     $li->state('on-order');
1514     $po->state('on-order');
1515     udpate_lineitem($mgr, $li) or return $e->die_event;
1516     udpate_purchase_order($mgr, $po) or return $e->die_event;
1517
1518     $e->commit;
1519     return 1;
1520 }
1521
1522 __PACKAGE__->register_method(
1523         method => 'rollback_receive_lineitem_api',
1524         api_name        => 'open-ils.acq.lineitem.receive.rollback',
1525         signature => {
1526         desc => 'Mark a lineitem as received',
1527         params => [
1528             {desc => 'Authentication token', type => 'string'},
1529             {desc => 'lineitem detail ID', type => 'number'}
1530         ],
1531         return => {desc => '1 on success, Event on error'}
1532     }
1533 );
1534
1535 sub rollback_receive_lineitem_api {
1536     my($self, $conn, $auth, $li_id) = @_;
1537
1538     my $e = new_editor(xact=>1, authtoken=>$auth);
1539     return $e->die_event unless $e->checkauth;
1540     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1541
1542     my $li = $e->retrieve_acq_lineitem_detail([
1543         $li_id, {
1544             flesh => 1,
1545             flesh_fields => {
1546                 jub => ['purchase_order']
1547             }
1548         }
1549     ]);
1550     my $po = $li->purchase_order;
1551
1552     return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $po->ordering_agency);
1553
1554     rollback_receive_lineitem($mgr, $li_id) or return $e->die_event;
1555
1556     $po->state('on-order');
1557     update_purchase_order($mgr, $po) or return $e->die_event;
1558
1559     $e->commit;
1560     return 1;
1561 }
1562
1563
1564 __PACKAGE__->register_method(
1565         method => 'set_lineitem_price_api',
1566         api_name        => 'open-ils.acq.lineitem.price.set',
1567         signature => {
1568         desc => 'Set lineitem price.  If debits already exist, update them as well',
1569         params => [
1570             {desc => 'Authentication token', type => 'string'},
1571             {desc => 'lineitem ID', type => 'number'}
1572         ],
1573         return => {desc => 'status blob, Event on error'}
1574     }
1575 );
1576
1577 sub set_lineitem_price_api {
1578     my($self, $conn, $auth, $li_id, $price, $currency) = @_;
1579
1580     my $e = new_editor(xact=>1, authtoken=>$auth);
1581     return $e->die_event unless $e->checkauth;
1582     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1583
1584     # XXX perms
1585
1586     my $li = $e->retrieve_acq_lineitem($li_id) or return $e->die_event;
1587
1588     # update the local attr for estimated price
1589     set_lineitem_attr(
1590         $mgr,
1591         attr_name => 'estimated_price',
1592         attr_type => 'lineitem_local_attr_definition',
1593         attr_value => $price,
1594         lineitem => $li_id
1595     ) or return $e->die_event;
1596
1597     my $lid_ids = $e->search_acq_lineitem_detail(
1598         {lineitem => $li_id, fund_debit => {'!=' => undef}},
1599         {idlist => 1}
1600     );
1601
1602     for my $lid_id (@$lid_ids) {
1603
1604         my $lid = $e->retrieve_acq_lineitem_detail([
1605             $lid_id, {
1606             flesh => 1, flesh_fields => {acqlid => ['fund', 'fund_debit']}}
1607         ]);
1608
1609         # onless otherwise specified, assume currency of new price is same as currency type of the fund
1610         $currency ||= $lid->fund->currency_type;
1611         my $amount = $price;
1612
1613         if($lid->fund->currency_type ne $currency) {
1614             $amount = currency_conversion($mgr, $currency, $lid->fund->currency_type, $price);
1615         }
1616
1617         $lid->fund_debit->origin_currency_type($currency);
1618         $lid->fund_debit->origin_amount($price);
1619         $lid->fund_debit->amount($amount);
1620
1621         $e->update_acq_fund_debit($lid->fund_debit) or return $e->die_event;
1622         $mgr->add_lid;
1623         $mgr->respond;
1624     }
1625
1626     $e->commit;
1627     return $mgr->respond_complete;
1628 }
1629
1630
1631 __PACKAGE__->register_method(
1632         method => 'clone_picklist_api',
1633         api_name        => 'open-ils.acq.picklist.clone',
1634         signature => {
1635         desc => 'Clones a picklist, including lineitem and lineitem details',
1636         params => [
1637             {desc => 'Authentication token', type => 'string'},
1638             {desc => 'Picklist ID', type => 'number'},
1639             {desc => 'New Picklist Name', type => 'string'}
1640         ],
1641         return => {desc => 'status blob, Event on error'}
1642     }
1643 );
1644
1645 sub clone_picklist_api {
1646     my($self, $conn, $auth, $pl_id, $name) = @_;
1647
1648     my $e = new_editor(xact=>1, authtoken=>$auth);
1649     return $e->die_event unless $e->checkauth;
1650     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1651
1652     my $old_pl = $e->retrieve_acq_picklist($pl_id);
1653     my $new_pl = create_picklist($mgr, %{$old_pl->to_bare_hash}, name => $name) or return $e->die_event;
1654
1655     my $li_ids = $e->search_acq_lineitem({picklist => $pl_id}, {idlist => 1});
1656
1657     for my $li_id (@$li_ids) {
1658
1659         # copy the lineitems
1660         my $li = $e->retrieve_acq_lineitem($li_id);
1661         my $new_li = create_lineitem($mgr, %{$li->to_bare_hash}, picklist => $new_pl->id) or return $e->die_event;
1662
1663         my $lid_ids = $e->search_acq_lineitem_detail({lineitem => $li_id}, {idlist => 1});
1664         for my $lid_id (@$lid_ids) {
1665
1666             # copy the lineitem details
1667             my $lid = $e->retrieve_acq_lineitem_detail($lid_id);
1668             create_lineitem_detail($mgr, %{$lid->to_bare_hash}, lineitem => $new_li->id) or return $e->die_event;
1669         }
1670
1671         $mgr->respond;
1672     }
1673
1674     $e->commit;
1675     return $mgr->respond_complete;
1676 }
1677
1678
1679 __PACKAGE__->register_method(
1680         method => 'merge_picklist_api',
1681         api_name        => 'open-ils.acq.picklist.merge',
1682         signature => {
1683         desc => 'Merges 2 or more picklists into a single list',
1684         params => [
1685             {desc => 'Authentication token', type => 'string'},
1686             {desc => 'Lead Picklist ID', type => 'number'},
1687             {desc => 'List of subordinate picklist IDs', type => 'array'}
1688         ],
1689         return => {desc => 'status blob, Event on error'}
1690     }
1691 );
1692
1693 sub merge_picklist_api {
1694     my($self, $conn, $auth, $lead_pl, $pl_list) = @_;
1695
1696     my $e = new_editor(xact=>1, authtoken=>$auth);
1697     return $e->die_event unless $e->checkauth;
1698     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1699
1700     # XXX perms on each picklist modified
1701
1702     # point all of the lineitems at the lead picklist
1703     my $li_ids = $e->search_acq_lineitem({picklist => $pl_list}, {idlist => 1});
1704
1705     for my $li_id (@$li_ids) {
1706         my $li = $e->retrieve_acq_lineitem($li_id);
1707         $li->picklist($lead_pl);
1708         update_lineitem($mgr, $li) or return $e->die_event;
1709         $mgr->respond;
1710     }
1711
1712     # now delete the subordinate lists
1713     for my $pl_id (@$pl_list) {
1714         my $pl = $e->retrieve_acq_picklist($pl_id);
1715         $e->delete_acq_picklist($pl) or return $e->die_event;
1716     }
1717
1718     $e->commit;
1719     return $mgr->respond_complete;
1720 }
1721
1722
1723 __PACKAGE__->register_method(
1724         method => 'delete_picklist_api',
1725         api_name        => 'open-ils.acq.picklist.delete',
1726         signature => {
1727         desc => q/Deletes a picklist.  It also deletes any lineitems in the "new" state.
1728             Other attached lineitems are detached'/,
1729         params => [
1730             {desc => 'Authentication token', type => 'string'},
1731             {desc => 'Picklist ID to delete', type => 'number'}
1732         ],
1733         return => {desc => '1 on success, Event on error'}
1734     }
1735 );
1736
1737 sub delete_picklist_api {
1738     my($self, $conn, $auth, $picklist_id) = @_;
1739     my $e = new_editor(xact=>1, authtoken=>$auth);
1740     return $e->die_event unless $e->checkauth;
1741     my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
1742     my $pl = $e->retrieve_acq_picklist($picklist_id) or return $e->die_event;
1743     delete_picklist($mgr, $pl) or return $e->die_event;
1744     $e->commit;
1745     return $mgr->respond_complete;
1746 }
1747
1748
1749
1750 1;