From 9039298c35f3336f96ca518be4bf86f3e708864d Mon Sep 17 00:00:00 2001 From: erickson Date: Tue, 7 Apr 2009 18:31:08 +0000 Subject: [PATCH] porting some more functionality over to the common area git-svn-id: svn://svn.open-ils.org/ILS/trunk@12814 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- .../src/perlmods/OpenILS/Application/Acq/Order.pm | 384 +++++++++++++++++++-- 1 file changed, 355 insertions(+), 29 deletions(-) diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Order.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/Order.pm index 456bfe6536..9b48cd5176 100644 --- a/Open-ILS/src/perlmods/OpenILS/Application/Acq/Order.pm +++ b/Open-ILS/src/perlmods/OpenILS/Application/Acq/Order.pm @@ -7,6 +7,7 @@ sub new { $self->{args} = { lid => 0, li => 0, + copies => 0, progress => 0, debits_accrued => 0, purchase_order => undef, @@ -16,18 +17,24 @@ sub new { return $self; } +sub conn { + my($self, $val) = @_; + $self->{conn} = $val if $val; + return $self->{conn}; +} sub respond { - my($self, $other_args) = @_; - $self->conn->respond({ %{$self->{args}}, %$other_args }); + my($self, %other_args) = @_; + $self->conn->respond({ %{$self->{args}}, %other_args }); } sub respond_complete { - my($self, $other_args) = @_; + my($self, %other_args) = @_; $self->complete; - $self->conn->respond_complete({ %{$self->{args}}, %$other_args }); + $self->conn->respond_complete({ %{$self->{args}}, %other_args }); + return undef; } sub total { my($self, $val) = @_; - $self->{total} = $val if $val; + $self->{total} = $val if defined $val; return $self->{total}; } sub purchase_order { @@ -52,6 +59,12 @@ sub add_li { $self->{args}->{progress} += 1; return $self; } +sub add_copy { + my $self = shift; + $self->{args}->{copies} += 1; + $self->{args}->{progress} += 1; + return $self; +} sub add_debit { my($self, $amount) = @_; $self->{args}->{debits_accrued} += $amount; @@ -92,7 +105,7 @@ my $U = 'OpenILS::Application::AppUtils'; # Lineitem # ---------------------------------------------------------------------------- sub create_lineitem { - my($mgr, $args) = @_; + my($mgr, %args) = @_; my $li = Fieldmapper::acq::lineitem->new; $li->creator($mgr->editor->requestor->id); $li->selector($li->creator); @@ -100,7 +113,7 @@ sub create_lineitem { $li->create_time('now'); $li->edit_time('now'); $li->state('new'); - $li->$_($$args{$_}) for keys %$args || (); + $li->$_($args{$_}) for keys %args; if($li->picklist) { return 0 unless update_picklist($mgr, $li->picklist); } @@ -112,7 +125,8 @@ sub update_lineitem { my($mgr, $li) = @_; $li->edit_time('now'); $li->editor($mgr->editor->requestor->id); - return $mgr->editor->update_acq_lineitem($li); + return $li if $mgr->editor->update_acq_lineitem($li); + return undef; } sub delete_lineitem { @@ -140,9 +154,9 @@ sub delete_lineitem { # Lineitem Detail # ---------------------------------------------------------------------------- sub create_lineitem_detail { - my($mgr, $args) = @_; + my($mgr, %args) = @_; my $lid = Fieldmapper::acq::lineitem_detail->new; - $lid->$_($$args{$_}) for keys %$args || (); + $lid->$_($args{$_}) for keys %args; # create some default values unless($lid->barcode) { @@ -174,7 +188,7 @@ sub delete_lineitem_detail { # Picklist # ---------------------------------------------------------------------------- sub create_picklist { - my($mgr, $args) = @_; + my($mgr, %args) = @_; my $picklist = Fieldmapper::acq::picklist->new; $picklist->creator($mgr->editor->requestor->id); $picklist->owner($picklist->creator); @@ -183,7 +197,7 @@ sub create_picklist { $picklist->edit_time('now'); $picklist->org_unit($mgr->editor->requestor->ws_ou); $picklist->owner($mgr->editor->requestor->id); - $picklist->$_($$args{$_}) for keys %$args || (); + $picklist->$_($args{$_}) for keys %args; $mgr->picklist($picklist); return $mgr->editor->create_acq_picklist($picklist); } @@ -193,7 +207,8 @@ sub update_picklist { $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist; $picklist->edit_time('now'); $picklist->editor($mgr->editor->requestor->id); - return $mgr->editor->update_acq_picklist($picklist); + return $picklist if $mgr->editor->update_acq_picklist($picklist); + return undef; } sub delete_picklist { @@ -230,11 +245,12 @@ sub update_purchase_order { $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po; $po->editor($mgr->editor->requestor->id); $po->edit_date('now'); - return $mgr->editor->update_acq_purchase_order($po); + return $po if $mgr->editor->update_acq_purchase_order($po); + return undef; } sub create_purchase_order { - my($mgr, $args) = @_; + my($mgr, %args) = @_; my $po = Fieldmapper::acq::purchase_order->new; $po->creator($mgr->editor->requestor->id); $po->editor($mgr->editor->requestor->id); @@ -242,11 +258,119 @@ sub create_purchase_order { $po->edit_time('now'); $po->create_time('now'); $po->ordering_agency($mgr->editor->requestor->ws_ou); - $po->$_($$args{$_}) for keys %$args || (); + $po->$_($args{$_}) for keys %args; return $mgr->editor->create_acq_purchase_order($po); } +# ---------------------------------------------------------------------------- +# Bib, Callnumber, and Copy data +# ---------------------------------------------------------------------------- + +sub create_lineitem_assets { + my($mgr, $li_id) = @_; + my $evt; + + my $li = $mgr->editor->retrieve_acq_lineitem([ + $li_id, + { flesh => 1, + flesh_fields => {jub => ['purchase_order', 'attributes']} + } + ]) or return 0; + + # ----------------------------------------------------------------- + # first, create the bib record if necessary + # ----------------------------------------------------------------- + unless($li->eg_bib_id) { + create_bib($mgr, $li) or return 0; + } + + my $li_details = $mgr->editor->search_acq_lineitem_detail({lineitem => $li_id}, {idlist=>1}); + + # ----------------------------------------------------------------- + # for each lineitem_detail, create the volume if necessary, create + # a copy, and link them all together. + # ----------------------------------------------------------------- + my %cache; + for my $lid_id (@{$li_details}) { + + my $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid_id) or return 0; + my $org = $lid->owning_lib; + my $label = $lid->cn_label; + + $cache{$org} = {} unless $cache{$org}; + my $volume = $cache{$org}{$label}; + unless($volume) { + $volume = $cache{$org}{$label} = create_volume($li, $lid) or return 0; + } + create_copy($mgr, $volume, $lid) or return 0; + } + + return 1; +} + +sub create_bib { + my($mgr, $li) = @_; + + my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import( + $mgr->editor, $li->marc, undef, undef, undef, 1); #$rec->bib_source + + if($U->event_code($record)) { + $mgr->editor->event($record); + $mgr->editor->rollback; + return 0; + } + + $li->eg_bib_id($record->id); + return update_lineitem($mgr, $li); +} + +sub create_volume { + my($mgr, $li, $lid) = @_; + + my ($volume, $evt) = + OpenILS::Application::Cat::AssetCommon->find_or_create_volume( + $mgr->editor, + $lid->cn_label, + $li->eg_bib_id, + $lid->owning_lib + ); + + if($evt) { + $mgr->editor->event($evt); + return 0; + } + + return $volume; +} + +sub create_copy { + my($mgr, $volume, $lid) = @_; + my $copy = Fieldmapper::asset::copy->new; + $copy->isnew(1); + $copy->loan_duration(2); + $copy->fine_level(2); + $copy->status(OILS_COPY_STATUS_ON_ORDER); + $copy->barcode($lid->barcode); + $copy->location($lid->location); + $copy->call_number($volume->id); + $copy->circ_lib($volume->owning_lib); + $copy->circ_modifier('book'); # XXX + + my $evt = OpenILS::Application::Cat::AssetCommon->create_copy($mgr->editor, $volume, $copy); + if($evt) { + $mgr->editor->event($evt); + return 0; + } + + $mgr->add_copy; + $lid->eg_copy_id($copy->id); + $mgr->editor->update_acq_lineitem_detail($lid) or return 0; +} + + + + # ---------------------------------------------------------------------------- @@ -286,7 +410,7 @@ sub zsearch { if($first) { my $e = new_editor(requestor=>$e->requestor, xact=>1); - $mgr = OpenILS::Application::Acq::BatchManager->new({editor => $e, conn => $conn}); + $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); $picklist = zsearch_build_pl($mgr, $name); $first = 0; } @@ -297,18 +421,18 @@ sub zsearch { for my $rec (@{$result->{records}}) { - my $li = create_lineitem($mgr, { - picklist => $picklist->{id}, + my $li = create_lineitem($mgr, + picklist => $picklist->id, source_label => $result->{service}, marc => $rec->{marcxml}, eg_bib_id => $rec->{bibid} - }); + ); if($$options{respond_li}) { $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id})) if $$options{flesh_attrs}; $li->clear_marc if $$options{clear_marc}; - $mgr->respond({lineitem => $li}); + $mgr->respond(lineitem => $li); } else { $mgr->respond; } @@ -316,26 +440,228 @@ sub zsearch { } $mgr->editor->commit; - $mgr->respond_complete; - return undef; + return $mgr->respond_complete; } sub zsearch_build_pl { my($mgr, $name) = @_; - $name ||= ''; - my $picklist = $mgr->editor->search_acq_picklist({owner=>$mgr->editor->requestor->id, name=>$name})->[0]; + + my $picklist = $mgr->editor->search_acq_picklist({ + owner => $mgr->editor->requestor->id, + name => $name + })->[0]; + if($name eq '' and $picklist) { return 0 unless delete_picklist($mgr, $picklist); $picklist = undef; } + return update_picklist($mgr, $picklist) if $picklist; + return create_picklist($mgr, name => $name); +} + + +# ---------------------------------------------------------------------------- +# Workflow: Build a selection list / PO by importing a batch of MARC records +# ---------------------------------------------------------------------------- + +__PACKAGE__->register_method( + method => 'upload_records', + api_name => 'open-ils.acq.process_upload_records', + stream => 1, +); + +my %fund_code_map; +sub upload_records { + my($self, $conn, $auth, $key) = @_; + + my $e = new_editor(authtoken => $auth, xact => 1); + return $e->die_event unless $e->checkauth; + my $mgr = OpenILS::Application::Acq::BatchManager->new(editor => $e, conn => $conn); + + my $cache = OpenSRF::Utils::Cache->new; + my $evt; + + my $data = $cache->get_cache("vandelay_import_spool_$key"); + my $purpose = $data->{purpose}; + my $filename = $data->{path}; + my $provider = $data->{provider}; + my $picklist = $data->{picklist}; + my $create_po = $data->{create_po}; + my $ordering_agency = $data->{ordering_agency}; + my $purchase_order; + + unless(-r $filename) { + $logger->error("unable to read MARC file $filename"); + $e->rollback; + return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename}); + } + + $provider = $e->retrieve_acq_provider($provider) or return $e->die_event; + if($picklist) { - update_picklist($mgr, $picklist) or return 0; - return $picklist; - } + $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event; + if($picklist->owner != $e->requestor->id) { + return $e->die_event unless + $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist); + } + } - return create_picklist($mgr, {name => $name}); + if($create_po) { + $purchase_order = Fieldmapper::acq::purchase_order->new; + $purchase_order->provider($provider->id); + $purchase_order->ordering_agency($ordering_agency); + $evt = OpenILS::Application::Acq::Financials::create_purchase_order_impl($e, $purchase_order); + return $evt if $evt; + } + + $logger->info("acq processing MARC file=$filename"); + + my $marctype = 'USMARC'; # ? + my $batch = new MARC::Batch ($marctype, $filename); + $batch->strict_off; + + my $count = 0; + + while(1) { + + my $r; + $logger->info("processing record $count"); + + try { + $r = $batch->next + } catch Error with { $r = -1; }; + + last unless $r; + + if($r == -1) { + $logger->warn("Proccessing of record $count in set $key failed. Skipping this record"); + $count++; + next; + } + + try { + + (my $xml = $r->as_xml_record()) =~ s/\n//sog; + $xml =~ s/^<\?xml.+\?\s*>//go; + $xml =~ s/>\s+entityize($xml); + $xml =~ s/[\x00-\x1f]//go; + + my $li = Fieldmapper::acq::lineitem->new; + $li->picklist($picklist->id) if $picklist; + $li->purchase_order($purchase_order->id) if $purchase_order; + $li->source_label($provider->code); # XXX ?? + $li->provider($provider->id); + $li->selector($e->requestor->id); + $li->creator($e->requestor->id); + $li->editor($e->requestor->id); + $li->edit_time('now'); + $li->create_time('now'); + $li->marc($xml); + $li->state('on-order') if $purchase_order; + $e->create_acq_lineitem($li) or die $e->die_event; + + $conn->respond({count => $count}) if (++$count % 5) == 0; + + $evt = create_lineitem_details($conn, \$count, $e, $ordering_agency, $li, $purchase_order); + die $evt if $evt; # caught below + + } catch Error with { + my $error = shift; + $logger->warn("Encountered a bad record at Vandelay ingest: ".$error); + } + } + + $e->commit; + unlink($filename); + $cache->delete_cache('vandelay_import_spool_' . $key); + + # clear the cached funds + delete $fund_code_map{$_} for keys %fund_code_map; + + return { + complete => 1, + purchase_order => $purchase_order, + picklist => $picklist + }; } +sub create_lineitem_details { + my($conn, $countref, $e, $ordering_agency, $li, $purchase_order) = @_; + + my $holdings = $e->json_query({from => ['acq.extract_provider_holding_data', $li->id]}); + return undef unless @$holdings; + my $org_path = $U->get_org_ancestors($ordering_agency); + + my $idx = 1; + while(1) { + my $compiled = extract_lineitem_detail_data($e, $org_path, $holdings, $idx); + last unless $compiled; + + for(1..$$compiled{quantity}) { + my $lid = Fieldmapper::acq::lineitem_detail->new; + $lid->lineitem($li->id); + $lid->owning_lib($$compiled{owning_lib}); + $lid->cn_label($$compiled{call_number}); + $lid->fund($$compiled{fund}); + + if($purchase_order) { + } + + } + + $idx++; + } + return undef; +} + +sub extract_lineitem_detail_data { + my($e, $org_path, $holdings, $holding_index) = @_; + + my @data_list = { grep { $_->holding eq $holding_index } @$holdings }; + my %compiled = map { $_->{attr} => $_->{data} } @data_list; + my $err_evt = OpenILS::Event->new('ACQ_IMPORT_ERROR'); + + $compiled{quantity} ||= 1; + + # ---------------------------------------------------- + # find the fund + if(my $code = $compiled{fund_code}) { + + my $fund = $fund_code_map{$code}; + unless($fund) { + # search up the org tree for the most appropriate fund + for my $org (@$org_path) { + $fund = $e->search_acq_fund({org => $org, code => $code, year => DateTime->now->year})->[0]; + last if $fund; + } + unless($fund) { + $logger->error("Import error: there is no fund with code $code at orgs $org_path"); + $e->rollback; + return $err_evt; + } + } + $compiled{fund} = $fund->id; + $fund_code_map{$code} = $fund; + + } else { + # XXX perhaps a default fund? + $logger->error("Import error: no fund code provided"); + $e->rollback; + return $err_evt; + } + + $compiled{owning_lib} = $e->search_actor_org_unit({shortname => $compiled{owning_lib}})->[0] + or return $e->die_event; + + # ---------------------------------------------------- + # find the collection code + + return \%compiled; +} + + 1; -- 2.11.0