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

   1 package OpenILS::Application::Acq::BatchManager;
   2 use strict; use warnings;
   3
   4 sub new {
   5     my($class, %args) = @_;
   6     my $self = bless(\%args, $class);
   7     $self->{args} = {
   8         lid => 0,
   9         li => 0,
  10         copies => 0,
  11         progress => 0,
  12         debits_accrued => 0,
  13         purchase_order => undef,
  14         picklist => undef,
  15         complete => 0
  16     };
  17     $self->{cache} = {};
  18     return $self;
  19 }
  20
  21 sub conn {
  22     my($self, $val) = @_;
  23     $self->{conn} = $val if $val;
  24     return $self->{conn};
  25 }
  26 sub throttle {
  27     my($self, $val) = @_;
  28     $self->{throttle} = $val if $val;
  29     return $self->{throttle};
  30 }
  31 sub respond {
  32     my($self, %other_args) = @_;
  33     if($self->throttle and not %other_args) {
  34         return unless ($self->{args}->{progress} % $self->throttle) == 0;
  35     }
  36     $self->conn->respond({ %{$self->{args}}, %other_args });
  37 }
  38 sub respond_complete {
  39     my($self, %other_args) = @_;
  40     $self->complete;
  41     $self->conn->respond_complete({ %{$self->{args}}, %other_args });
  42     return undef;
  43 }
  44 sub total {
  45     my($self, $val) = @_;
  46     $self->{total} = $val if defined $val;
  47     return $self->{total};
  48 }
  49 sub purchase_order {
  50     my($self, $val) = @_;
  51     $self->{purchase_order} = $val if $val;
  52     return $self;
  53 }
  54 sub picklist {
  55     my($self, $val) = @_;
  56     $self->{picklist} = $val if $val;
  57     return $self;
  58 }
  59 sub add_lid {
  60     my $self = shift;
  61     $self->{args}->{lid} += 1;
  62     $self->{args}->{progress} += 1;
  63     return $self;
  64 }
  65 sub add_li {
  66     my $self = shift;
  67     $self->{args}->{li} += 1;
  68     $self->{args}->{progress} += 1;
  69     return $self;
  70 }
  71 sub add_copy {
  72     my $self = shift;
  73     $self->{args}->{copies} += 1;
  74     $self->{args}->{progress} += 1;
  75     return $self;
  76 }
  77 sub add_debit {
  78     my($self, $amount) = @_;
  79     $self->{args}->{debits_accrued} += $amount;
  80     $self->{args}->{progress} += 1;
  81     return $self;
  82 }
  83 sub editor {
  84     my($self, $editor) = @_;
  85     $self->{editor} = $editor if defined $editor;
  86     return $self->{editor};
  87 }
  88 sub complete {
  89     my $self = shift;
  90     $self->{args}->{complete} = 1;
  91     return $self;
  92 }
  93
  94 sub cache {
  95     my($self, $org, $key, $val) = @_;
  96     $self->{cache}->{$org} = {} unless $self->{cache}->{org};
  97     $self->{cache}->{$org}->{$key} = $val if defined $val;
  98     return $self->{cache}->{$org}->{$key};
  99 }
 100
 101
 102 package OpenILS::Application::Acq::Order;
 103 use base qw/OpenILS::Application/;
 104 use strict; use warnings;
 105 # ----------------------------------------------------------------------------
 106 # Break up each component of the order process and pieces into managable
 107 # actions that can be shared across different workflows
 108 # ----------------------------------------------------------------------------
 109 use OpenILS::Event;
 110 use OpenSRF::Utils::Logger qw(:logger);
 111 use OpenSRF::Utils::JSON;
 112 use OpenILS::Utils::Fieldmapper;
 113 use OpenILS::Utils::CStoreEditor q/:funcs/;
 114 use OpenILS::Const qw/:const/;
 115 use OpenSRF::EX q/:try/;
 116 use OpenILS::Application::AppUtils;
 117 use OpenILS::Application::Cat::BibCommon;
 118 use OpenILS::Application::Cat::AssetCommon;
 119 use MARC::Record;
 120 use MARC::Batch;
 121 use MARC::File::XML;
 122 my $U = 'OpenILS::Application::AppUtils';
 123
 124
 125 # ----------------------------------------------------------------------------
 126 # Lineitem
 127 # ----------------------------------------------------------------------------
 128 sub create_lineitem {
 129     my($mgr, %args) = @_;
 130     my $li = Fieldmapper::acq::lineitem->new;
 131     $li->creator($mgr->editor->requestor->id);
 132     $li->selector($li->creator);
 133     $li->editor($li->creator);
 134     $li->create_time('now');
 135     $li->edit_time('now');
 136     $li->state('new');
 137     $li->$_($args{$_}) for keys %args;
 138     if($li->picklist) {
 139         return 0 unless update_picklist($mgr, $li->picklist);
 140     }
 141     $mgr->add_li;
 142     return $mgr->editor->create_acq_lineitem($li);
 143 }
 144
 145 sub update_lineitem {
 146     my($mgr, $li) = @_;
 147     $li->edit_time('now');
 148     $li->editor($mgr->editor->requestor->id);
 149     return $li if $mgr->editor->update_acq_lineitem($li);
 150     return undef;
 151 }
 152
 153 sub delete_lineitem {
 154     my($mgr, $li) = @_;
 155     $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
 156
 157     if($li->picklist) {
 158         return 0 unless update_picklist($mgr, $li->picklist);
 159     }
 160
 161     if($li->purchase_order) {
 162         return 0 unless update_purchase_order($mgr, $li->purchase_order);
 163     }
 164
 165     # delete the attached lineitem_details
 166     my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
 167     for my $lid_id (@$lid_ids) {
 168         return 0 unless delete_lineitem_detail($mgr, undef, $lid_id);
 169     }
 170
 171     return $mgr->editor->delete_acq_lineitem($li);
 172 }
 173
 174 # ----------------------------------------------------------------------------
 175 # Lineitem Detail
 176 # ----------------------------------------------------------------------------
 177 sub create_lineitem_detail {
 178     my($mgr, %args) = @_;
 179     my $lid = Fieldmapper::acq::lineitem_detail->new;
 180     $lid->$_($args{$_}) for keys %args;
 181     $mgr->editor->create_acq_lineitem_detail($lid) or return 0;
 182     $mgr->add_lid;
 183
 184     # create some default values
 185     unless($lid->barcode) {
 186         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
 187         $lid->barcode($pfx.$lid->id);
 188     }
 189
 190     unless($lid->cn_label) {
 191         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
 192         $lid->cn_label($pfx.$lid->id);
 193     }
 194
 195     if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
 196         $lid->location($loc);
 197     }
 198
 199     if(!$lid->circ_modifier and my $mod = get_default_circ_modifier($mgr, $lid->owning_lib)) {
 200         $lid->circ_modifier($mod);
 201     }
 202
 203     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 204     my $li = $mgr->editor->retrieve_acq_lineitem($lid->lineitem) or return 0;
 205     update_lineitem($mgr, $li) or return 0;
 206     return $lid;
 207 }
 208
 209 sub get_default_circ_modifier {
 210     my($mgr, $org) = @_;
 211     my $mod = $mgr->cache($org, "def_circ_mod");
 212     return $mod if $mod;
 213     $mod = $U->ou_ancestor_setting_value($org, 'acq.default_circ_modifier');
 214     return $mgr->cache($org, "def_circ_mod", $mod) if $mod;
 215     return undef;
 216 }
 217
 218 sub delete_lineitem_detail {
 219     my($mgr, $lid) = @_;
 220     $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
 221     return $mgr->editor->delete_acq_lineitem_detail($lid);
 222 }
 223
 224
 225 # ----------------------------------------------------------------------------
 226 # Lineitem Attr
 227 # ----------------------------------------------------------------------------
 228 sub set_lineitem_attr {
 229     my($mgr, %args) = @_;
 230     my $attr_type = $args{attr_type};
 231
 232     # first, see if it's already set.  May just need to overwrite it
 233     my $attr = $mgr->editor->search_acq_lineitem_attr({
 234         lineitem => $args{lineitem},
 235         attr_type => $args{attr_type},
 236         attr_name => $args{attr_name}
 237     })->[0];
 238
 239     if($attr) {
 240         $attr->attr_value($args{attr_value});
 241         return $attr if $mgr->editor->update_acq_lineitem_attr($attr);
 242         return undef;
 243
 244     } else {
 245
 246         $attr = Fieldmapper::acq::lineitem_attr->new;
 247         $attr->$_($args{$_}) for keys %args;
 248
 249         unless($attr->definition) {
 250             my $find = "search_acq_$attr_type";
 251             my $attr_def_id = $mgr->editor->$find({code => $attr->attr_name}, {idlist=>1})->[0] or return 0;
 252             $attr->definition($attr_def_id);
 253         }
 254         return $mgr->editor->create_acq_lineitem_attr($attr);
 255     }
 256 }
 257
 258 # ----------------------------------------------------------------------------
 259 # Picklist
 260 # ----------------------------------------------------------------------------
 261 sub create_picklist {
 262     my($mgr, %args) = @_;
 263     my $picklist = Fieldmapper::acq::picklist->new;
 264     $picklist->creator($mgr->editor->requestor->id);
 265     $picklist->owner($picklist->creator);
 266     $picklist->editor($picklist->creator);
 267     $picklist->create_time('now');
 268     $picklist->edit_time('now');
 269     $picklist->org_unit($mgr->editor->requestor->ws_ou);
 270     $picklist->owner($mgr->editor->requestor->id);
 271     $picklist->$_($args{$_}) for keys %args;
 272     $mgr->picklist($picklist);
 273     return $mgr->editor->create_acq_picklist($picklist);
 274 }
 275
 276 sub update_picklist {
 277     my($mgr, $picklist) = @_;
 278     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 279     $picklist->edit_time('now');
 280     $picklist->editor($mgr->editor->requestor->id);
 281     return $picklist if $mgr->editor->update_acq_picklist($picklist);
 282     return undef;
 283 }
 284
 285 sub delete_picklist {
 286     my($mgr, $picklist) = @_;
 287     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 288
 289     # delete all 'new' lineitems
 290     my $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'});
 291     for my $li (@$lis) {
 292         return 0 unless delete_lineitem($mgr, $li);
 293     }
 294
 295     # detach all non-'new' lineitems
 296     $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}});
 297     for my $li (@$lis) {
 298         $li->clear_picklist;
 299         return 0 unless update_lineitem($li);
 300     }
 301
 302     # remove any picklist-specific object perms
 303     my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => "".$picklist->id});
 304     for my $op (@$ops) {
 305         return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
 306     }
 307
 308     return $mgr->editor->delete_acq_picklist($picklist);
 309 }
 310
 311 # ----------------------------------------------------------------------------
 312 # Purchase Order
 313 # ----------------------------------------------------------------------------
 314 sub update_purchase_order {
 315     my($mgr, $po) = @_;
 316     $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
 317     $po->editor($mgr->editor->requestor->id);
 318     $po->edit_date('now');
 319     return $po if $mgr->editor->update_acq_purchase_order($po);
 320     return undef;
 321 }
 322
 323 sub create_purchase_order {
 324     my($mgr, %args) = @_;
 325     my $po = Fieldmapper::acq::purchase_order->new;
 326     $po->creator($mgr->editor->requestor->id);
 327     $po->editor($mgr->editor->requestor->id);
 328     $po->owner($mgr->editor->requestor->id);
 329     $po->edit_time('now');
 330     $po->create_time('now');
 331     $po->ordering_agency($mgr->editor->requestor->ws_ou);
 332     $po->$_($args{$_}) for keys %args;
 333     $mgr->purchase_order($po);
 334     return $mgr->editor->create_acq_purchase_order($po);
 335 }
 336
 337
 338 # ----------------------------------------------------------------------------
 339 # Bib, Callnumber, and Copy data
 340 # ----------------------------------------------------------------------------
 341
 342 sub create_lineitem_assets {
 343     my($mgr, $li_id) = @_;
 344     my $evt;
 345
 346     my $li = $mgr->editor->retrieve_acq_lineitem([
 347         $li_id,
 348         {   flesh => 1,
 349             flesh_fields => {jub => ['purchase_order', 'attributes']}
 350         }
 351     ]) or return 0;
 352
 353     # -----------------------------------------------------------------
 354     # first, create the bib record if necessary
 355     # -----------------------------------------------------------------
 356     unless($li->eg_bib_id) {
 357         create_bib($mgr, $li) or return 0;
 358     }
 359
 360     my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1});
 361
 362     # -----------------------------------------------------------------
 363     # for each lineitem_detail, create the volume if necessary, create
 364     # a copy, and link them all together.
 365     # -----------------------------------------------------------------
 366     for my $lid_id (@{$li_details}) {
 367
 368         my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0;
 369         my $org = $lid->owning_lib;
 370         my $label = $lid->cn_label;
 371
 372         my $volume = $mgr->cache($org, "cn.$label");
 373         unless($volume) {
 374             $volume = create_volume($mgr, $li, $lid) or return 0;
 375             $mgr->cache($org, "cn.$label", $volume);
 376         }
 377         create_copy($mgr, $volume, $lid) or return 0;
 378     }
 379
 380     return 1;
 381 }
 382
 383 sub create_bib {
 384     my($mgr, $li) = @_;
 385
 386     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 387         $mgr->editor, $li->marc, undef, undef, 1); #$rec->bib_source
 388
 389     if($U->event_code($record)) {
 390         $mgr->editor->event($record);
 391         $mgr->editor->rollback;
 392         return 0;
 393     }
 394
 395     $li->eg_bib_id($record->id);
 396     return update_lineitem($mgr, $li);
 397 }
 398
 399 sub create_volume {
 400     my($mgr, $li, $lid) = @_;
 401
 402     my ($volume, $evt) =
 403         OpenILS::Application::Cat::AssetCommon->find_or_create_volume(
 404             $mgr->editor,
 405             $lid->cn_label,
 406             $li->eg_bib_id,
 407             $lid->owning_lib
 408         );
 409
 410     if($evt) {
 411         $mgr->editor->event($evt);
 412         return 0;
 413     }
 414
 415     return $volume;
 416 }
 417
 418 sub create_copy {
 419     my($mgr, $volume, $lid) = @_;
 420     my $copy = Fieldmapper::asset::copy->new;
 421     $copy->isnew(1);
 422     $copy->loan_duration(2);
 423     $copy->fine_level(2);
 424     $copy->status(OILS_COPY_STATUS_ON_ORDER);
 425     $copy->barcode($lid->barcode);
 426     $copy->location($lid->location);
 427     $copy->call_number($volume->id);
 428     $copy->circ_lib($volume->owning_lib);
 429     $copy->circ_modifier($lid->circ_modifier);
 430
 431     my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy);
 432     if($evt) {
 433         $mgr->editor->event($evt);
 434         return 0;
 435     }
 436
 437     $mgr->add_copy;
 438     $lid->eg_copy_id($copy->id);
 439     $mgr->editor->update_acq_lineitem_detail($lid) or return 0;
 440 }
 441
 442
 443
 444
 445
 446
 447 # ----------------------------------------------------------------------------
 448 # Workflow: Build a selection list from a Z39.50 search
 449 # ----------------------------------------------------------------------------
 450
 451 __PACKAGE__->register_method(
 452         method => 'zsearch',
 453         api_name => 'open-ils.acq.picklist.search.z3950',
 454     stream => 1,
 455         signature => {
 456         desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
 457         params => [
 458             {desc => 'Authentication token', type => 'string'},
 459             {desc => 'Search definition', type => 'object'},
 460             {desc => 'Picklist name, optional', type => 'string'},
 461         ]
 462     }
 463 );
 464
 465 sub zsearch {
 466     my($self, $conn, $auth, $search, $name, $options) = @_;
 467     my $e = new_editor(authtoken=>$auth);
 468     return $e->event unless $e->checkauth;
 469     return $e->event unless $e->allowed('CREATE_PICKLIST');
 470
 471     $search->{limit} ||= 10;
 472     $options ||= {};
 473
 474     my $ses = OpenSRF::AppSession->create('open-ils.search');
 475     my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
 476
 477     my $first = 1;
 478     my $picklist;
 479     my $mgr;
 480     while(my $resp = $req->recv(timeout=>60)) {
 481
 482         if($first) {
 483             my $e = new_editor(requestor=>$e->requestor, xact=>1);
 484             $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn);
 485             $picklist = zsearch_build_pl($mgr, $name);
 486             $first = 0;
 487         }
 488
 489         my $result = $resp->content;
 490         my $count = $result->{count};
 491         $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
 492
 493         for my $rec (@{$result->{records}}) {
 494
 495             my $li = create_lineitem($mgr,
 496                 picklist => $picklist->id,
 497                 source_label => $result->{service},
 498                 marc => $rec->{marcxml},
 499                 eg_bib_id => $rec->{bibid}
 500             );
 501
 502             if($$options{respond_li}) {
 503                 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
 504                     if $$options{flesh_attrs};
 505                 $li->clear_marc if $$options{clear_marc};
 506                 $mgr->respond(lineitem => $li);
 507             } else {
 508                 $mgr->respond;
 509             }
 510         }
 511     }
 512
 513     $mgr->editor->commit;
 514     return $mgr->respond_complete;
 515 }
 516
 517 sub zsearch_build_pl {
 518     my($mgr, $name) = @_;
 519     $name ||= '';
 520
 521     my $picklist = $mgr->editor->search_acq_picklist({
 522         owner => $mgr->editor->requestor->id,
 523         name => $name
 524     })->[0];
 525
 526     if($name eq '' and $picklist) {
 527         return 0 unless delete_picklist($mgr, $picklist);
 528         $picklist = undef;
 529     }
 530
 531     return update_picklist($mgr, $picklist) if $picklist;
 532     return create_picklist($mgr, name => $name);
 533 }
 534
 535
 536 # ----------------------------------------------------------------------------
 537 # Workflow: Build a selection list / PO by importing a batch of MARC records
 538 # ----------------------------------------------------------------------------
 539
 540 __PACKAGE__->register_method(
 541     method => 'upload_records',
 542     api_name => 'open-ils.acq.process_upload_records',
 543     stream => 1,
 544 );
 545
 546 sub upload_records {
 547     my($self, $conn, $auth, $key) = @_;
 548
 549         my $e = new_editor(authtoken => $auth, xact => 1);
 550     return $e->die_event unless $e->checkauth;
 551     my $mgr = OpenILS::Application::Acq::BatchManager->new(
 552         editor => $e, conn => $conn, throttle => 5);
 553
 554     my $cache = OpenSRF::Utils::Cache->new;
 555     my $evt;
 556
 557     my $data = $cache->get_cache("vandelay_import_spool_$key");
 558         my $purpose = $data->{purpose};
 559     my $filename = $data->{path};
 560     my $provider = $data->{provider};
 561     my $picklist = $data->{picklist};
 562     my $create_po = $data->{create_po};
 563     my $ordering_agency = $data->{ordering_agency};
 564     my $po;
 565
 566     unless(-r $filename) {
 567         $logger->error("unable to read MARC file $filename");
 568         $e->rollback;
 569         return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
 570     }
 571
 572     $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
 573
 574     if($picklist) {
 575         $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
 576         if($picklist->owner != $e->requestor->id) {
 577             return $e->die_event unless
 578                 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
 579         }
 580     }
 581
 582     if($create_po) {
 583         $po = create_purchase_order($mgr,
 584             ordering_agency => $ordering_agency,
 585             provider => $provider->id
 586         ) or return $mgr->editor->die_event;
 587     }
 588
 589     $logger->info("acq processing MARC file=$filename");
 590
 591     my $marctype = 'USMARC'; # ?
 592         my $batch = new MARC::Batch ($marctype, $filename);
 593         $batch->strict_off;
 594
 595         my $count = 0;
 596
 597         while(1) {
 598
 599             my $err;
 600         my $xml;
 601                 $count++;
 602         my $r;
 603
 604                 try {
 605             $r = $batch->next;
 606         } catch Error with {
 607             $err = shift;
 608                         $logger->warn("Proccessing of record $count in set $key failed with error $err.  Skipping this record");
 609         };
 610
 611         next if $err;
 612         last unless $r;
 613
 614                 try {
 615             ($xml = $r->as_xml_record()) =~ s/\n//sog;
 616             $xml =~ s/^<\?xml.+\?\s*>//go;
 617             $xml =~ s/>\s+</></go;
 618             $xml =~ s/\p{Cc}//go;
 619             $xml = $U->entityize($xml);
 620             $xml =~ s/[\x00-\x1f]//go;
 621
 622                 } catch Error with {
 623                         $err = shift;
 624                         $logger->warn("Proccessing XML of record $count in set $key failed with error $err.  Skipping this record");
 625                 };
 626
 627         next if $err or not $xml;
 628
 629         my %args = (
 630             source_label => $provider->code,
 631             provider => $provider->id,
 632             marc => $xml,
 633         );
 634
 635         $args{picklist} = $picklist->id if $picklist;
 636         if($po) {
 637             $args{purchase_order} = $po->id;
 638             $args{state} = 'on-order';
 639         }
 640
 641         my $li = create_lineitem($mgr, %args) or return $mgr->editor->die_event;
 642         $mgr->respond;
 643
 644         import_lineitem_details($mgr, $ordering_agency, $li) or return $mgr->editor->die_event;
 645         $mgr->respond;
 646
 647         if($li->purchase_order) {
 648             create_lineitem_assets($mgr, $li->id) or return 0;
 649         }
 650         $mgr->respond;
 651         }
 652
 653         $e->commit;
 654     unlink($filename);
 655     $cache->delete_cache('vandelay_import_spool_' . $key);
 656
 657     return $mgr->respond_complete;
 658 }
 659
 660 sub import_lineitem_details {
 661     my($mgr, $ordering_agency, $li) = @_;
 662
 663     my $holdings = $mgr->editor->json_query({from => ['acq.extract_provider_holding_data', $li->id]});
 664     return 1 unless @$holdings;
 665     my $org_path = $U->get_org_ancestors($ordering_agency);
 666     $org_path = [ reverse (@$org_path) ];
 667     my $price;
 668
 669     my $idx = 1;
 670     while(1) {
 671         my $compiled = extract_lineitem_detail_data($mgr, $org_path, $holdings, $idx);
 672         last unless defined $compiled;
 673         return 0 unless $compiled;
 674
 675         for(1..$$compiled{quantity}) {
 676             create_lineitem_detail($mgr,
 677                 lineitem => $li->id,
 678                 owning_lib => $$compiled{owning_lib},
 679                 cn_label => $$compiled{call_number},
 680                 fund => $$compiled{fund},
 681                 circ_modifier => $$compiled{circ_modifier},
 682                 note => $$compiled{note}
 683             ) or return 0;
 684         }
 685
 686         $mgr->respond;
 687         $idx++;
 688     }
 689
 690     set_lineitem_attr(
 691         $mgr,
 692         attr_name => 'estimated_price',
 693         attr_type => 'lineitem_provider_attr_definition',
 694         attr_value => $price,
 695         lineitem => $li->id
 696     ) or return 0;
 697
 698     return 1;
 699 }
 700
 701 # return hash on success, 0 on error, undef on no more holdings
 702 sub extract_lineitem_detail_data {
 703     my($mgr, $org_path, $holdings, $index) = @_;
 704
 705     my @data_list = grep { $_->{holding} eq $index } @$holdings;
 706     return undef unless @data_list;
 707
 708     my %compiled = map { $_->{attr} => $_->{data} } @data_list;
 709     my $base_org = $$org_path[0];
 710
 711     my $killme = sub {
 712         my $msg = shift;
 713         $logger->error("Item import extraction error: $msg");
 714         $logger->error("Holdings Data: " . OpenSRF::Utils::JSON->perl2JSON(\%compiled));
 715         $mgr->editor->rollback;
 716         $mgr->editor->event(OpenILS::Event->new('ACQ_IMPORT_ERROR', payload => $msg));
 717         return 0;
 718     };
 719
 720     $compiled{quantity} ||= 1;
 721
 722     # ---------------------------------------------------------------------
 723     # Fund
 724     my $code = $compiled{fund_code};
 725     return $killme->("no fund code provided") unless $code;
 726
 727     my $fund = $mgr->cache($base_org, "fund.$code");
 728     unless($fund) {
 729         # search up the org tree for the most appropriate fund
 730         for my $org (@$org_path) {
 731             $fund = $mgr->editor->search_acq_fund(
 732                 {org => $org, code => $code, year => DateTime->now->year}, {idlist => 1})->[0];
 733             last if $fund;
 734         }
 735     }
 736     return $killme->("no fund with code $code at orgs [@$org_path]") unless $fund;
 737     $compiled{fund} = $fund;
 738     $mgr->cache($base_org, "fund.$code", $fund);
 739
 740
 741     # ---------------------------------------------------------------------
 742     # Owning lib
 743     my $sn = $compiled{owning_lib};
 744     return $killme->("no owning_lib defined") unless $sn;
 745     my $org_id =
 746         $mgr->cache($base_org, "orgsn.$sn") ||
 747             $mgr->editor->search_actor_org_unit({shortname => $sn}, {idlist => 1})->[0];
 748     return $killme->("invalid owning_lib defined: $sn") unless $org_id;
 749     $compiled{owning_lib} = $org_id;
 750     $mgr->cache($$org_path[0], "orgsn.$sn", $org_id);
 751
 752
 753     # ---------------------------------------------------------------------
 754     # Circ Modifier
 755     my $mod;
 756     $code = $compiled{circ_modifier};
 757
 758     if($code) {
 759
 760         $mod = $mgr->cache($base_org, "mod.$code") ||
 761             $mgr->editor->retrieve_config_circ_modifier($code);
 762         return $killme->("invlalid circ_modifier $code") unless $mod;
 763         $mgr->cache($base_org, "mod.$code", $mod);
 764
 765     } else {
 766         # try the default
 767         $mod = get_default_circ_modifier($mgr, $base_org)
 768             or return $killme->("no circ_modifier defined");
 769     }
 770
 771     $compiled{circ_modifier} = $mod;
 772
 773
 774     # ---------------------------------------------------------------------
 775     # Shelving Location
 776     my $name = $compiled{copy_location};
 777     return $killme->("no copy_location defined") unless $name;
 778     my $loc = $mgr->cache($base_org, "copy_loc.$name");
 779     unless($loc) {
 780         for my $org (@$org_path) {
 781             $loc = $mgr->editor->search_asset_copy_location(
 782                 {owning_lib => $org, name => $name}, {idlist => 1})->[0];
 783             last if $loc;
 784         }
 785     }
 786     return $killme->("Invalid copy location $name") unless $loc;
 787     $compiled{copy_location} = $loc;
 788     $mgr->cache($base_org, "copy_loc.$name", $loc);
 789
 790     return \%compiled;
 791 }
 792
 793
 794 1;