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