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     return $self;
  25 }
  26
  27 sub conn {
  28     my($self, $val) = @_;
  29     $self->{conn} = $val if $val;
  30     return $self->{conn};
  31 }
  32 sub throttle {
  33     my($self, $val) = @_;
  34     $self->{throttle} = $val if $val;
  35     return $self->{throttle};
  36 }
  37 sub respond {
  38     my($self, %other_args) = @_;
  39     if($self->throttle and not %other_args) {
  40         return unless (
  41             ($self->{args}->{progress} - $self->{last_respond_progress}) >= $self->throttle
  42         );
  43     }
  44     $self->conn->respond({ %{$self->{args}}, %other_args });
  45     $self->{last_respond_progress} = $self->{args}->{progress};
  46 }
  47 sub respond_complete {
  48     my($self, %other_args) = @_;
  49     $self->complete;
  50     $self->conn->respond_complete({ %{$self->{args}}, %other_args });
  51     return undef;
  52 }
  53 sub total {
  54     my($self, $val) = @_;
  55     $self->{args}->{total} = $val if defined $val;
  56     $self->{args}->{maximum} = $self->{args}->{total};
  57     return $self->{args}->{total};
  58 }
  59 sub purchase_order {
  60     my($self, $val) = @_;
  61     $self->{args}->{purchase_order} = $val if $val;
  62     return $self;
  63 }
  64 sub picklist {
  65     my($self, $val) = @_;
  66     $self->{args}->{picklist} = $val if $val;
  67     return $self;
  68 }
  69 sub add_lid {
  70     my $self = shift;
  71     $self->{args}->{lid} += 1;
  72     $self->{args}->{progress} += 1;
  73     return $self;
  74 }
  75 sub add_li {
  76     my $self = shift;
  77     $self->{args}->{li} += 1;
  78     $self->{args}->{progress} += 1;
  79     return $self;
  80 }
  81 sub add_copy {
  82     my $self = shift;
  83     $self->{args}->{copies} += 1;
  84     $self->{args}->{progress} += 1;
  85     return $self;
  86 }
  87 sub add_bib {
  88     my $self = shift;
  89     $self->{args}->{bibs} += 1;
  90     $self->{args}->{progress} += 1;
  91     return $self;
  92 }
  93 sub add_debit {
  94     my($self, $amount) = @_;
  95     $self->{args}->{debits_accrued} += $amount;
  96     $self->{args}->{progress} += 1;
  97     return $self;
  98 }
  99 sub editor {
 100     my($self, $editor) = @_;
 101     $self->{editor} = $editor if defined $editor;
 102     return $self->{editor};
 103 }
 104 sub complete {
 105     my $self = shift;
 106     $self->{args}->{complete} = 1;
 107     return $self;
 108 }
 109
 110 sub ingest_ses {
 111     my($self, $val) = @_;
 112     $self->{ingest_ses} = $val if $val;
 113     return $self->{ingest_ses};
 114 }
 115
 116 sub push_ingest_queue {
 117     my($self, $rec_id) = @_;
 118
 119     $self->ingest_ses(OpenSRF::AppSession->connect('open-ils.ingest'))
 120         unless $self->ingest_ses;
 121
 122     my $req = $self->ingest_ses->request('open-ils.ingest.full.biblio.record', $rec_id);
 123
 124     push(@{$self->{ingest_queue}}, $req);
 125 }
 126
 127 sub process_ingest_records {
 128     my $self = shift;
 129     return unless @{$self->{ingest_queue}};
 130
 131     for my $req (@{$self->{ingest_queue}}) {
 132
 133         try {
 134             $req->gather(1);
 135             $self->{args}->{indexed} += 1;
 136             $self->{args}->{progress} += 1;
 137         } otherwise {};
 138
 139         $self->respond;
 140     }
 141     $self->ingest_ses->disconnect;
 142 }
 143
 144
 145 sub cache {
 146     my($self, $org, $key, $val) = @_;
 147     $self->{cache}->{$org} = {} unless $self->{cache}->{org};
 148     $self->{cache}->{$org}->{$key} = $val if defined $val;
 149     return $self->{cache}->{$org}->{$key};
 150 }
 151
 152
 153 package OpenILS::Application::Acq::Order;
 154 use base qw/OpenILS::Application/;
 155 use strict; use warnings;
 156 # ----------------------------------------------------------------------------
 157 # Break up each component of the order process and pieces into managable
 158 # actions that can be shared across different workflows
 159 # ----------------------------------------------------------------------------
 160 use OpenILS::Event;
 161 use OpenSRF::Utils::Logger qw(:logger);
 162 use OpenSRF::Utils::JSON;
 163 use OpenILS::Utils::Fieldmapper;
 164 use OpenILS::Utils::CStoreEditor q/:funcs/;
 165 use OpenILS::Const qw/:const/;
 166 use OpenSRF::EX q/:try/;
 167 use OpenILS::Application::AppUtils;
 168 use OpenILS::Application::Cat::BibCommon;
 169 use OpenILS::Application::Cat::AssetCommon;
 170 use MARC::Record;
 171 use MARC::Batch;
 172 use MARC::File::XML;
 173 my $U = 'OpenILS::Application::AppUtils';
 174
 175
 176 # ----------------------------------------------------------------------------
 177 # Lineitem
 178 # ----------------------------------------------------------------------------
 179 sub create_lineitem {
 180     my($mgr, %args) = @_;
 181     my $li = Fieldmapper::acq::lineitem->new;
 182     $li->creator($mgr->editor->requestor->id);
 183     $li->selector($li->creator);
 184     $li->editor($li->creator);
 185     $li->create_time('now');
 186     $li->edit_time('now');
 187     $li->state('new');
 188     $li->$_($args{$_}) for keys %args;
 189     if($li->picklist) {
 190         return 0 unless update_picklist($mgr, $li->picklist);
 191     }
 192     $mgr->add_li;
 193     return $mgr->editor->create_acq_lineitem($li);
 194 }
 195
 196 sub update_lineitem {
 197     my($mgr, $li) = @_;
 198     $li->edit_time('now');
 199     $li->editor($mgr->editor->requestor->id);
 200     return $li if $mgr->editor->update_acq_lineitem($li);
 201     $mgr->add_lid;
 202     return undef;
 203 }
 204
 205 sub delete_lineitem {
 206     my($mgr, $li) = @_;
 207     $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
 208
 209     if($li->picklist) {
 210         return 0 unless update_picklist($mgr, $li->picklist);
 211     }
 212
 213     if($li->purchase_order) {
 214         return 0 unless update_purchase_order($mgr, $li->purchase_order);
 215     }
 216
 217     # delete the attached lineitem_details
 218     my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
 219     for my $lid_id (@$lid_ids) {
 220         return 0 unless delete_lineitem_detail($mgr, undef, $lid_id);
 221     }
 222
 223     return $mgr->editor->delete_acq_lineitem($li);
 224 }
 225
 226 # begins and commit transactions as it goes
 227 sub create_lineitem_list_assets {
 228     my($mgr, $li_ids) = @_;
 229     # create the bibs/volumes/copies and ingest the records
 230     for my $li_id (@$li_ids) {
 231         $mgr->editor->xact_begin;
 232         my $data = create_lineitem_assets($mgr, $li_id) or return undef;
 233         $mgr->editor->xact_commit;
 234         $mgr->push_ingest_queue($data->{li}->eg_bib_id) if $data->{new_bib};
 235         $mgr->respond;
 236     }
 237     $mgr->process_ingest_records;
 238     return 1;
 239 }
 240
 241
 242 # ----------------------------------------------------------------------------
 243 # Lineitem Detail
 244 # ----------------------------------------------------------------------------
 245 sub create_lineitem_detail {
 246     my($mgr, %args) = @_;
 247     my $lid = Fieldmapper::acq::lineitem_detail->new;
 248     $lid->$_($args{$_}) for keys %args;
 249     $mgr->editor->create_acq_lineitem_detail($lid) or return 0;
 250     $mgr->add_lid;
 251
 252     # create some default values
 253     unless($lid->barcode) {
 254         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
 255         $lid->barcode($pfx.$lid->id);
 256     }
 257
 258     unless($lid->cn_label) {
 259         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
 260         $lid->cn_label($pfx.$lid->id);
 261     }
 262
 263     if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
 264         $lid->location($loc);
 265     }
 266
 267     if(!$lid->circ_modifier and my $mod = get_default_circ_modifier($mgr, $lid->owning_lib)) {
 268         $lid->circ_modifier($mod);
 269     }
 270
 271     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 272     my $li = $mgr->editor->retrieve_acq_lineitem($lid->lineitem) or return 0;
 273     update_lineitem($mgr, $li) or return 0;
 274     return $lid;
 275 }
 276
 277 sub get_default_circ_modifier {
 278     my($mgr, $org) = @_;
 279     my $mod = $mgr->cache($org, 'def_circ_mod');
 280     return $mod if $mod;
 281     $mod = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier');
 282     return $mgr->cache($org, 'def_circ_mod', $mod) if $mod;
 283     return undef;
 284 }
 285
 286 sub delete_lineitem_detail {
 287     my($mgr, $lid) = @_;
 288     $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
 289     return $mgr->editor->delete_acq_lineitem_detail($lid);
 290 }
 291
 292
 293 # ----------------------------------------------------------------------------
 294 # Lineitem Attr
 295 # ----------------------------------------------------------------------------
 296 sub set_lineitem_attr {
 297     my($mgr, %args) = @_;
 298     my $attr_type = $args{attr_type};
 299
 300     # first, see if it's already set.  May just need to overwrite it
 301     my $attr = $mgr->editor->search_acq_lineitem_attr({
 302         lineitem => $args{lineitem},
 303         attr_type => $args{attr_type},
 304         attr_name => $args{attr_name}
 305     })->[0];
 306
 307     if($attr) {
 308         $attr->attr_value($args{attr_value});
 309         return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
 310         return undef;
 311
 312     } else {
 313
 314         $attr = Fieldmapper::acq::lineitem_attr->new;
 315         $attr->$_($args{$_}) for keys %args;
 316
 317         unless($attr->definition) {
 318             my $find = "search_acq_$attr_type";
 319             my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
 320             $attr->definition($attr_def_id);
 321         }
 322         return $mgr->editor->create_acq_lineitem_attr($attr);
 323     }
 324 }
 325
 326 sub get_li_price {
 327     my $li = shift;
 328     my $attrs = $li->attributes;
 329     my ($marc_estimated, $local_estimated, $local_actual, $prov_estimated, $prov_actual);
 330
 331     for my $attr (@$attrs) {
 332         if($attr->attr_name eq 'estimated_price') {
 333             $local_estimated = $attr->attr_value
 334                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 335             $prov_estimated = $attr->attr_value
 336                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 337             $marc_estimated = $attr->attr_value
 338                 if $attr->attr_type eq 'lineitem_marc_attr_definition';
 339
 340         } elsif($attr->attr_name eq 'actual_price') {
 341             $local_actual = $attr->attr_value
 342                 if $attr->attr_type eq 'lineitem_local_attr_definition';
 343             $prov_actual = $attr->attr_value
 344                 if $attr->attr_type eq 'lineitem_prov_attr_definition';
 345         }
 346     }
 347
 348     return ($local_actual, 1) if $local_actual;
 349     return ($prov_actual, 2) if $prov_actual;
 350     return ($local_estimated, 1) if $local_estimated;
 351     return ($prov_estimated, 2) if $prov_estimated;
 352     return ($marc_estimated, 3);
 353 }
 354
 355
 356 # ----------------------------------------------------------------------------
 357 # Lineitem Debits
 358 # ----------------------------------------------------------------------------
 359 sub create_lineitem_debits {
 360     my($mgr, $li, $price, $ptype) = @_;
 361
 362     ($price, $ptype) = get_li_price($li) unless $price;
 363
 364     unless($price) {
 365         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PRICE', payload => $li->id));
 366         $mgr->editor->rollback;
 367         return 0;
 368     }
 369
 370     unless($li->provider) {
 371         $mgr->editor->event(OpenILS::Event->new('ACQ_LINEITEM_NO_PROVIDER', payload => $li->id));
 372         $mgr->editor->rollback;
 373         return 0;
 374     }
 375
 376     my $lid_ids = $mgr->editor->search_acq_lineitem_detail(
 377         {lineitem => $li->id},
 378         {idlist=>1}
 379     );
 380
 381     for my $lid_id (@$lid_ids) {
 382
 383         my $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 384             $lid_id,
 385             {   flesh => 1,
 386                 flesh_fields => {acqlid => ['fund']}
 387             }
 388         ]);
 389
 390         create_lineitem_detail_debit($mgr, $li, $lid, $price, $ptype) or return 0;
 391     }
 392
 393     return 1;
 394 }
 395
 396
 397 # flesh li->provider
 398 # flesh lid->fund
 399 # ptype 1=local, 2=provider, 3=marc
 400 sub create_lineitem_detail_debit {
 401     my($mgr, $li, $lid, $price, $ptype) = @_;
 402
 403     unless(ref $li and ref $li->provider) {
 404        $li = $mgr->editor->retrieve_acq_lineitem([
 405             $li,
 406             {   flesh => 1,
 407                 flesh_fields => {jub => ['provider']},
 408             }
 409         ]);
 410     }
 411
 412     unless(ref $lid and ref $lid->fund) {
 413         $lid = $mgr->editor->retrieve_acq_lineitem_detail([
 414             $lid,
 415             {   flesh => 1,
 416                 flesh_fields => {acqlid => ['fund']}
 417             }
 418         ]);
 419     }
 420
 421     my $ctype = $lid->fund->currency_type;
 422     my $amount = $price;
 423
 424     if($ptype == 2) { # price from vendor
 425         $ctype = $li->provider->currency_type;
 426         $amount = currency_conversion($mgr, $ctype, $lid->fund->currency_type, $price);
 427     }
 428
 429     my $debit = create_fund_debit(
 430         $mgr,
 431         fund => $lid->fund->id,
 432         origin_amount => $price,
 433         origin_currency_type => $ctype,
 434         amount => $amount
 435     ) or return 0;
 436
 437     $lid->fund_debit($debit->id);
 438     $lid->fund($lid->fund->id);
 439     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 440     return $debit;
 441 }
 442
 443
 444 # ----------------------------------------------------------------------------
 445 # Fund Debit
 446 # ----------------------------------------------------------------------------
 447 sub create_fund_debit {
 448     my($mgr, %args) = @_;
 449     my $debit = Fieldmapper::acq::fund_debit->new;
 450     $debit->debit_type('purchase');
 451     $debit->encumbrance('t');
 452     $debit->$_($args{$_}) for keys %args;
 453     $mgr->add_debit($debit->amount);
 454     return $mgr->editor->create_acq_fund_debit($debit);
 455 }
 456
 457 sub currency_conversion {
 458     my($mgr, $src_currency, $dest_currency, $amount) = @_;
 459     my $result = $mgr->editor->json_query(
 460         {from => ['acq.exchange_ratio', $src_currency, $dest_currency, $amount]});
 461     return $result->[0]->{'acq.exchange_ratio'};
 462 }
 463
 464
 465 # ----------------------------------------------------------------------------
 466 # Picklist
 467 # ----------------------------------------------------------------------------
 468 sub create_picklist {
 469     my($mgr, %args) = @_;
 470     my $picklist = Fieldmapper::acq::picklist->new;
 471     $picklist->creator($mgr->editor->requestor->id);
 472     $picklist->owner($picklist->creator);
 473     $picklist->editor($picklist->creator);
 474     $picklist->create_time('now');
 475     $picklist->edit_time('now');
 476     $picklist->org_unit($mgr->editor->requestor->ws_ou);
 477     $picklist->owner($mgr->editor->requestor->id);
 478     $picklist->$_($args{$_}) for keys %args;
 479     $mgr->picklist($picklist);
 480     return $mgr->editor->create_acq_picklist($picklist);
 481 }
 482
 483 sub update_picklist {
 484     my($mgr, $picklist) = @_;
 485     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 486     $picklist->edit_time('now');
 487     $picklist->editor($mgr->editor->requestor->id);
 488     $mgr->picklist($picklist);
 489     return $picklist if $mgr->editor->update_acq_picklist($picklist);
 490     return undef;
 491 }
 492
 493 sub delete_picklist {
 494     my($mgr, $picklist) = @_;
 495     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 496
 497     # delete all 'new' lineitems
 498     my $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'});
 499     for my $li (@$lis) {
 500         return 0 unless delete_lineitem($mgr, $li);
 501     }
 502
 503     # detach all non-'new' lineitems
 504     $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}});
 505     for my $li (@$lis) {
 506         $li->clear_picklist;
 507         return 0 unless update_lineitem($li);
 508     }
 509
 510     # remove any picklist-specific object perms
 511     my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => ''.$picklist->id});
 512     for my $op (@$ops) {
 513         return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
 514     }
 515
 516     return $mgr->editor->delete_acq_picklist($picklist);
 517 }
 518
 519 # ----------------------------------------------------------------------------
 520 # Purchase Order
 521 # ----------------------------------------------------------------------------
 522 sub update_purchase_order {
 523     my($mgr, $po) = @_;
 524     $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
 525     $po->editor($mgr->editor->requestor->id);
 526     $po->edit_time('now');
 527     $mgr->purchase_order($po);
 528     return $po if $mgr->editor->update_acq_purchase_order($po);
 529     return undef;
 530 }
 531
 532 sub create_purchase_order {
 533     my($mgr, %args) = @_;
 534     my $po = Fieldmapper::acq::purchase_order->new;
 535     $po->creator($mgr->editor->requestor->id);
 536     $po->editor($mgr->editor->requestor->id);
 537     $po->owner($mgr->editor->requestor->id);
 538     $po->edit_time('now');
 539     $po->create_time('now');
 540     $po->ordering_agency($mgr->editor->requestor->ws_ou);
 541     $po->$_($args{$_}) for keys %args;
 542     $mgr->purchase_order($po);
 543     return $mgr->editor->create_acq_purchase_order($po);
 544 }
 545
 546
 547 # ----------------------------------------------------------------------------
 548 # Bib, Callnumber, and Copy data
 549 # ----------------------------------------------------------------------------
 550
 551 sub create_lineitem_assets {
 552     my($mgr, $li_id) = @_;
 553     my $evt;
 554
 555     my $li = $mgr->editor->retrieve_acq_lineitem([
 556         $li_id,
 557         {   flesh => 1,
 558             flesh_fields => {jub => ['purchase_order', 'attributes']}
 559         }
 560     ]) or return 0;
 561
 562     # -----------------------------------------------------------------
 563     # first, create the bib record if necessary
 564     # -----------------------------------------------------------------
 565     my $new_bib = 0;
 566     unless($li->eg_bib_id) {
 567         create_bib($mgr, $li) or return 0;
 568         $new_bib = 1;
 569     }
 570
 571     my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
 572
 573     # -----------------------------------------------------------------
 574     # for each lineitem_detail, create the volume if necessary, create
 575     # a copy, and link them all together.
 576     # -----------------------------------------------------------------
 577     for my $lid_id (@{$li_details}) {
 578
 579         my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
 580         next if $lid->eg_copy_id;
 581
 582         my $org = $lid->owning_lib;
 583         my $label = $lid->cn_label;
 584         my $bibid = $li->eg_bib_id;
 585
 586         my $volume = $mgr->cache($org, "cn.$bibid.$label");
 587         unless($volume) {
 588             $volume = create_volume($mgr, $li, $lid) or return 0;
 589             $mgr->cache($org, "cn.$bibid.$label", $volume);
 590         }
 591         create_copy($mgr, $volume, $lid) or return 0;
 592     }
 593
 594     return { li => $li, new_bib => $new_bib };
 595 }
 596
 597 sub create_bib {
 598     my($mgr, $li) = @_;
 599
 600     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 601         $mgr->editor,
 602         $li->marc,
 603         undef,
 604         undef,
 605         1, # override tcn collisions
 606         1, # no-ingest
 607         undef # $rec->bib_source
 608     );
 609
 610     if($U->event_code($record)) {
 611         $mgr->editor->event($record);
 612         $mgr->editor->rollback;
 613         return 0;
 614     }
 615
 616     $li->eg_bib_id($record->id);
 617     $mgr->add_bib;
 618     return update_lineitem($mgr, $li);
 619 }
 620
 621 sub create_volume {
 622     my($mgr, $li, $lid) = @_;
 623
 624     my ($volume, $evt) =
 625         OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
 626             $mgr->editor,
 627             $lid->cn_label,
 628             $li->eg_bib_id,
 629             $lid->owning_lib
 630         );
 631
 632     if($evt) {
 633         $mgr->editor->event($evt);
 634         return 0;
 635     }
 636
 637     return $volume;
 638 }
 639
 640 sub create_copy {
 641     my($mgr, $volume, $lid) = @_;
 642     my $copy = Fieldmapper::asset::copy->new;
 643     $copy->isnew(1);
 644     $copy->loan_duration(2);
 645     $copy->fine_level(2);
 646     $copy->status(OILS_COPY_STATUS_ON_ORDER);
 647     $copy->barcode($lid->barcode);
 648     $copy->location($lid->location);
 649     $copy->call_number($volume->id);
 650     $copy->circ_lib($volume->owning_lib);
 651     $copy->circ_modifier($lid->circ_modifier);
 652
 653     my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
 654     if($evt) {
 655         $mgr->editor->event($evt);
 656         return 0;
 657     }
 658
 659     $mgr->add_copy;
 660     $lid->eg_copy_id($copy->id);
 661     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 662 }
 663
 664
 665
 666
 667
 668
 669 # ----------------------------------------------------------------------------
 670 # Workflow: Build a selection list from a Z39.50 search
 671 # ----------------------------------------------------------------------------
 672
 673 __PACKAGE__->register_method(
 674         method => 'zsearch',
 675         api_name => 'open-ils.acq.picklist.search.z3950',
 676     stream => 1,
 677         signature => {
 678         desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
 679         params => [
 680             {desc => 'Authentication token', type => 'string'},
 681             {desc => 'Search definition', type => 'object'},
 682             {desc => 'Picklist name, optional', type => 'string'},
 683         ]
 684     }
 685 );
 686
 687 sub zsearch {
 688     my($self, $conn, $auth, $search, $name, $options) = @_;
 689     my $e = new_editor(authtoken=>$auth);
 690     return $e->event unless $e->checkauth;
 691     return $e->event unless $e->allowed('CREATE_PICKLIST');
 692
 693     $search->{limit} ||= 10;
 694     $options ||= {};
 695
 696     my $ses = OpenSRF::AppSession->create('open-ils.search');
 697     my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
 698
 699     my $first = 1;
 700     my $picklist;
 701     my $mgr;
 702     while(my $resp = $req->recv(timeout=>60)) {
 703
 704         if($first) {
 705             my $e = new_editor(requestor=>$e->requestor, xact=>1);
 706             $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
 707             $picklist = zsearch_build_pl($mgr, $name);
 708             $first = 0;
 709         }
 710
 711         my $result = $resp->content;
 712         my $count = $result->{count};
 713         $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
 714
 715         for my $rec (@{$result->{records}}) {
 716
 717             my $li = create_lineitem($mgr,
 718                 picklist => $picklist->id,
 719                 source_label => $result->{service},
 720                 marc => $rec->{marcxml},
 721                 eg_bib_id => $rec->{bibid}
 722             );
 723
 724             if($$options{respond_li}) {
 725                 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
 726                     if $$options{flesh_attrs};
 727                 $li->clear_marc if $$options{clear_marc};
 728                 $mgr->respond(lineitem => $li);
 729             } else {
 730                 $mgr->respond;
 731             }
 732         }
 733     }
 734
 735     $mgr->editor->commit;
 736     return $mgr->respond_complete;
 737 }
 738
 739 sub zsearch_build_pl {
 740     my($mgr, $name) = @_;
 741     $name ||= '';
 742
 743     my $picklist = $mgr->editor->search_acq_picklist({
 744         owner => $mgr->editor->requestor->id,
 745         name => $name
 746     })->[0];
 747
 748     if($name eq '' and $picklist) {
 749         return 0 unless delete_picklist($mgr, $picklist);
 750         $picklist = undef;
 751     }
 752
 753     return update_picklist($mgr, $picklist) if $picklist;
 754     return create_picklist($mgr, name => $name);
 755 }
 756
 757
 758 # ----------------------------------------------------------------------------
 759 # Workflow: Build a selection list / PO by importing a batch of MARC records
 760 # ----------------------------------------------------------------------------
 761
 762 __PACKAGE__->register_method(
 763     method => 'upload_records',
 764     api_name => 'open-ils.acq.process_upload_records',
 765     stream => 1,
 766 );
 767
 768 sub upload_records {
 769     my($self, $conn, $auth, $key) = @_;
 770
 771         my $e = new_editor(authtoken => $auth, xact => 1);
 772     return $e->die_event unless $e->checkauth;
 773
 774     my $mgr = OpenILS::Application::Acq::BatchManager->new(
 775         editor => $e,
 776         conn => $conn,
 777         throttle => 5
 778     );
 779
 780     my $cache = OpenSRF::Utils::Cache->new;
 781
 782     my $data = $cache->get_cache("vandelay_import_spool_$key");
 783         my $purpose = $data->{purpose};
 784     my $filename = $data->{path};
 785     my $provider = $data->{provider};
 786     my $picklist = $data->{picklist};
 787     my $create_po = $data->{create_po};
 788     my $ordering_agency = $data->{ordering_agency};
 789     my $create_assets = $data->{create_assets};
 790     my $po;
 791     my $evt;
 792
 793     unless(-r $filename) {
 794         $logger->error("unable to read MARC file $filename");
 795         $e->rollback;
 796         return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
 797     }
 798
 799     $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
 800
 801     if($picklist) {
 802         $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
 803         if($picklist->owner != $e->requestor->id) {
 804             return $e->die_event unless
 805                 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
 806         }
 807     }
 808
 809     if($create_po) {
 810         $po = create_purchase_order($mgr,
 811             ordering_agency => $ordering_agency,
 812             provider => $provider->id
 813         ) or return $mgr->editor->die_event;
 814     }
 815
 816     $logger->info("acq processing MARC file=$filename");
 817
 818     my $marctype = 'USMARC'; # ?
 819         my $batch = new MARC::Batch ($marctype, $filename);
 820         $batch->strict_off;
 821
 822         my $count = 0;
 823     my @li_list;
 824
 825         while(1) {
 826
 827             my $err;
 828         my $xml;
 829                 $count++;
 830         my $r;
 831
 832                 try {
 833             $r = $batch->next;
 834         } catch Error with {
 835             $err = shift;
 836                         $logger->warn("Proccessing of record $count in set $key failed with error $err.  Skipping this record");
 837         };
 838
 839         next if $err;
 840         last unless $r;
 841
 842                 try {
 843             ($xml = $r->as_xml_record()) =~ s/\n//sog;
 844             $xml =~ s/^<\?xml.+\?\s*>//go;
 845             $xml =~ s/>\s+</></go;
 846             $xml =~ s/\p{Cc}//go;
 847             $xml = $U->entityize($xml);
 848             $xml =~ s/[\x00-\x1f]//go;
 849
 850                 } catch Error with {
 851                         $err = shift;
 852                         $logger->warn("Proccessing XML of record $count in set $key failed with error $err.  Skipping this record");
 853                 };
 854
 855         next if $err or not $xml;
 856
 857         my %args = (
 858             source_label => $provider->code,
 859             provider => $provider->id,
 860             marc => $xml,
 861         );
 862
 863         $args{picklist} = $picklist->id if $picklist;
 864         if($po) {
 865             $args{purchase_order} = $po->id;
 866             $args{state} = 'on-order';
 867         }
 868
 869         my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
 870         $mgr->respond;
 871         $li->provider($provider); # flesh it, we'll need it later
 872
 873         import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
 874         $mgr->respond;
 875
 876         push(@li_list, $li->id);
 877         $mgr->respond;
 878         }
 879
 880         $e->commit;
 881     unlink($filename);
 882     $cache->delete_cache('vandelay_import_spool_' . $key);
 883
 884     if($create_assets) {
 885         create_lineitem_list_assets($mgr, \@li_list) or return $e->die_event;
 886     }
 887
 888     return $mgr->respond_complete;
 889 }
 890
 891 sub import_lineitem_details {
 892     my($mgr, $ordering_agency, $li) = @_;
 893
 894     my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
 895     return 1 unless @$holdings;
 896     my $org_path = $U->get_org_ancestors($ordering_agency);
 897     $org_path = [ reverse (@$org_path) ];
 898     my $price;
 899
 900     my $idx = 1;
 901     while(1) {
 902         # create a lineitem detail for each copy in the data
 903
 904         my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
 905         last unless defined $compiled;
 906         return 0 unless $compiled;
 907
 908         # this takes the price of the last copy and uses it as the lineitem price
 909         # need to determine if a given record would include different prices for the same item
 910         $price = $$compiled{price};
 911
 912         for(1..$$compiled{quantity}) {
 913             my $lid = create_lineitem_detail($mgr,
 914                 lineitem => $li->id,
 915                 owning_lib => $$compiled{owning_lib},
 916                 cn_label => $$compiled{call_number},
 917                 fund => $$compiled{fund},
 918                 circ_modifier => $$compiled{circ_modifier},
 919                 note => $$compiled{note},
 920                 location => $$compiled{copy_location}
 921             ) or return 0;
 922         }
 923
 924         $mgr->respond;
 925         $idx++;
 926     }
 927
 928     # set the price attr so we'll know the source of the price
 929     set_lineitem_attr(
 930         $mgr,
 931         attr_name => 'estimated_price',
 932         attr_type => 'lineitem_local_attr_definition',
 933         attr_value => $price,
 934         lineitem => $li->id
 935     ) or return 0;
 936
 937     # if we're creating a purchase order, create the debits
 938     if($li->purchase_order) {
 939         create_lineitem_debits($mgr, $li, $price, 2) or return 0;
 940         $mgr->respond;
 941     }
 942
 943     return 1;
 944 }
 945
 946 # return hash on success, 0 on error, undef on no more holdings
 947 sub extract_lineitem_detail_data {
 948     my($mgr, $org_path, $holdings, $index) = @_;
 949
 950     my @data_list = grep { $_->{holding} eq $index } @$holdings;
 951     return undef unless @data_list;
 952
 953     my %compiled = map { $_->{attr} => $_->{data} } @data_list;
 954     my $base_org = $$org_path[0];
 955
 956     my $killme = sub {
 957         my $msg = shift;
 958         $logger->error("Item import extraction error: $msg");
 959         $logger->error('Holdings Data: ' . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
 960         $mgr->editor->rollback;
 961         $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
 962         return 0;
 963     };
 964
 965     $compiled{quantity} ||= 1;
 966
 967     # ---------------------------------------------------------------------
 968     # Fund
 969     my $code = $compiled{fund_code};
 970     return $killme->('no fund code provided') unless $code;
 971
 972     my $fund = $mgr->cache($base_org, "fund.$code");
 973     unless($fund) {
 974         # search up the org tree for the most appropriate fund
 975         for my $org (@$org_path) {
 976             $fund = $mgr->editor->search_acq_fund(
 977                 {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
 978             last if $fund;
 979         }
 980     }
 981     return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
 982     $compiled{fund} = $fund;
 983     $mgr->cache($base_org, "fund.$code", $fund);
 984
 985
 986     # ---------------------------------------------------------------------
 987     # Owning lib
 988     my $sn = $compiled{owning_lib};
 989     return $killme->('no owning_lib defined') unless $sn;
 990     my $org_id =
 991         $mgr->cache($base_org, "orgsn.$sn") ||
 992             $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
 993     return $killme->("invalid owning_lib defined: $sn") unless $org_id;
 994     $compiled{owning_lib} = $org_id;
 995     $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
 996
 997
 998     # ---------------------------------------------------------------------
 999     # Circ Modifier
1000     my $mod;
1001     $code = $compiled{circ_modifier};
1002
1003     if($code) {
1004
1005         $mod = $mgr->cache($base_org, "mod.$code") ||
1006             $mgr->editor->retrieve_config_circ_modifier($code);
1007         return $killme->("invlalid circ_modifier $code") unless $mod;
1008         $mgr->cache($base_org, "mod.$code", $mod);
1009
1010     } else {
1011         # try the default
1012         $mod = get_default_circ_modifier($mgr, $base_org)
1013             or return $killme->('no circ_modifier defined');
1014     }
1015
1016     $compiled{circ_modifier} = $mod;
1017
1018
1019     # ---------------------------------------------------------------------
1020     # Shelving Location
1021     my $name = $compiled{copy_location};
1022     return $killme->('no copy_location defined') unless $name;
1023     my $loc = $mgr->cache($base_org, "copy_loc.$name");
1024     unless($loc) {
1025         for my $org (@$org_path) {
1026             $loc = $mgr->editor->search_asset_copy_location(
1027                 {owning_lib => $org, name => $name}, {idlist => 1})->[0];
1028             last if $loc;
1029         }
1030     }
1031     return $killme->("Invalid copy location $name") unless $loc;
1032     $compiled{copy_location} = $loc;
1033     $mgr->cache($base_org, "copy_loc.$name", $loc);
1034
1035     return \%compiled;
1036 }
1037
1038
1039
1040 # ----------------------------------------------------------------------------
1041 # Workflow: Given an existing purchase order, import/create the bibs,
1042 # callnumber and copy objects
1043 # ----------------------------------------------------------------------------
1044
1045 __PACKAGE__->register_method(
1046         method => 'create_po_assets',
1047         api_name        => 'open-ils.acq.purchase_order.assets.create',
1048         signature => {
1049         desc => q/Creates assets for each lineitem in the purchase order/,
1050         params => [
1051             {desc => 'Authentication token', type => 'string'},
1052             {desc => 'The purchase order id', type => 'number'},
1053         ],
1054         return => {desc => 'Streams a total versus completed counts object, event on error'}
1055     }
1056 );
1057
1058 sub create_po_assets {
1059     my($self, $conn, $auth, $po_id) = @_;
1060     my $e = new_editor(authtoken=>$auth, xact=>1);
1061     return $e->die_event unless $e->checkauth;
1062
1063     my $mgr = OpenILS::Application::Acq::BatchManager->new(
1064         editor => $e,
1065         conn => $conn,
1066         throttle => 5
1067     );
1068
1069     my $po = $e->retrieve_acq_purchase_order($po_id) or return $e->die_event;
1070     return $e->die_event unless $e->allowed('IMPORT_PURCHASE_ORDER_ASSETS', $po->ordering_agency);
1071
1072     my $li_ids = $e->search_acq_lineitem({purchase_order => $po_id}, {idlist => 1});
1073
1074     # it's ugly, but it's fast.  Get the total count of lineitem detail objects to process
1075     my $lid_total = $e->json_query({
1076         select => { acqlid => [{aggregate => 1, transform => 'count', column => 'id'}] },
1077         from => {
1078             acqlid => {
1079                 jub => {
1080                     fkey => 'lineitem',
1081                     field => 'id',
1082                     join => {acqpo => {fkey => 'purchase_order', field => 'id'}}
1083                 }
1084             }
1085         },
1086         where => {'+acqpo' => {id => $po_id}}
1087     })->[0]->{id};
1088
1089     $mgr->total(scalar(@$li_ids) + $lid_total);
1090
1091     create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1092
1093     $e->xact_begin;
1094     update_purchase_order($mgr, $po) or return $e->die_event;
1095     $e->commit;
1096
1097     return $mgr->respond_complete;
1098 }
1099
1100
1101
1102 __PACKAGE__->register_method(
1103         method => 'create_purchase_order_api',
1104         api_name        => 'open-ils.acq.purchase_order.create',
1105         signature => {
1106         desc => 'Creates a new purchase order',
1107         params => [
1108             {desc => 'Authentication token', type => 'string'},
1109             {desc => 'purchase_order to create', type => 'object'}
1110         ],
1111         return => {desc => 'The purchase order id, Event on failure'}
1112     }
1113 );
1114
1115 sub create_purchase_order_api {
1116     my($self, $conn, $auth, $po, $args) = @_;
1117     $args ||= {};
1118
1119     my $e = new_editor(xact=>1, authtoken=>$auth);
1120     return $e->die_event unless $e->checkauth;
1121     return $e->die_event unless $e->allowed('CREATE_PURCHASE_ORDER', $po->ordering_agency);
1122
1123     my $mgr = OpenILS::Application::Acq::BatchManager->new(
1124         editor => $e,
1125         conn => $conn,
1126         throttle => 5
1127     );
1128
1129     # create the PO
1130     my %pargs = (ordering_agency => $e->requestor->ws_ou);
1131     $pargs{provider} = $po->provider if $po->provider;
1132     $po = create_purchase_order($mgr, %pargs) or return $e->die_event;
1133
1134     my $li_ids = $$args{lineitems};
1135
1136     if($li_ids) {
1137
1138         for my $li_id (@$li_ids) {
1139
1140             my $li = $e->retrieve_acq_lineitem([
1141                 $li_id,
1142                 {flesh => 1, flesh_fields => {jub => ['attributes']}}
1143             ]) or return $e->die_event;
1144
1145             $li->provider($po->provider);
1146             $li->purchase_order($po->id);
1147             update_lineitem($mgr, $li) or return $e->die_event;
1148             $mgr->respond;
1149
1150             create_lineitem_debits($mgr, $li) or return $e->die_event;
1151         }
1152     }
1153
1154     # commit before starting the asset creation
1155     $e->xact_commit;
1156
1157     if($li_ids and $$args{create_assets}) {
1158         create_lineitem_list_assets($mgr, $li_ids) or return $e->die_event;
1159     }
1160
1161     return $mgr->respond_complete;
1162 }
1163
1164
1165 __PACKAGE__->register_method(
1166         method => 'lineitem_detail_CUD_batch',
1167         api_name => 'open-ils.acq.lineitem_detail.cud.batch',
1168     stream => 1,
1169         signature => {
1170         desc => q/Creates a new purchase order line item detail.
1171             Additionally creates the associated fund_debit/,
1172         params => [
1173             {desc => 'Authentication token', type => 'string'},
1174             {desc => 'List of lineitem_details to create', type => 'array'},
1175         ],
1176         return => {desc => 'Streaming response of current position in the array'}
1177     }
1178 );
1179
1180 sub lineitem_detail_CUD_batch {
1181     my($self, $conn, $auth, $li_details) = @_;
1182
1183     my $e = new_editor(xact=>1, authtoken=>$auth);
1184     return $e->die_event unless $e->checkauth;
1185
1186     my $mgr = OpenILS::Application::Acq::BatchManager->new(
1187         editor => $e,
1188         conn => $conn,
1189         throttle => 5
1190     );
1191
1192     # XXX perms
1193
1194     $mgr->total(scalar(@$li_details));
1195
1196     my %li_cache;
1197
1198     for my $lid (@$li_details) {
1199
1200         my $li = $li_cache{$lid->lineitem} || $e->retrieve_acq_lineitem($lid->lineitem);
1201
1202         if($lid->isnew) {
1203             create_lineitem_detail($mgr, %{$lid->to_bare_hash}) or return $e->die_event;
1204
1205         } elsif($lid->ischanged) {
1206             $e->update_acq_lineitem_detail($lid) or return $e->die_event;
1207
1208         } elsif($lid->isdeleted) {
1209             delete_lineitem_detail($mgr, $lid) or return $e->die_event;
1210         }
1211
1212         $mgr->respond(li => $li);
1213         $li_cache{$lid->lineitem} = $li;
1214     }
1215
1216     $e->commit;
1217     return $mgr->respond_complete;
1218 }
1219
1220
1221
1222 1;