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

   1 package OpenILS::Application::Acq::Picklist;
   2 use base qw/OpenILS::Application/;
   3 use strict; use warnings;
   4
   5 use OpenSRF::EX q/:try/;
   6 use OpenSRF::Utils::Logger qw(:logger);
   7 use OpenILS::Utils::Fieldmapper;
   8 use OpenILS::Utils::CStoreEditor q/:funcs/;
   9 use OpenILS::Const qw/:const/;
  10 use OpenSRF::Utils::SettingsClient;
  11 use OpenILS::Event;
  12 use OpenILS::Application::AppUtils;
  13 use OpenSRF::Utils::Cache;
  14 use MARC::Record;
  15 use MARC::Batch;
  16 use MARC::File::XML;
  17 use MIME::Base64;
  18 use Digest::MD5 qw/md5_hex/;
  19
  20 my $U = 'OpenILS::Application::AppUtils';
  21
  22
  23 __PACKAGE__->register_method(
  24         method => 'create_picklist',
  25         api_name        => 'open-ils.acq.picklist.create',
  26         signature => {
  27         desc => 'Creates a new picklist',
  28         params => [
  29             {desc => 'Authentication token', type => 'string'},
  30             {desc => 'Picklist object to create', type => 'object'}
  31         ],
  32         return => {desc => 'The ID of the new picklist'}
  33     }
  34 );
  35
  36 sub create_picklist {
  37     my($self, $conn, $auth, $picklist) = @_;
  38     my $e = new_editor(xact=>1, authtoken=>$auth);
  39     return $e->die_event unless $e->checkauth;
  40     $picklist->creator($e->requestor->id);
  41     $picklist->editor($e->requestor->id);
  42     $picklist->org_unit($e->requestor->ws_ou) unless $picklist->org_unit;
  43     return $e->die_event unless $e->allowed('CREATE_PICKLIST', $picklist->org_unit);
  44     return OpenILS::Event->new('BAD_PARAMS')
  45         unless $e->requestor->id == $picklist->owner;
  46     $e->create_acq_picklist($picklist) or return $e->die_event;
  47     $e->commit;
  48     return $picklist->id;
  49 }
  50
  51
  52 __PACKAGE__->register_method(
  53         method => 'update_picklist',
  54         api_name        => 'open-ils.acq.picklist.update',
  55         signature => {
  56         desc => 'Updates a new picklist',
  57         params => [
  58             {desc => 'Authentication token', type => 'string'},
  59             {desc => 'Picklist object to update', type => 'object'}
  60         ],
  61         return => {desc => '1 on success, Event on error'}
  62     }
  63 );
  64
  65 sub update_picklist {
  66     my($self, $conn, $auth, $picklist) = @_;
  67     my $e = new_editor(xact=>1, authtoken=>$auth);
  68     return $e->die_event unless $e->checkauth;
  69
  70     # don't let them change the owner
  71     my $o_picklist = $e->retrieve_acq_picklist($picklist->id)
  72         or return $e->die_event;
  73     if($o_picklist->owner != $e->requestor->id) {
  74         return $e->die_event unless
  75             $e->allowed('UPDATE_PICKLIST', $o_picklist->org_unit);
  76     }
  77     return OpenILS::Event->new('BAD_PARAMS') unless $o_picklist->org_unit == $picklist->org_unit;
  78
  79     $picklist->edit_time('now');
  80     $picklist->editor($e->requestor->id);
  81     $e->update_acq_picklist($picklist) or return $e->die_event;
  82     $e->commit;
  83     return 1;
  84 }
  85
  86 __PACKAGE__->register_method(
  87         method => 'retrieve_picklist',
  88         api_name        => 'open-ils.acq.picklist.retrieve',
  89         signature => {
  90         desc => 'Retrieves a picklist',
  91         params => [
  92             {desc => 'Authentication token', type => 'string'},
  93             {desc => 'Picklist ID to retrieve', type => 'number'},
  94             {desc => 'Options hash, including "flesh_lineitem_count" to get the count of attached entries', type => 'hash'},
  95         ],
  96         return => {desc => 'Picklist object on success, Event on error'}
  97     }
  98 );
  99
 100 sub retrieve_picklist {
 101     my($self, $conn, $auth, $picklist_id, $options) = @_;
 102     my $e = new_editor(authtoken=>$auth);
 103     return $e->event unless $e->checkauth;
 104
 105     my $picklist = $e->retrieve_acq_picklist($picklist_id)
 106         or return $e->event;
 107
 108     $picklist->entry_count(retrieve_lineitem_count($e, $picklist_id))
 109         if $$options{flesh_lineitem_count};
 110
 111     if($e->requestor->id != $picklist->owner) {
 112         return $e->event unless
 113             $e->allowed('VIEW_PICKLIST', $picklist->org_unit, $picklist);
 114     }
 115
 116     $picklist->owner($e->retrieve_actor_user($picklist->owner))
 117         if($$options{flesh_owner});
 118     $picklist->owner($e->retrieve_actor_user($picklist->owner)->usrname)
 119         if($$options{flesh_username});
 120
 121     return $picklist;
 122 }
 123
 124
 125 # Returns the number of entries associated with this picklist
 126 sub retrieve_lineitem_count {
 127     my($e, $picklist_id) = @_;
 128     my $count = $e->json_query({
 129         select => {
 130             jub => [{transform => 'count', column => 'id', alias => 'count'}]
 131         },
 132         from => 'jub',
 133         where => {picklist => $picklist_id}}
 134     );
 135     return $count->[0]->{count};
 136 }
 137
 138
 139
 140 __PACKAGE__->register_method(
 141         method => 'retrieve_picklist_name',
 142         api_name        => 'open-ils.acq.picklist.name.retrieve',
 143         signature => {
 144         desc => 'Retrieves a picklist by name.  Owner is implied by the caller',
 145         params => [
 146             {desc => 'Authentication token', type => 'string'},
 147             {desc => 'Picklist name to retrieve', type => 'strin'},
 148         ],
 149         return => {desc => 'Picklist object on success, null on not found'}
 150     }
 151 );
 152
 153 sub retrieve_picklist_name {
 154     my($self, $conn, $auth, $name) = @_;
 155     my $e = new_editor(authtoken=>$auth);
 156     return $e->event unless $e->checkauth;
 157     my $picklist = $e->search_acq_picklist(
 158         {name => $name, owner => $e->requestor->id})->[0];
 159     if($e->requestor->id != $picklist->owner) {
 160         return $e->event unless
 161             $e->allowed('VIEW_PICKLIST', $picklist->org_unit, $picklist);
 162     }
 163     return $picklist;
 164 }
 165
 166
 167
 168 __PACKAGE__->register_method(
 169         method => 'retrieve_user_picklist',
 170         api_name        => 'open-ils.acq.picklist.user.retrieve',
 171     stream => 1,
 172         signature => {
 173         desc => 'Retrieves a  user\'s picklists',
 174         params => [
 175             {desc => 'Authentication token', type => 'string'},
 176             {desc => 'Options, including "idlist", whch forces the return
 177                 of a list of IDs instead of objects', type => 'hash'},
 178         ],
 179         return => {desc => 'Picklist object on success, Event on error'}
 180     }
 181 );
 182
 183 sub retrieve_user_picklist {
 184     my($self, $conn, $auth, $options) = @_;
 185     my $e = new_editor(authtoken=>$auth);
 186     return $e->die_event unless $e->checkauth;
 187
 188     # don't grab the PL with name == "", because that is the designated temporary picklist
 189     my $list = $e->search_acq_picklist([
 190             {owner=>$e->requestor->id, name=>{'!='=>''}},
 191             {order_by => {acqpl => 'name'}}
 192         ],
 193         {idlist=>1}
 194     );
 195
 196     for my $id (@$list) {
 197         if($$options{idlist}) {
 198             $conn->respond($id);
 199         } else {
 200             my $pl = $e->retrieve_acq_picklist($id);
 201             $pl->entry_count(retrieve_lineitem_count($e, $id)) if $$options{flesh_lineitem_count};
 202             $pl->owner($e->retrieve_actor_user($pl->owner)) if $$options{flesh_owner};
 203             $pl->owner($e->retrieve_actor_user($pl->owner)->usrname) if $$options{flesh_username};
 204             $conn->respond($pl);
 205         }
 206     }
 207
 208     return undef;
 209 }
 210
 211
 212 __PACKAGE__->register_method(
 213         method => 'retrieve_all_user_picklist',
 214         api_name        => 'open-ils.acq.picklist.user.all.retrieve',
 215     stream => 1,
 216         signature => {
 217         desc => 'Retrieves all of the picklists a user is allowed to see',
 218         params => [
 219             {desc => 'Authentication token', type => 'string'},
 220             {desc => 'Options, including "idlist", whch forces the return
 221                 of a list of IDs instead of objects', type => 'hash'},
 222         ],
 223         return => {desc => 'Picklist objects on success, Event on error'}
 224     }
 225 );
 226
 227 sub retrieve_all_user_picklist {
 228     my($self, $conn, $auth, $options) = @_;
 229     my $e = new_editor(authtoken=>$auth);
 230     return $e->event unless $e->checkauth;
 231
 232     my $my_list = $e->search_acq_picklist(
 233         {owner=>$e->requestor->id, name=>{'!='=>''}}, {idlist=>1});
 234
 235     my $picklist_ids = $e->objects_allowed('VIEW_PICKLIST', 'acqpl');
 236     my $p_orgs = $U->user_has_work_perm_at($e, 'VIEW_PICKLIST', {descendants =>1});
 237     my $picklist_ids_2 = $e->search_acq_picklist(
 238         {name=>{'!='=>''}, org_unit => $p_orgs}, {idlist=>1});
 239
 240     return undef unless @$my_list or @$picklist_ids or @$picklist_ids_2;
 241
 242     my @list = (@$my_list, @$picklist_ids, @$picklist_ids_2);
 243     my %dedup;
 244     $dedup{$_} = 1 for @list;
 245     @list = keys %dedup;
 246
 247     return \@list if $$options{idlist};
 248
 249     for my $pl (@list) {
 250         my $picklist = $e->retrieve_acq_picklist($pl) or return $e->event;
 251         $picklist->entry_count(retrieve_lineitem_count($e, $picklist->id))
 252             if($$options{flesh_lineitem_count});
 253         $picklist->owner($e->retrieve_actor_user($picklist->owner))
 254             if $$options{flesh_owner};
 255         $picklist->owner($e->retrieve_actor_user($picklist->owner)->usrname)
 256             if $$options{flesh_username};
 257         $conn->respond($picklist);
 258     }
 259
 260     return undef;
 261 }
 262
 263
 264 __PACKAGE__->register_method(
 265         method => 'delete_picklist',
 266         api_name        => 'open-ils.acq.picklist.delete',
 267         signature => {
 268         desc => q/Deletes a picklist.  It also deletes any lineitems in the "new" state.
 269             Other attached lineitems are detached'/,
 270         params => [
 271             {desc => 'Authentication token', type => 'string'},
 272             {desc => 'Picklist ID to delete', type => 'number'}
 273         ],
 274         return => {desc => '1 on success, Event on error'}
 275     }
 276 );
 277
 278 sub delete_picklist {
 279     my($self, $conn, $auth, $picklist_id) = @_;
 280     my $e = new_editor(xact=>1, authtoken=>$auth);
 281     return $e->die_event unless $e->checkauth;
 282
 283     my $picklist = $e->retrieve_acq_picklist($picklist_id)
 284         or return $e->die_event;
 285     # don't let anyone delete someone else's picklist
 286     if($picklist->owner != $e->requestor->id) {
 287         return $e->die_event unless
 288             $e->allowed('DELETE_PICKLIST', $picklist->org_unit, $picklist);
 289     }
 290
 291     # delete all 'new' lineitems
 292     my $lis = $e->search_acq_lineitem({picklist => $picklist->id, state => 'new'});
 293     for my $li (@$lis) {
 294         $e->delete_acq_lineitem($li) or return $e->die_event;
 295     }
 296
 297     # detach all non-'new' lineitems
 298     $lis = $e->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}});
 299     for my $li (@$lis) {
 300         $li->clear_picklist;
 301         $e->update_acq_lineitem($li) or return $e->die_event;
 302     }
 303
 304     # remove any picklist-specific object perms
 305     my $ops = $e->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => "".$picklist->id});
 306     for my $op (@$ops) {
 307         $e->delete_usr_object_perm_map($op) or return $e->die_event;
 308     }
 309
 310
 311     $e->delete_acq_picklist($picklist) or return $e->die_event;
 312     $e->commit;
 313     return 1;
 314 }
 315
 316 __PACKAGE__->register_method(
 317         method => 'retrieve_pl_lineitem',
 318         api_name        => 'open-ils.acq.lineitem.picklist.retrieve',
 319     stream => 1,
 320         signature => {
 321         desc => 'Retrieves lineitem objects according to picklist',
 322         params => [
 323             {desc => 'Authentication token', type => 'string'},
 324             {desc => 'Picklist ID whose entries to retrieve', type => 'number'},
 325             {desc => q/Options, including
 326                 "sort_attr", which defines the attribute to sort on;
 327                 "sort_attr_type", which defines the attribute type sort on;
 328                 "sort_dir", which defines the sort order between "asc" and "desc";
 329                 "limit", retrieval limit;
 330                 "offset", retrieval offset;
 331                 "idlist", return a list of IDs instead of objects
 332                 "flesh_attrs", additionaly return the list of flattened attributes
 333                 "clear_marc", discards the raw MARC data to reduce data size
 334                 /,
 335                 type => 'hash'}
 336         ],
 337         return => {desc => 'Array of lineitem objects or IDs,  on success, Event on error'}
 338     }
 339 );
 340
 341
 342 my $PL_ENTRY_JSON_QUERY = {
 343     select => {jub => ["id"], "acqlia" => ["attr_value"]},
 344     "from" => {
 345         "jub" => {
 346             "acqlia" => {
 347                 "fkey" => "id",
 348                 "field" => "lineitem",
 349                 "type" => "left",
 350                 "filter" => {
 351                     "attr_type" => "lineitem_marc_attr_definition",
 352                     "attr_name" => "author"
 353                 }
 354             }
 355         }
 356     },
 357     "order_by" => {"acqlia" => {"attr_value" => {"direction"=>"asc"}}},
 358     "limit" => 10,
 359     "where" => {"+jub" => {"picklist"=>2}},
 360     "offset" => 0
 361 };
 362
 363 sub retrieve_pl_lineitem {
 364     my($self, $conn, $auth, $picklist_id, $options) = @_;
 365     my $e = new_editor(authtoken=>$auth);
 366     return $e->event unless $e->checkauth;
 367
 368     # collect the retrieval options
 369     my $sort_attr = $$options{sort_attr} || 'title';
 370     my $sort_attr_type = $$options{sort_attr_type} || 'lineitem_marc_attr_definition';
 371     my $sort_dir = $$options{sort_dir} || 'asc';
 372     my $limit = $$options{limit} || 10;
 373     my $offset = $$options{offset} || 0;
 374
 375     $PL_ENTRY_JSON_QUERY->{where}->{'+jub'}->{picklist} = $picklist_id;
 376     $PL_ENTRY_JSON_QUERY->{from}->{jub}->{acqlia}->{filter}->{attr_name} = $sort_attr;
 377     $PL_ENTRY_JSON_QUERY->{from}->{jub}->{acqlia}->{filter}->{attr_type} = $sort_attr_type;
 378     $PL_ENTRY_JSON_QUERY->{order_by}->{acqlia}->{attr_value}->{direction} = $sort_dir;
 379     $PL_ENTRY_JSON_QUERY->{limit} = $limit;
 380     $PL_ENTRY_JSON_QUERY->{offset} = $offset;
 381
 382     my $entries = $e->json_query($PL_ENTRY_JSON_QUERY);
 383
 384     my @ids;
 385     push(@ids, $_->{id}) for @$entries;
 386
 387     for my $id (@ids) {
 388         if($$options{idlist}) {
 389             $conn->respond($id);
 390             next;
 391         }
 392
 393         my $entry;
 394         my $flesh = ($$options{flesh_attrs}) ?
 395             {flesh => 1, flesh_fields => {jub => ['attributes']}} : {};
 396
 397         $entry = $e->retrieve_acq_lineitem([$id, $flesh]);
 398         my $details = $e->search_acq_lineitem_detail({lineitem => $id}, {idlist=>1});
 399         $entry->item_count(scalar(@$details));
 400         $entry->clear_marc if $$options{clear_marc};
 401         $conn->respond($entry);
 402     }
 403
 404     return undef;
 405 }
 406
 407 =head comment
 408 request open-ils.cstore open-ils.cstore.json_query.atomic {"select":{"jub":[{"transform":"count", "attregate":1, "column":"id","alias":"count"}]}, "from":"jub","where":{"picklist":1}}
 409 =cut
 410
 411 __PACKAGE__->register_method(
 412         method => 'zsearch',
 413         api_name => 'open-ils.acq.picklist.search.z3950',
 414     stream => 1,
 415         signature => {
 416         desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
 417         params => [
 418             {desc => 'Authentication token', type => 'string'},
 419             {desc => 'Search definition', type => 'object'},
 420             {desc => 'Picklist name, optional', type => 'string'},
 421         ]
 422     }
 423 );
 424
 425 sub zsearch {
 426     my($self, $conn, $auth, $search, $name, $options) = @_;
 427     my $e = new_editor(authtoken=>$auth);
 428     return $e->event unless $e->checkauth;
 429     return $e->event unless $e->allowed('CREATE_PICKLIST');
 430
 431     $search->{limit} ||= 10;
 432     $options ||= {};
 433
 434     my $ses = OpenSRF::AppSession->create('open-ils.search');
 435     my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
 436
 437     my $first = 1;
 438     my $picklist;
 439     while(my $resp = $req->recv(timeout=>60)) {
 440
 441         if($first) {
 442             $e = new_editor(requestor=>$e->requestor, xact=>1);
 443             $picklist = zsearch_build_pl($self, $conn, $auth, $e, $name);
 444             $first = 0;
 445         }
 446
 447         my $result = $resp->content;
 448         my $count = $result->{count};
 449         my $total = (($count < $search->{limit}) ? $count : $search->{limit})+1;
 450         my $ctr = 0;
 451         $conn->respond({total=>$total, progress=>++$ctr});
 452
 453         for my $rec (@{$result->{records}}) {
 454             my $li = Fieldmapper::acq::lineitem->new;
 455             $li->picklist($picklist->id);
 456             $li->source_label($result->{service});
 457             $li->selector($e->requestor->id);
 458             $li->creator($e->requestor->id);
 459             $li->editor($e->requestor->id);
 460             $li->edit_time('now');
 461             $li->create_time('now');
 462             $li->marc($rec->{marcxml});
 463             $li->state('new');
 464             $li->eg_bib_id($rec->{bibid}) if $rec->{bibid};
 465             $e->create_acq_lineitem($li) or return $e->die_event;
 466
 467             my $response = {total => $total, progress => ++$ctr};
 468
 469             if($$options{respond_li}) {
 470                 $response->{lineitem} = $li;
 471                 $li->attributes($e->search_acq_lineitem_attr({lineitem => $li->id}))
 472                     if $$options{flesh_attrs};
 473                 $li->clear_marc if $$options{clear_marc};
 474             }
 475
 476             $conn->respond($response);
 477         }
 478     }
 479
 480     $e->commit;
 481     return {complete=>1, picklist_id=>$picklist->id};
 482 }
 483
 484 sub zsearch_build_pl {
 485     my($self, $conn, $auth, $e, $name) = @_;
 486
 487     $name ||= '';
 488     my $picklist = $e->search_acq_picklist({owner=>$e->requestor->id, name=>$name})->[0];
 489     if($name eq '' and $picklist) {
 490         my $evt = delete_picklist($self, $conn, $auth, $picklist->id);
 491         return $evt unless $evt == 1;
 492         $picklist = undef;
 493     }
 494
 495     unless($picklist) {
 496         $picklist = Fieldmapper::acq::picklist->new;
 497         $picklist->owner($e->requestor->id);
 498         $picklist->creator($e->requestor->id);
 499         $picklist->editor($e->requestor->id);
 500         $picklist->edit_time('now');
 501         $picklist->name($name);
 502         $picklist->org_unit($e->requestor->ws_ou);
 503         $e->create_acq_picklist($picklist) or return $e->die_event;
 504
 505     } else {
 506         $picklist->editor($e->requestor->id);
 507         $picklist->edit_time('now');
 508         $e->update_acq_picklist($picklist) or return $e->die_event;
 509     }
 510
 511     return $picklist;
 512 }
 513
 514
 515
 516 __PACKAGE__->register_method(
 517         method => 'ranged_distrib_formulas',
 518         api_name        => 'open-ils.acq.distribution_formula.ranged.retrieve',
 519     stream => 1,
 520         signature => {
 521         desc => 'Ranged distribution formulas, fleshed with entries',
 522         params => [
 523             {desc => 'Authentication token', type => 'string'},
 524         ],
 525         return => {desc => 'List of distribution formulas'}
 526     }
 527 );
 528
 529 sub ranged_distrib_formulas {
 530     my($self, $conn, $auth) = @_;
 531     my $e = new_editor(authtoken=>$auth);
 532     return $e->event unless $e->checkauth;
 533     my $orgs = $U->user_has_work_perm_at($e, 'CREATE_PICKLIST', {descendants =>1});
 534     my $forms = $e->search_acq_distribution_formula([
 535         {owner => $orgs},
 536         {flesh => 1, flesh_fields => {acqdf => ['entries']}}
 537     ]);
 538     $conn->respond($_) for @$forms;
 539     return undef;
 540 }
 541
 542 __PACKAGE__->register_method(
 543     method => 'upload_records',
 544     api_name => 'open-ils.acq.process_upload_records',
 545     stream => 1,
 546 );
 547
 548 sub upload_records {
 549     my($self, $conn, $auth, $key) = @_;
 550         my $e = new_editor(authtoken => $auth, xact => 1);
 551     return $e->die_event unless $e->checkauth;
 552     my $cache = OpenSRF::Utils::Cache->new;
 553
 554     my $data = $cache->get_cache("vandelay_import_spool_$key");
 555         my $purpose = $data->{purpose};
 556     my $filename = $data->{path};
 557     my $provider = $data->{provider};
 558     my $picklist = $data->{picklist};
 559     my $create_po = $data->{create_po};
 560     my $ordering_agency = $data->{ordering_agency};
 561     my $purchase_order;
 562
 563     unless(-r $filename) {
 564         $logger->error("unable to read MARC file $filename");
 565         $e->rollback;
 566         return OpenILS::Event->new('FILE_UPLOAD_ERROR', payload => {filename => $filename});
 567     }
 568
 569     $provider = $e->retrieve_acq_provider($provider) or return $e->die_event;
 570
 571     if($picklist) {
 572         $picklist = $e->retrieve_acq_picklist($picklist) or return $e->die_event;
 573         if($picklist->owner != $e->requestor->id) {
 574             return $e->die_event unless
 575                 $e->allowed('CREATE_PICKLIST', $picklist->org_unit, $picklist);
 576         }
 577     }
 578
 579     if($create_po) {
 580         return $e->die_event unless
 581             $e->allowed('CREATE_PURCHASE_ORDER', $ordering_agency);
 582         # $purchase_order =
 583     }
 584
 585     $logger->info("acq processing MARC file=$filename");
 586
 587     my $marctype = 'USMARC'; # ?
 588         my $batch = new MARC::Batch ($marctype, $filename);
 589         $batch->strict_off;
 590
 591         my $count = 0;
 592
 593         while(1) {
 594
 595             my $r;
 596                 $logger->info("processing record $count");
 597
 598         try {
 599             $r = $batch->next
 600         } catch Error with { $r = -1; };
 601
 602         last unless $r;
 603
 604         if($r == -1) {
 605                         $logger->warn("Proccessing of record $count in set $key failed.  Skipping this record");
 606                         $count++;
 607             next;
 608                 }
 609
 610                 try {
 611
 612                         (my $xml = $r->as_xml_record()) =~ s/\n//sog;
 613                         $xml =~ s/^<\?xml.+\?\s*>//go;
 614                         $xml =~ s/>\s+</></go;
 615                         $xml =~ s/\p{Cc}//go;
 616                         $xml = $U->entityize($xml);
 617                         $xml =~ s/[\x00-\x1f]//go;
 618
 619             my $li = Fieldmapper::acq::lineitem->new;
 620             $li->picklist($picklist->id) if $picklist;
 621             $li->purchase_order($purchase_order->id) if $purchase_order;
 622             $li->source_label($provider->code); # XXX ??
 623             $li->selector($e->requestor->id);
 624             $li->creator($e->requestor->id);
 625             $li->editor($e->requestor->id);
 626             $li->edit_time('now');
 627             $li->create_time('now');
 628             $li->marc($xml);
 629             $li->state('on-order') if $purchase_order;
 630             $e->create_acq_lineitem($li) or die $e->die_event;
 631
 632                         $conn->respond({count => $count}) if (++$count % 5) == 0;
 633
 634                 } catch Error with {
 635                         my $error = shift;
 636                         $logger->warn("Encountered a bad record at Vandelay ingest: ".$error);
 637                 }
 638         }
 639
 640         $e->commit;
 641     unlink($filename);
 642     $cache->delete_cache('vandelay_import_spool_' . $key);
 643
 644         return {
 645         complete => 1,
 646         purchase_order => $purchase_order,
 647         picklist => $picklist
 648     };
 649 }
 650
 651
 652
 653
 654 1;