[open-ils-commits] r12814 - trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq (erickson)
svn at svn.open-ils.org
svn at svn.open-ils.org
Tue Apr 7 14:31:12 EDT 2009
Author: erickson
Date: 2009-04-07 14:31:08 -0400 (Tue, 07 Apr 2009)
New Revision: 12814
Modified:
trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Order.pm
Log:
porting some more functionality over to the common area
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Order.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Order.pm 2009-04-07 16:48:13 UTC (rev 12813)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Application/Acq/Order.pm 2009-04-07 18:31:08 UTC (rev 12814)
@@ -7,6 +7,7 @@
$self->{args} = {
lid => 0,
li => 0,
+ copies => 0,
progress => 0,
debits_accrued => 0,
purchase_order => undef,
@@ -16,18 +17,24 @@
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 @@
$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 @@
# 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 @@
$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 @@
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 @@
# 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 @@
# 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 @@
$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 @@
$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 @@
$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,13 +258,121 @@
$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;
+}
+
+
+
+
+
+
# ----------------------------------------------------------------------------
# Workflow: Build a selection list from a Z39.50 search
# ----------------------------------------------------------------------------
@@ -286,7 +410,7 @@
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 @@
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 @@
}
$mgr->editor->commit;
- $mgr->respond_complete;
- return undef;
+ return $mgr->respond_complete;
}
sub zsearch_build_pl {
my($mgr, $name) = @_;
+ $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+</></go;
+ $xml =~ s/\p{Cc}//go;
+ $xml = $U->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;
More information about the open-ils-commits
mailing list