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