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         progress => 0,
  11         debits_accrued => 0,
  12         purchase_order => undef,
  13         picklist => undef,
  14         complete => 0
  15     };
  16     return $self;
  17 }
  18
  19 sub respond {
  20     my($self, $other_args) = @_;
  21     $self->conn->respond({ %{$self->{args}}, %$other_args });
  22 }
  23 sub respond_complete {
  24     my($self, $other_args) = @_;
  25     $self->complete;
  26     $self->conn->respond_complete({ %{$self->{args}}, %$other_args });
  27 }
  28 sub total {
  29     my($self, $val) = @_;
  30     $self->{total} = $val if $val;
  31     return $self->{total};
  32 }
  33 sub purchase_order {
  34     my($self, $val) = @_;
  35     $self->{purchase_order} = $val if $val;
  36     return $self;
  37 }
  38 sub picklist {
  39     my($self, $val) = @_;
  40     $self->{picklist} = $val if $val;
  41     return $self;
  42 }
  43 sub add_lid {
  44     my $self = shift;
  45     $self->{args}->{lid} += 1;
  46     $self->{args}->{progress} += 1;
  47     return $self;
  48 }
  49 sub add_li {
  50     my $self = shift;
  51     $self->{args}->{li} += 1;
  52     $self->{args}->{progress} += 1;
  53     return $self;
  54 }
  55 sub add_debit {
  56     my($self, $amount) = @_;
  57     $self->{args}->{debits_accrued} += $amount;
  58     $self->{args}->{progress} += 1;
  59     return $self;
  60 }
  61 sub editor {
  62     my($self, $editor) = @_;
  63     $self->{editor} = $editor if defined $editor;
  64     return $self->{editor};
  65 }
  66 sub complete {
  67     my $self = shift;
  68     $self->{args}->{complete} = 1;
  69     return $self;
  70 }
  71
  72
  73 package OpenILS::Application::Acq::Order;
  74 use base qw/OpenILS::Application/;
  75 use strict; use warnings;
  76 # ----------------------------------------------------------------------------
  77 # Break up each component of the order process and pieces into managable
  78 # actions that can be shared across different workflows
  79 # ----------------------------------------------------------------------------
  80 use OpenILS::Event;
  81 use OpenSRF::Utils::Logger qw(:logger);
  82 use OpenILS::Utils::Fieldmapper;
  83 use OpenILS::Utils::CStoreEditor q/:funcs/;
  84 use OpenILS::Const qw/:const/;
  85 use OpenILS::Application::AppUtils;
  86 use OpenILS::Application::Cat::BibCommon;
  87 use OpenILS::Application::Cat::AssetCommon;
  88 my $U = 'OpenILS::Application::AppUtils';
  89
  90
  91 # ----------------------------------------------------------------------------
  92 # Lineitem
  93 # ----------------------------------------------------------------------------
  94 sub create_lineitem {
  95     my($mgr, $args) = @_;
  96     my $li = Fieldmapper::acq::lineitem->new;
  97     $li->creator($mgr->editor->requestor->id);
  98     $li->selector($li->creator);
  99     $li->editor($li->creator);
 100     $li->create_time('now');
 101     $li->edit_time('now');
 102     $li->state('new');
 103     $li->$_($$args{$_}) for keys %$args || ();
 104     if($li->picklist) {
 105         return 0 unless update_picklist($mgr, $li->picklist);
 106     }
 107     $mgr->add_li;
 108     return $mgr->editor->create_acq_lineitem($li);
 109 }
 110
 111 sub update_lineitem {
 112     my($mgr, $li) = @_;
 113     $li->edit_time('now');
 114     $li->editor($mgr->editor->requestor->id);
 115     return $mgr->editor->update_acq_lineitem($li);
 116 }
 117
 118 sub delete_lineitem {
 119     my($mgr, $li) = @_;
 120     $li = $mgr->editor->retrieve_acq_lineitem($li) unless ref $li;
 121
 122     if($li->picklist) {
 123         return 0 unless update_picklist($mgr, $li->picklist);
 124     }
 125
 126     if($li->purchase_order) {
 127         return 0 unless update_purchase_order($mgr, $li->purchase_order);
 128     }
 129
 130     # delete the attached lineitem_details
 131     my $lid_ids = $mgr->editor->search_acq_lineitem_detail({lineitem => $li->id}, {idlist=>1});
 132     for my $lid_id (@$lid_ids) {
 133         return 0 unless delete_lineitem_detail($mgr, undef, $lid_id);
 134     }
 135
 136     return $mgr->editor->delete_acq_lineitem($li);
 137 }
 138
 139 # ----------------------------------------------------------------------------
 140 # Lineitem Detail
 141 # ----------------------------------------------------------------------------
 142 sub create_lineitem_detail {
 143     my($mgr, $args) = @_;
 144     my $lid = Fieldmapper::acq::lineitem_detail->new;
 145     $lid->$_($$args{$_}) for keys %$args || ();
 146
 147     # create some default values
 148     unless($lid->barcode) {
 149         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_barcode_prefix') || 'ACQ';
 150         $lid->barcode($pfx.$lid->id);
 151     }
 152
 153     unless($lid->cn_label) {
 154         my $pfx = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.tmp_callnumber_prefix') || 'ACQ';
 155         $lid->cn_label($pfx.$lid->id);
 156     }
 157
 158     if(!$lid->location and my $loc = $U->ou_ancestor_setting_value($lid->owning_lib, 'acq.default_copy_location')) {
 159         $lid->location($loc);
 160     }
 161
 162     my $li = $mgr->editor->retrieve_acq_lineitem($lid->lineitem) or return 0;
 163     return 0 unless update_lineitem($mgr, $li);
 164     return $mgr->editor->create_acq_lineitem_detail($lid);
 165 }
 166
 167 sub delete_lineitem_detail {
 168     my($mgr, $lid) = @_;
 169     $lid = $mgr->editor->retrieve_acq_lineitem_detail($lid) unless ref $lid;
 170     return $mgr->editor->delete_acq_lineitem_detail($lid);
 171 }
 172
 173 # ----------------------------------------------------------------------------
 174 # Picklist
 175 # ----------------------------------------------------------------------------
 176 sub create_picklist {
 177     my($mgr, $args) = @_;
 178     my $picklist = Fieldmapper::acq::picklist->new;
 179     $picklist->creator($mgr->editor->requestor->id);
 180     $picklist->owner($picklist->creator);
 181     $picklist->editor($picklist->creator);
 182     $picklist->create_time('now');
 183     $picklist->edit_time('now');
 184     $picklist->org_unit($mgr->editor->requestor->ws_ou);
 185     $picklist->owner($mgr->editor->requestor->id);
 186     $picklist->$_($$args{$_}) for keys %$args || ();
 187     $mgr->picklist($picklist);
 188     return $mgr->editor->create_acq_picklist($picklist);
 189 }
 190
 191 sub update_picklist {
 192     my($mgr, $picklist) = @_;
 193     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 194     $picklist->edit_time('now');
 195     $picklist->editor($mgr->editor->requestor->id);
 196     return $mgr->editor->update_acq_picklist($picklist);
 197 }
 198
 199 sub delete_picklist {
 200     my($mgr, $picklist) = @_;
 201     $picklist = $mgr->editor->retrieve_acq_picklist($picklist) unless ref $picklist;
 202
 203     # delete all 'new' lineitems
 204     my $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => 'new'});
 205     for my $li (@$lis) {
 206         return 0 unless delete_lineitem($mgr, $li);
 207     }
 208
 209     # detach all non-'new' lineitems
 210     $lis = $mgr->editor->search_acq_lineitem({picklist => $picklist->id, state => {'!=' => 'new'}});
 211     for my $li (@$lis) {
 212         $li->clear_picklist;
 213         return 0 unless update_lineitem($li);
 214     }
 215
 216     # remove any picklist-specific object perms
 217     my $ops = $mgr->editor->search_permission_usr_object_perm_map({object_type => 'acqpl', object_id => "".$picklist->id});
 218     for my $op (@$ops) {
 219         return 0 unless $mgr->editor->delete_usr_object_perm_map($op);
 220     }
 221
 222     return $mgr->editor->delete_acq_picklist($picklist);
 223 }
 224
 225 # ----------------------------------------------------------------------------
 226 # Purchase Order
 227 # ----------------------------------------------------------------------------
 228 sub update_purchase_order {
 229     my($mgr, $po) = @_;
 230     $po = $mgr->editor->retrieve_acq_purchase_order($po) unless ref $po;
 231     $po->editor($mgr->editor->requestor->id);
 232     $po->edit_date('now');
 233     return $mgr->editor->update_acq_purchase_order($po);
 234 }
 235
 236 sub create_purchase_order {
 237     my($mgr, $args) = @_;
 238     my $po = Fieldmapper::acq::purchase_order->new;
 239     $po->creator($mgr->editor->requestor->id);
 240     $po->editor($mgr->editor->requestor->id);
 241     $po->owner($mgr->editor->requestor->id);
 242     $po->edit_time('now');
 243     $po->create_time('now');
 244     $po->ordering_agency($mgr->editor->requestor->ws_ou);
 245     $po->$_($$args{$_}) for keys %$args || ();
 246     return $mgr->editor->create_acq_purchase_order($po);
 247 }
 248
 249
 250
 251
 252 # ----------------------------------------------------------------------------
 253 # Workflow: Build a selection list from a Z39.50 search
 254 # ----------------------------------------------------------------------------
 255
 256 __PACKAGE__->register_method(
 257         method => 'zsearch',
 258         api_name => 'open-ils.acq.picklist.search.z3950',
 259     stream => 1,
 260         signature => {
 261         desc => 'Performs a z3950 federated search and creates a picklist and associated lineitems',
 262         params => [
 263             {desc => 'Authentication token', type => 'string'},
 264             {desc => 'Search definition', type => 'object'},
 265             {desc => 'Picklist name, optional', type => 'string'},
 266         ]
 267     }
 268 );
 269
 270 sub zsearch {
 271     my($self, $conn, $auth, $search, $name, $options) = @_;
 272     my $e = new_editor(authtoken=>$auth);
 273     return $e->event unless $e->checkauth;
 274     return $e->event unless $e->allowed('CREATE_PICKLIST');
 275
 276     $search->{limit} ||= 10;
 277     $options ||= {};
 278
 279     my $ses = OpenSRF::AppSession->create('open-ils.search');
 280     my $req = $ses->request('open-ils.search.z3950.search_class', $auth, $search);
 281
 282     my $first = 1;
 283     my $picklist;
 284     my $mgr;
 285     while(my $resp = $req->recv(timeout=>60)) {
 286
 287         if($first) {
 288             my $e = new_editor(requestor=>$e->requestor, xact=>1);
 289             $mgr = OpenILS::Application::Acq::BatchManager->new({editor => $e, conn => $conn});
 290             $picklist = zsearch_build_pl($mgr, $name);
 291             $first = 0;
 292         }
 293
 294         my $result = $resp->content;
 295         my $count = $result->{count};
 296         $mgr->total( (($count < $search->{limit}) ? $count : $search->{limit})+1 );
 297
 298         for my $rec (@{$result->{records}}) {
 299
 300             my $li = create_lineitem($mgr, {
 301                 picklist => $picklist->{id},
 302                 source_label => $result->{service},
 303                 marc => $rec->{marcxml},
 304                 eg_bib_id => $rec->{bibid}
 305             });
 306
 307             if($$options{respond_li}) {
 308                 $li->attributes($mgr->editor->search_acq_lineitem_attr({lineitem => $li->id}))
 309                     if $$options{flesh_attrs};
 310                 $li->clear_marc if $$options{clear_marc};
 311                 $mgr->respond({lineitem => $li});
 312             } else {
 313                 $mgr->respond;
 314             }
 315         }
 316     }
 317
 318     $mgr->editor->commit;
 319     $mgr->respond_complete;
 320     return undef;
 321 }
 322
 323 sub zsearch_build_pl {
 324     my($mgr, $name) = @_;
 325
 326     $name ||= '';
 327     my $picklist = $mgr->editor->search_acq_picklist({owner=>$mgr->editor->requestor->id, name=>$name})->[0];
 328     if($name eq '' and $picklist) {
 329         return 0 unless delete_picklist($mgr, $picklist);
 330         $picklist = undef;
 331     }
 332
 333     if($picklist) {
 334         update_picklist($mgr, $picklist) or return 0;
 335         return $picklist;
 336     }
 337
 338     return create_picklist($mgr, {name => $name});
 339 }
 340
 341 1;