Make Evergreen Perl modules installable via Module::Build to match OpenSRF
[working/Evergreen.git] / Open-ILS / src / perlmods / lib / 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 use OpenILS::Application::Acq::Financials;
20 use DateTime;
21
22 my $U = 'OpenILS::Application::AppUtils';
23
24
25 __PACKAGE__->register_method(
26         method => 'create_picklist',
27         api_name        => 'open-ils.acq.picklist.create',
28         signature => {
29         desc => 'Creates a new picklist',
30         params => [
31             {desc => 'Authentication token', type => 'string'},
32             {desc => 'Picklist object to create', type => 'object'}
33         ],
34         return => {desc => 'The ID of the new picklist'}
35     }
36 );
37
38 sub create_picklist {
39     my($self, $conn, $auth, $picklist) = @_;
40     my $e = new_editor(xact=>1, authtoken=>$auth);
41     return $e->die_event unless $e->checkauth;
42     $picklist->creator($e->requestor->id);
43     $picklist->editor($e->requestor->id);
44     $picklist->org_unit($e->requestor->ws_ou) unless $picklist->org_unit;
45     return $e->die_event unless $e->allowed('CREATE_PICKLIST', $picklist->org_unit);
46     return OpenILS::Event->new('BAD_PARAMS')
47         unless $e->requestor->id == $picklist->owner;
48     $e->create_acq_picklist($picklist) or return $e->die_event;
49     $e->commit;
50     return $picklist->id;
51 }
52
53
54 __PACKAGE__->register_method(
55         method => 'update_picklist',
56         api_name        => 'open-ils.acq.picklist.update',
57         signature => {
58         desc => 'Updates a new picklist',
59         params => [
60             {desc => 'Authentication token', type => 'string'},
61             {desc => 'Picklist object to update', type => 'object'}
62         ],
63         return => {desc => '1 on success, Event on error'}
64     }
65 );
66
67 sub update_picklist {
68     my($self, $conn, $auth, $picklist) = @_;
69     my $e = new_editor(xact=>1, authtoken=>$auth);
70     return $e->die_event unless $e->checkauth;
71
72     # don't let them change the owner
73     my $o_picklist = $e->retrieve_acq_picklist($picklist->id)
74         or return $e->die_event;
75     if($o_picklist->owner != $e->requestor->id) {
76         return $e->die_event unless 
77             $e->allowed('UPDATE_PICKLIST', $o_picklist->org_unit);
78     }
79     return OpenILS::Event->new('BAD_PARAMS') unless $o_picklist->org_unit == $picklist->org_unit;
80
81     $picklist->edit_time('now');
82     $picklist->editor($e->requestor->id);
83     $e->update_acq_picklist($picklist) or return $e->die_event;
84     $e->commit;
85     return 1;
86 }
87
88 __PACKAGE__->register_method(
89         method => 'retrieve_picklist',
90         api_name        => 'open-ils.acq.picklist.retrieve',
91     authoritative => 1,
92         signature => {
93         desc => 'Retrieves a picklist',
94         params => [
95             {desc => 'Authentication token', type => 'string'},
96             {desc => 'Picklist ID to retrieve', type => 'number'},
97             {desc => 'Options hash, including "flesh_lineitem_count" to get the count of attached entries', type => 'hash'},
98         ],
99         return => {desc => 'Picklist object on success, Event on error'}
100     }
101 );
102
103 sub retrieve_picklist {
104     my($self, $conn, $auth, $picklist_id, $options) = @_;
105     my $e = new_editor(authtoken=>$auth);
106     return $e->event unless $e->checkauth;
107
108     return retrieve_picklist_impl($e, $picklist_id, $options);
109 }
110
111 sub retrieve_picklist_impl {
112     my ($e, $picklist_id, $options) = @_;
113     $options ||= {};
114
115     my $picklist = $e->retrieve_acq_picklist($picklist_id)
116         or return $e->event;
117
118     $picklist->entry_count(retrieve_lineitem_count($e, $picklist_id))
119         if $$options{flesh_lineitem_count};
120
121     if($e->requestor->id != $picklist->owner) {
122         return $e->event unless 
123             $e->allowed('VIEW_PICKLIST', $picklist->org_unit, $picklist);
124     }
125
126     $picklist->owner($e->retrieve_actor_user($picklist->owner)) 
127         if($$options{flesh_owner});
128     $picklist->owner($e->retrieve_actor_user($picklist->owner)->usrname) 
129         if($$options{flesh_username});
130
131     return $picklist;
132 }
133
134
135 # Returns the number of entries associated with this picklist
136 sub retrieve_lineitem_count {
137     my($e, $picklist_id) = @_;
138     my $count = $e->json_query({
139         select => { 
140             jub => [{transform => 'count', column => 'id', alias => 'count'}]
141         }, 
142         from => 'jub', 
143         where => {picklist => $picklist_id}}
144     );
145     return $count->[0]->{count};
146 }
147
148
149
150 __PACKAGE__->register_method(
151         method => 'retrieve_picklist_name',
152         api_name        => 'open-ils.acq.picklist.name.retrieve',
153     authoritative => 1,
154         signature => {
155         desc => 'Retrieves a picklist by name.  Owner is implied by the caller',
156         params => [
157             {desc => 'Authentication token',      type => 'string'},
158             {desc => 'Picklist name to retrieve', type => 'string'},
159         ],
160         return => {desc => 'Picklist object on success, null on not found'}
161     }
162 );
163
164 sub retrieve_picklist_name {
165     my($self, $conn, $auth, $name) = @_;
166     my $e = new_editor(authtoken=>$auth);
167     return $e->event unless $e->checkauth;
168     my $picklist = $e->search_acq_picklist(
169         {name => $name, owner => $e->requestor->id})->[0];
170     if($e->requestor->id != $picklist->owner) {
171         return $e->event unless 
172             $e->allowed('VIEW_PICKLIST', $picklist->org_unit, $picklist);
173     }
174     return $picklist;
175 }
176
177
178
179 __PACKAGE__->register_method(
180         method => 'retrieve_user_picklist',
181         api_name        => 'open-ils.acq.picklist.user.retrieve',
182     stream => 1,
183         signature => {
184         desc => 'Retrieves a  user\'s picklists',
185         params => [
186             {desc => 'Authentication token', type => 'string'},
187             {desc => 'Options, including "idlist", whch forces the return
188                 of a list of IDs instead of objects', type => 'hash'},
189         ],
190         return => {desc => 'Picklist object on success, Event on error'}
191     }
192 );
193
194 sub retrieve_user_picklist {
195     my($self, $conn, $auth, $options) = @_;
196     my $e = new_editor(authtoken=>$auth);
197     return $e->die_event unless $e->checkauth;
198     $options ||= {};
199
200     # don't grab the PL with name == "", because that is the designated temporary picklist
201     my $list = $e->search_acq_picklist([
202             {
203                 owner => $e->requestor->id, 
204                 name => {'!=' => ''}
205             }, {
206                 order_by => $$options{order_by} || {acqpl => 'edit_time DESC'},
207                 limit => $$options{limit} || 10,
208                 offset => $$options{offset} || 0,
209             }
210         ],
211         {idlist=>1}
212     );
213
214     for my $id (@$list) {
215         if($$options{idlist}) {
216             $conn->respond($id);
217         } else {
218             my $pl = $e->retrieve_acq_picklist($id);
219             $pl->entry_count(retrieve_lineitem_count($e, $id)) if $$options{flesh_lineitem_count};
220             $pl->owner($e->retrieve_actor_user($pl->owner)) if $$options{flesh_owner};
221             $pl->owner($e->retrieve_actor_user($pl->owner)->usrname) if $$options{flesh_username};
222             $conn->respond($pl);
223         }
224     }
225
226     return undef;
227 }
228
229
230 __PACKAGE__->register_method(
231         method => 'retrieve_all_user_picklist',
232         api_name        => 'open-ils.acq.picklist.user.all.retrieve',
233     stream => 1,
234         signature => {
235         desc => 'Retrieves all of the picklists a user is allowed to see',
236         params => [
237             {desc => 'Authentication token', type => 'string'},
238             {desc => 'Options, including "idlist", whch forces the return
239                 of a list of IDs instead of objects', type => 'hash'},
240         ],
241         return => {desc => 'Picklist objects on success, Event on error'}
242     }
243 );
244
245 sub retrieve_all_user_picklist {
246     my($self, $conn, $auth, $options) = @_;
247     my $e = new_editor(authtoken=>$auth);
248     return $e->event unless $e->checkauth;
249
250     my $my_list = $e->search_acq_picklist(
251         {owner=>$e->requestor->id, name=>{'!='=>''}}, {idlist=>1});
252
253     my $picklist_ids = $e->objects_allowed('VIEW_PICKLIST', 'acqpl');
254     my $p_orgs = $U->user_has_work_perm_at($e, 'VIEW_PICKLIST', {descendants =>1});
255     my $picklist_ids_2 = $e->search_acq_picklist(
256         {name=>{'!='=>''}, org_unit => $p_orgs}, {idlist=>1});
257
258     return undef unless @$my_list or @$picklist_ids or @$picklist_ids_2;
259
260     my @list = (@$my_list, @$picklist_ids, @$picklist_ids_2);
261     my %dedup;
262     $dedup{$_} = 1 for @list;
263     @list = keys %dedup;
264
265     return \@list if $$options{idlist};
266
267     for my $pl (@list) {
268         my $picklist = $e->retrieve_acq_picklist($pl) or return $e->event;
269         $picklist->entry_count(retrieve_lineitem_count($e, $picklist->id))
270             if($$options{flesh_lineitem_count});
271         $picklist->owner($e->retrieve_actor_user($picklist->owner))
272             if $$options{flesh_owner};
273         $picklist->owner($e->retrieve_actor_user($picklist->owner)->usrname)
274             if $$options{flesh_username};
275         $conn->respond($picklist);
276     }
277
278     return undef;
279 }
280
281 __PACKAGE__->register_method(
282         method => 'retrieve_pl_lineitem',
283         api_name        => 'open-ils.acq.lineitem.picklist.retrieve',
284     stream => 1,
285         signature => {
286         desc => 'Retrieves lineitem objects according to picklist',
287         params => [
288             {desc => 'Authentication token', type => 'string'},
289             {desc => 'Picklist ID whose entries to retrieve', type => 'number'},
290             {desc => q/Options, including 
291                 "sort_attr", which defines the attribute to sort on; 
292                 "sort_attr_type", which defines the attribute type sort on; 
293                 "sort_dir", which defines the sort order between "asc" and "desc";
294                 "limit", retrieval limit;
295                 "offset", retrieval offset;
296                 "idlist", return a list of IDs instead of objects
297                 "flesh_attrs", additionaly return the list of flattened attributes
298                 "clear_marc", discards the raw MARC data to reduce data size
299                 "flesh_notes", flesh lineitem notes
300                 "flesh_cancel_reason", flesh cancel_reason
301                 /, 
302                 type => 'hash'}
303         ],
304         return => {desc => 'Array of lineitem objects or IDs,  on success, Event on error'}
305     }
306 );
307
308
309 my $PL_ENTRY_JSON_QUERY = {
310     select => {jub => ["id"], "acqlia" => ["attr_value"]},
311     "from" => {
312         "jub" => {
313             "acqlia" => {
314                 "fkey" => "id", 
315                 "field" => "lineitem", 
316                 "type" => "left", 
317                 "filter" => {
318                     "attr_type" => "lineitem_marc_attr_definition", 
319                     "attr_name" => "author" 
320                 }
321             }
322         }
323     }, 
324     "order_by" => {"acqlia" => {"attr_value" => {"direction"=>"asc"}}}, 
325     "limit" => 10,
326     "where" => {"+jub" => {"picklist"=>2}},
327     "offset" => 0
328 };
329
330 sub retrieve_pl_lineitem {
331     my($self, $conn, $auth, $picklist_id, $options) = @_;
332     my $e = new_editor(authtoken=>$auth);
333     return $e->event unless $e->checkauth;
334
335     # collect the retrieval options
336     my $sort_attr = $$options{sort_attr} || 'title';
337     my $sort_attr_type = $$options{sort_attr_type} || 'lineitem_marc_attr_definition';
338     my $sort_dir = $$options{sort_dir} || 'asc';
339     my $limit = $$options{limit} || 10;
340     my $offset = $$options{offset} || 0;
341
342     $PL_ENTRY_JSON_QUERY->{where}->{'+jub'}->{picklist} = $picklist_id;
343     $PL_ENTRY_JSON_QUERY->{from}->{jub}->{acqlia}->{filter}->{attr_name} = $sort_attr;
344     $PL_ENTRY_JSON_QUERY->{from}->{jub}->{acqlia}->{filter}->{attr_type} = $sort_attr_type;
345     $PL_ENTRY_JSON_QUERY->{order_by}->{acqlia}->{attr_value}->{direction} = $sort_dir;
346     $PL_ENTRY_JSON_QUERY->{limit} = $limit;
347     $PL_ENTRY_JSON_QUERY->{offset} = $offset;
348
349     my $entries = $e->json_query($PL_ENTRY_JSON_QUERY);
350
351     my @ids;
352     for my $entry (@$entries) {
353         push(@ids, $entry->{id}) unless grep { $_ eq $entry->{id} } @ids;
354     }
355
356     for my $id (@ids) {
357         if($$options{idlist}) {
358             $conn->respond($id);
359             next;
360         } 
361
362         my $entry;
363         my $flesh = {};
364         if($$options{flesh_attrs} or $$options{flesh_notes} or $$options{flesh_cancel_reason}) {
365             $flesh = {flesh => 2, flesh_fields => {jub => []}};
366             if($$options{flesh_notes}) {
367                 push(@{$flesh->{flesh_fields}->{jub}}, 'lineitem_notes');
368                 $flesh->{flesh_fields}->{acqlin} = ['alert_text'];
369             }
370             push(@{$flesh->{flesh_fields}->{jub}}, 'attributes') if $$options{flesh_attrs};
371             push @{$flesh->{flesh_fields}->{jub}}, 'cancel_reason' if $$options{flesh_cancel_reason};
372         }
373
374         $entry = $e->retrieve_acq_lineitem([$id, $flesh]);
375         my $details = $e->search_acq_lineitem_detail({lineitem => $id}, {idlist=>1});
376         $entry->item_count(scalar(@$details));
377         $entry->clear_marc if $$options{clear_marc};
378         $conn->respond($entry);
379     }
380
381     return undef;
382 }
383
384 =head comment
385 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}}
386 =cut
387
388
389
390 __PACKAGE__->register_method(
391     method    => "record_distribution_formula_application",
392     api_name  => "open-ils.acq.distribution_formula.record_application",
393     signature => {
394         desc  => "Record the application (which actually happens on the " .
395             "client side) of a distribution formula to a PO or a PL",
396         params => [
397             {desc => "Authentication token", type => "string"},
398             {desc => "Formulae applied", "type" => "array"},
399             {desc => "Lineitem ID", "type" => "number"}
400         ],
401         return => {desc => "acqdfa IDs on success; event on failure"}
402     }
403 );
404
405 sub record_distribution_formula_application {
406     my ($self, $conn, $auth, $formulae, $li_id) = @_;
407
408     my $e = new_editor("authtoken" => $auth, "xact" => 1);
409     return $e->die_event unless $e->checkauth;
410
411     # We need this to determine relevant OU for testing permissions...
412     my $li = $e->retrieve_acq_lineitem([
413         $li_id, {
414             "flesh" => 1,
415             "flesh_fields" => {"jub" => [qw/purchase_order picklist/]}
416         }
417     ]) or return $e->die_event;
418
419     # ... which we do here.
420     my $ou;
421     if ($li->purchase_order) {
422         $ou = $li->purchase_order->ordering_agency;
423     } elsif ($li->picklist) {
424         $ou = $li->picklist->org_unit;
425     } else {
426         $e->rollback;
427         return new OpenILS::Event("BAD_PARAMS");
428     }
429
430     return $e->die_event unless $e->allowed("CREATE_PURCHASE_ORDER", $ou);
431
432     # Just deal with it if $formulate is a scalar instead of an array.
433     $formulae = [ $formulae ] if not ref $formulae;
434
435     my @results = ();
436     foreach (@{$formulae}) {
437         my $acqdfa = new Fieldmapper::acq::distribution_formula_application;
438
439         $acqdfa->creator($e->requestor->id);
440         $acqdfa->formula($_);
441         $acqdfa->lineitem($li_id);
442
443         $acqdfa = $e->create_acq_distribution_formula_application($acqdfa)
444             or return $e->die_event;
445         push @results, $acqdfa->id;
446     }
447
448     $e->commit or return $e->die_event;
449     \@results;
450 }
451
452
453 __PACKAGE__->register_method(
454         method => 'ranged_distrib_formulas',
455         api_name        => 'open-ils.acq.distribution_formula.ranged.retrieve',
456     stream => 1,
457         signature => {
458         desc => 'Ranged distribution formulas, fleshed with entries',
459         params => [
460             {desc => 'Authentication token', type => 'string'},
461             {desc => "offset", type => "number"},
462             {desc => "limit", type => "number"}
463         ],
464         return => {desc => 'List of distribution formulas'}
465     }
466 );
467
468 sub ranged_distrib_formulas {
469     my ($self, $conn, $auth, $offset, $limit) = @_;
470
471     $offset ||= 0;
472     $limit ||= 10;
473
474     my $e = new_editor(authtoken=>$auth);
475     return $e->event unless $e->checkauth;
476     my $orgs = $U->user_has_work_perm_at($e, 'CREATE_PICKLIST', {descendants =>1});
477
478     my $forms = $e->search_acq_distribution_formula([
479         {owner => $orgs},
480         {
481             flesh => 1, 
482             flesh_fields => {acqdf => ['entries']},
483             order_by => {acqdf => "name"},
484             limit => $limit,
485             offset => $offset
486         }
487     ]) or return $e->die_event;
488
489     for (@$forms) {
490
491         # how many times has this DF been used
492         my $count = $e->json_query({
493             select => {acqdfa => [{column => 'formula', aggregate => 1, transform => 'count', alias => 'count'}]}, 
494             from => 'acqdfa', 
495             where => {formula => $_->id}
496         })->[0];
497
498         $_->use_count($count->{count});
499         $conn->respond($_);
500     }
501
502     return undef;
503 }
504
505 __PACKAGE__->register_method(
506         method => "ranged_distrib_formula_applications",
507         api_name => "open-ils.acq.distribution_formula_application.ranged.retrieve",
508     stream => 1,
509         signature => {
510         desc => "Ranged distribution formulas applications, fleshed with formulas and users",
511         params => [
512             {desc => "Authentication token", type => "string"},
513             {desc => "Lineitem Id", type => "number"}
514         ],
515         return => {desc => "List of distribution formula applications"}
516     }
517 );
518
519 sub ranged_distrib_formula_applications {
520     my ($self, $conn, $auth, $li_id) = @_;
521
522     my $e = new_editor("authtoken" => $auth);
523     return $e->event unless $e->checkauth;
524
525     my $li = $e->retrieve_acq_lineitem([
526         $li_id, {
527             "flesh" => 1,
528             "flesh_fields" => {"jub" => [qw/purchase_order picklist/]}
529         }
530     ]) or return $e->die_event;
531
532     if ($li->picklist) {
533         return $e->die_event unless $e->allowed(
534             "VIEW_PICKLIST", $li->picklist->org_unit
535         );
536     } elsif ($li->purchase_order) {
537         return $e->die_event unless $e->allowed(
538             "VIEW_PURCHASE_ORDER", $li->purchase_order->ordering_agency
539         );
540     } else {
541         # For the moment no use cases are forseen for using this
542         # method with LIs that don't belong to a PL or a PO.
543         $e->disconnect;
544         return new OpenILS::Event("BAD_PARAMS", "note" => "Freestanding LI");
545     }
546
547     my $dfa = $e->search_acq_distribution_formula_application([
548         {"lineitem" => $li_id},
549         {"flesh" => 1, "flesh_fields" => {"acqdfa" => [qw/formula creator/]}}
550     ]);
551
552     $conn->respond($_) foreach (@$dfa);
553
554     $e->disconnect;
555     undef;
556 }
557
558 1;