Forward Port 3.4.1 to 3.4.2 upgrade script
[Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / Application / Actor / Container.pm
1 package OpenILS::Application::Actor::Container;
2 use base 'OpenILS::Application';
3 use strict; use warnings;
4 use OpenILS::Application::AppUtils;
5 use OpenILS::Perm;
6 use Data::Dumper;
7 use OpenSRF::EX qw(:try);
8 use OpenILS::Utils::Fieldmapper;
9 use OpenILS::Utils::CStoreEditor qw/:funcs/;
10 use OpenSRF::Utils::SettingsClient;
11 use OpenSRF::Utils::Cache;
12 use Digest::MD5 qw(md5_hex);
13 use OpenSRF::Utils::JSON;
14
15 my $apputils = "OpenILS::Application::AppUtils";
16 my $U = $apputils;
17 my $logger = "OpenSRF::Utils::Logger";
18
19 sub initialize { return 1; }
20
21 my $svc = 'open-ils.cstore';
22 my $meth = 'open-ils.cstore.direct.container';
23 my %types;
24 my %ctypes;
25 my %itypes;
26 my %htypes;
27 my %qtypes;
28 my %ttypes;
29 my %batch_perm;
30 my %table;
31
32 $batch_perm{'biblio'} = ['UPDATE_MARC'];
33 $batch_perm{'callnumber'} = ['UPDATE_VOLUME'];
34 $batch_perm{'copy'} = ['UPDATE_COPY'];
35 $batch_perm{'user'} = ['UPDATE_USER'];
36
37 $types{'biblio'} = "$meth.biblio_record_entry_bucket";
38 $types{'callnumber'} = "$meth.call_number_bucket";
39 $types{'copy'} = "$meth.copy_bucket";
40 $types{'user'} = "$meth.user_bucket";
41
42 $ctypes{'biblio'} = "container_biblio_record_entry_bucket";
43 $ctypes{'callnumber'} = "container_call_number_bucket";
44 $ctypes{'copy'} = "container_copy_bucket";
45 $ctypes{'user'} = "container_user_bucket";
46
47 $itypes{'biblio'} = "biblio_record_entry";
48 $itypes{'callnumber'} = "asset_call_number";
49 $itypes{'copy'} = "asset_copy";
50 $itypes{'user'} = "actor_user";
51
52 $ttypes{'biblio'} = "biblio_record_entry";
53 $ttypes{'callnumber'} = "call_number";
54 $ttypes{'copy'} = "copy";
55 $ttypes{'user'} = "user";
56
57 $htypes{'biblio'} = "bre";
58 $htypes{'callnumber'} = "acn";
59 $htypes{'copy'} = "acp";
60 $htypes{'user'} = "au";
61
62 $table{'biblio'} = "biblio.record_entry";
63 $table{'callnumber'} = "asset.call_number";
64 $table{'copy'} = "asset.copy";
65 $table{'user'} = "actor.usr";
66
67 #$qtypes{'biblio'} = 0 
68 #$qtypes{'callnumber'} = 0;
69 #$qtypes{'copy'} = 0;
70 $qtypes{'user'} = 1;
71
72 my $event;
73
74 sub _sort_buckets {
75     my $buckets = shift;
76     return $buckets unless ($buckets && $buckets->[0]);
77     return [ sort { $a->name cmp $b->name } @$buckets ];
78 }
79
80 __PACKAGE__->register_method(
81     method  => "bucket_retrieve_all",
82     api_name    => "open-ils.actor.container.all.retrieve_by_user",
83     authoritative => 1,
84     notes        => <<"    NOTES");
85         Retrieves all un-fleshed buckets assigned to given user 
86         PARAMS(authtoken, bucketOwnerId)
87         If requestor ID is different than bucketOwnerId, requestor must have
88         VIEW_CONTAINER permissions.
89     NOTES
90
91 sub bucket_retrieve_all {
92     my($self, $client, $auth, $user_id) = @_;
93     my $e = new_editor(authtoken => $auth);
94     return $e->event unless $e->checkauth;
95
96     if($e->requestor->id ne $user_id) {
97         return $e->event unless $e->allowed('VIEW_CONTAINER');
98     }
99     
100     my %buckets;
101     for my $type (keys %ctypes) {
102         my $meth = "search_" . $ctypes{$type};
103         $buckets{$type} = _sort_buckets($e->$meth({owner => $user_id}));
104     }
105
106     return \%buckets;
107 }
108
109 __PACKAGE__->register_method(
110     method  => "bucket_flesh",
111     api_name    => "open-ils.actor.container.flesh",
112     authoritative => 1,
113     argc        => 3, 
114 );
115
116 __PACKAGE__->register_method(
117     method  => "bucket_flesh_pub",
118     api_name    => "open-ils.actor.container.public.flesh",
119     argc        => 3, 
120 );
121
122 sub bucket_flesh {
123     my($self, $conn, $auth, $class, $bucket_id) = @_;
124     my $e = new_editor(authtoken => $auth);
125     return $e->event unless $e->checkauth;
126     return _bucket_flesh($self, $conn, $e, $class, $bucket_id);
127 }
128
129 sub bucket_flesh_pub {
130     my($self, $conn, $class, $bucket_id) = @_;
131     my $e = new_editor();
132     return _bucket_flesh($self, $conn, $e, $class, $bucket_id);
133 }
134
135 sub _bucket_flesh {
136     my($self, $conn, $e, $class, $bucket_id) = @_;
137     my $meth = 'retrieve_' . $ctypes{$class};
138     my $bkt = $e->$meth($bucket_id) or return $e->event;
139
140     unless($U->is_true($bkt->pub)) {
141         return undef if $self->api_name =~ /public/;
142         unless($bkt->owner eq $e->requestor->id) {
143             my $owner = $e->retrieve_actor_user($bkt->owner)
144                 or return $e->die_event;
145             return $e->event unless $e->allowed('VIEW_CONTAINER', $owner->home_ou);
146         }
147     }
148
149     my $fmclass = $bkt->class_name . "i";
150     $meth = 'search_' . $ctypes{$class} . '_item';
151     $bkt->items(
152         $e->$meth(
153             {bucket => $bucket_id}, 
154             {   order_by => {$fmclass => "pos"},
155                 flesh => 1, 
156                 flesh_fields => {$fmclass => ['notes']}
157             }
158         )
159     );
160
161     return $bkt;
162 }
163
164
165 __PACKAGE__->register_method(
166     method  => "item_note_cud",
167     api_name    => "open-ils.actor.container.item_note.cud",
168 );
169
170
171 sub item_note_cud {
172     my($self, $conn, $auth, $class, $note) = @_;
173
174     return new OpenILS::Event("BAD_PARAMS") unless
175         $note->class_name =~ /bucket_item_note$/;
176
177     my $e = new_editor(authtoken => $auth, xact => 1);
178     return $e->die_event unless $e->checkauth;
179
180     my $meat = $ctypes{$class} . "_item_note";
181     my $meth = "retrieve_$meat";
182
183     my $item_meat = $ctypes{$class} . "_item";
184     my $item_meth = "retrieve_$item_meat";
185
186     my $nhint = $Fieldmapper::fieldmap->{$note->class_name}->{hint};
187     (my $ihint = $nhint) =~ s/n$//og;
188
189     my ($db_note, $item);
190
191     if ($note->isnew) {
192         $db_note = $note;
193
194         $item = $e->$item_meth([
195             $note->item, {
196                 flesh => 1, flesh_fields => {$ihint => ["bucket"]}
197             }
198         ]) or return $e->die_event;
199     } else {
200         $db_note = $e->$meth([
201             $note->id, {
202                 flesh => 2,
203                 flesh_fields => {
204                     $nhint => ['item'],
205                     $ihint => ['bucket']
206                 }
207             }
208         ]) or return $e->die_event;
209
210         $item = $db_note->item;
211     }
212
213     if($item->bucket->owner ne $e->requestor->id) {
214         return $e->die_event unless $e->allowed("UPDATE_CONTAINER");
215     }
216
217     $meth = 'create_' . $meat if $note->isnew;
218     $meth = 'update_' . $meat if $note->ischanged;
219     $meth = 'delete_' . $meat if $note->isdeleted;
220     return $e->die_event unless $e->$meth($note);
221     $e->commit;
222 }
223
224
225 __PACKAGE__->register_method(
226     method  => "bucket_retrieve_class",
227     api_name    => "open-ils.actor.container.retrieve_by_class",
228     argc        => 3, 
229     authoritative   => 1, 
230     notes        => <<"    NOTES");
231         Retrieves all un-fleshed buckets by class assigned to given user 
232         PARAMS(authtoken, bucketOwnerId, class [, type])
233         class can be one of "biblio", "callnumber", "copy", "user"
234         The optional "type" parameter allows you to limit the search by 
235         bucket type.  
236         If bucketOwnerId is not defined, the authtoken is used as the
237         bucket owner.
238         If requestor ID is different than bucketOwnerId, requestor must have
239         VIEW_CONTAINER permissions.
240     NOTES
241
242 sub bucket_retrieve_class {
243     my( $self, $client, $authtoken, $userid, $class, $type ) = @_;
244
245     my( $staff, $user, $evt ) = 
246         $apputils->checkses_requestor( $authtoken, $userid, 'VIEW_CONTAINER' );
247     return $evt if $evt;
248
249     $logger->debug("User " . $staff->id . 
250         " retrieving buckets for user $userid [class=$class, type=$type]");
251
252     my $meth = $types{$class} . ".search.atomic";
253     my $buckets;
254
255     if( $type ) {
256         $buckets = $apputils->simplereq( $svc, 
257             $meth, { owner => $userid, btype => $type } );
258     } else {
259         $logger->debug("Grabbing buckets by class $class: $svc : $meth :  {owner => $userid}");
260         $buckets = $apputils->simplereq( $svc, $meth, { owner => $userid } );
261     }
262
263     return _sort_buckets($buckets);
264 }
265
266 __PACKAGE__->register_method(
267     method  => "bucket_create",
268     api_name    => "open-ils.actor.container.create",
269     notes        => <<"    NOTES");
270         Creates a new bucket object.  If requestor is different from
271         bucketOwner, requestor needs CREATE_CONTAINER permissions
272         PARAMS(authtoken, bucketObject);
273         Returns the new bucket object
274     NOTES
275
276 sub bucket_create {
277     my( $self, $client, $authtoken, $class, $bucket ) = @_;
278
279     my $e = new_editor(xact=>1, authtoken=>$authtoken);
280     return $e->event unless $e->checkauth;
281
282     if( $bucket->owner ne $e->requestor->id ) {
283         return $e->event unless
284             $e->allowed('CREATE_CONTAINER');
285
286     } else {
287         return $e->event unless
288             $e->allowed('CREATE_MY_CONTAINER');
289     }
290         
291     $bucket->clear_id;
292
293     my $evt = OpenILS::Event->new('CONTAINER_EXISTS', 
294         payload => [$class, $bucket->owner, $bucket->btype, $bucket->name]);
295     my $search = {name => $bucket->name, owner => $bucket->owner, btype => $bucket->btype};
296
297     my $obj;
298     if( $class eq 'copy' ) {
299         return $evt if $e->search_container_copy_bucket($search)->[0];
300         return $e->event unless
301             $obj = $e->create_container_copy_bucket($bucket);
302     }
303
304     if( $class eq 'callnumber' ) {
305         return $evt if $e->search_container_call_number_bucket($search)->[0];
306         return $e->event unless
307             $obj = $e->create_container_call_number_bucket($bucket);
308     }
309
310     if( $class eq 'biblio' ) {
311         return $evt if $e->search_container_biblio_record_entry_bucket($search)->[0];
312         return $e->event unless
313             $obj = $e->create_container_biblio_record_entry_bucket($bucket);
314     }
315
316     if( $class eq 'user') {
317         return $evt if $e->search_container_user_bucket($search)->[0];
318         return $e->event unless
319             $obj = $e->create_container_user_bucket($bucket);
320     }
321
322     $e->commit;
323     return $obj->id;
324 }
325
326
327 __PACKAGE__->register_method(
328     method  => "item_create",
329     api_name    => "open-ils.actor.container.item.create",
330     signature => {
331         desc => q/
332             Adds one or more items to an existing container
333         /,
334         params => [
335             {desc => 'Authentication token', type => 'string'},
336             {desc => 'Container class.  Can be "copy", "callnumber", "biblio", or "user"', type => 'string'},
337             {desc => 'Item or items.  Can either be a single container item object, or an array of them', type => 'object'},
338         ],
339         return => {
340             desc => 'The ID of the newly created item(s).  In batch context, an array of IDs is returned'
341         }
342     }
343 );
344
345
346 sub item_create {
347     my( $self, $client, $authtoken, $class, $item ) = @_;
348
349     my $e = new_editor(xact=>1, authtoken=>$authtoken);
350     return $e->die_event unless $e->checkauth;
351     my $items = (ref $item eq 'ARRAY') ? $item : [$item];
352
353     my ( $bucket, $evt ) = $apputils->fetch_container_e($e, $item->bucket, $class);
354     return $evt if $evt;
355
356     if( $bucket->owner ne $e->requestor->id ) {
357         return $e->die_event unless
358             $e->allowed('CREATE_CONTAINER_ITEM');
359
360     } else {
361 #       return $e->event unless
362 #           $e->allowed('CREATE_CONTAINER_ITEM'); # new perm here?
363     }
364         
365     for my $one_item (@$items) {
366
367         $one_item->clear_id;
368
369         my $stat;
370         if( $class eq 'copy' ) {
371             return $e->die_event unless
372                 $stat = $e->create_container_copy_bucket_item($one_item);
373         }
374
375         if( $class eq 'callnumber' ) {
376             return $e->die_event unless
377                 $stat = $e->create_container_call_number_bucket_item($one_item);
378         }
379
380         if( $class eq 'biblio' ) {
381             return $e->die_event unless
382                 $stat = $e->create_container_biblio_record_entry_bucket_item($one_item);
383         }
384
385         if( $class eq 'user') {
386             return $e->die_event unless
387                 $stat = $e->create_container_user_bucket_item($one_item);
388         }
389     }
390
391     $e->commit;
392
393     # CStoreEeditor inserts the id (pkey) on newly created objects
394     return [ map { $_->id } @$items ] if ref $item eq 'ARRAY';
395     return $item->id; 
396 }
397
398
399
400 __PACKAGE__->register_method(
401     method  => "item_delete",
402     api_name    => "open-ils.actor.container.item.delete",
403     notes        => <<"    NOTES");
404         PARAMS(authtoken, class, itemId)
405     NOTES
406
407 sub item_delete {
408     my( $self, $client, $authtoken, $class, $itemid ) = @_;
409
410     my $e = new_editor(xact=>1, authtoken=>$authtoken);
411     return $e->event unless $e->checkauth;
412
413     my $ret = __item_delete($e, $class, $itemid);
414     $e->commit unless $U->event_code($ret);
415     return $ret;
416 }
417
418 sub __item_delete {
419     my( $e, $class, $itemid ) = @_;
420     my( $bucket, $item, $evt);
421
422     ( $item, $evt ) = $U->fetch_container_item_e( $e, $itemid, $class );
423     return $evt if $evt;
424
425     ( $bucket, $evt ) = $U->fetch_container_e($e, $item->bucket, $class);
426     return $evt if $evt;
427
428     if( $bucket->owner ne $e->requestor->id ) {
429       my $owner = $e->retrieve_actor_user($bucket->owner)
430          or return $e->die_event;
431         return $e->event unless $e->allowed('DELETE_CONTAINER_ITEM', $owner->home_ou);
432     }
433
434     my $stat;
435     if( $class eq 'copy' ) {
436         for my $note (@{$e->search_container_copy_bucket_item_note({item => $item->id})}) {
437             return $e->event unless 
438                 $e->delete_container_copy_bucket_item_note($note);
439         }
440         return $e->event unless
441             $stat = $e->delete_container_copy_bucket_item($item);
442     }
443
444     if( $class eq 'callnumber' ) {
445         for my $note (@{$e->search_container_call_number_bucket_item_note({item => $item->id})}) {
446             return $e->event unless 
447                 $e->delete_container_call_number_bucket_item_note($note);
448         }
449         return $e->event unless
450             $stat = $e->delete_container_call_number_bucket_item($item);
451     }
452
453     if( $class eq 'biblio' ) {
454         for my $note (@{$e->search_container_biblio_record_entry_bucket_item_note({item => $item->id})}) {
455             return $e->event unless 
456                 $e->delete_container_biblio_record_entry_bucket_item_note($note);
457         }
458         return $e->event unless
459             $stat = $e->delete_container_biblio_record_entry_bucket_item($item);
460     }
461
462     if( $class eq 'user') {
463         for my $note (@{$e->search_container_user_bucket_item_note({item => $item->id})}) {
464             return $e->event unless 
465                 $e->delete_container_user_bucket_item_note($note);
466         }
467         return $e->event unless
468             $stat = $e->delete_container_user_bucket_item($item);
469     }
470
471     return $stat;
472 }
473
474
475 __PACKAGE__->register_method(
476     method  => 'full_delete',
477     api_name    => 'open-ils.actor.container.full_delete',
478     notes       => "Complety removes a container including all attached items",
479 );  
480
481 sub full_delete {
482     my( $self, $client, $authtoken, $class, $containerId ) = @_;
483     my( $container, $evt);
484
485     my $e = new_editor(xact=>1, authtoken=>$authtoken);
486     return $e->event unless $e->checkauth;
487
488     ( $container, $evt ) = $apputils->fetch_container_e($e, $containerId, $class);
489     return $evt if $evt;
490
491     if( $container->owner ne $e->requestor->id ) {
492       my $owner = $e->retrieve_actor_user($container->owner)
493          or return $e->die_event;
494         return $e->event unless $e->allowed('DELETE_CONTAINER', $owner->home_ou);
495     }
496
497     my $items; 
498
499     my @s = ({bucket => $containerId}, {idlist=>1});
500
501     if( $class eq 'copy' ) {
502         $items = $e->search_container_copy_bucket_item(@s);
503     }
504
505     if( $class eq 'callnumber' ) {
506         $items = $e->search_container_call_number_bucket_item(@s);
507     }
508
509     if( $class eq 'biblio' ) {
510         $items = $e->search_container_biblio_record_entry_bucket_item(@s);
511     }
512
513     if( $class eq 'user') {
514         $items = $e->search_container_user_bucket_item(@s);
515     }
516
517     __item_delete($e, $class, $_) for @$items;
518
519     my $stat;
520     if( $class eq 'copy' ) {
521         return $e->event unless
522             $stat = $e->delete_container_copy_bucket($container);
523     }
524
525     if( $class eq 'callnumber' ) {
526         return $e->event unless
527             $stat = $e->delete_container_call_number_bucket($container);
528     }
529
530     if( $class eq 'biblio' ) {
531         return $e->event unless
532             $stat = $e->delete_container_biblio_record_entry_bucket($container);
533     }
534
535     if( $class eq 'user') {
536         return $e->event unless
537             $stat = $e->delete_container_user_bucket($container);
538     }
539
540     $e->commit;
541     return $stat;
542 }
543
544 __PACKAGE__->register_method(
545     method      => 'container_update',
546     api_name        => 'open-ils.actor.container.update',
547     signature   => q/
548         Updates the given container item.
549         @param authtoken The login session key
550         @param class The container class
551         @param container The container item
552         @return true on success, 0 on no update, Event on error
553         /
554 );
555
556 sub container_update {
557     my( $self, $conn, $authtoken, $class, $container )  = @_;
558
559     my $e = new_editor(xact=>1, authtoken=>$authtoken);
560     return $e->event unless $e->checkauth;
561
562     my ( $dbcontainer, $evt ) = $U->fetch_container_e($e, $container->id, $class);
563     return $evt if $evt;
564
565     if( $e->requestor->id ne $container->owner ) {
566         return $e->event unless $e->allowed('UPDATE_CONTAINER');
567     }
568
569     my $stat;
570     if( $class eq 'copy' ) {
571         return $e->event unless
572             $stat = $e->update_container_copy_bucket($container);
573     }
574
575     if( $class eq 'callnumber' ) {
576         return $e->event unless
577             $stat = $e->update_container_call_number_bucket($container);
578     }
579
580     if( $class eq 'biblio' ) {
581         return $e->event unless
582             $stat = $e->update_container_biblio_record_entry_bucket($container);
583     }
584
585     if( $class eq 'user') {
586         return $e->event unless
587             $stat = $e->update_container_user_bucket($container);
588     }
589
590     $e->commit;
591     return $stat;
592 }
593
594
595
596 __PACKAGE__->register_method(
597     method  => "anon_cache",
598     api_name    => "open-ils.actor.anon_cache.set_value",
599     signature => {
600         desc => q/
601             Sets a value in the anon web cache.  If the session key is
602             undefined, one will be automatically generated.
603         /,
604         params => [
605             {desc => 'Session key', type => 'string'},
606             {
607                 desc => q/Field name.  The name of the field in this cache session whose value to set/, 
608                 type => 'string'
609             },
610             {
611                 desc => q/The cached value.  This can be any type of object (hash, array, string, etc.)/,
612                 type => 'any'
613             },
614         ],
615         return => {
616             desc => 'session key on success, undef on error',
617             type => 'string'
618         }
619     }
620 );
621
622 __PACKAGE__->register_method(
623     method  => "anon_cache",
624     api_name    => "open-ils.actor.anon_cache.get_value",
625     signature => {
626         desc => q/
627             Returns the cached data at the specified field within the specified cache session.
628         /,
629         params => [
630             {desc => 'Session key', type => 'string'},
631             {
632                 desc => q/Field name.  The name of the field in this cache session whose value to set/, 
633                 type => 'string'
634             },
635         ],
636         return => {
637             desc => 'cached value on success, undef on error',
638             type => 'any'
639         }
640     }
641 );
642
643 __PACKAGE__->register_method(
644     method  => "anon_cache",
645     api_name    => "open-ils.actor.anon_cache.delete_session",
646     signature => {
647         desc => q/
648             Deletes a cache session.
649         /,
650         params => [
651             {desc => 'Session key', type => 'string'},
652         ],
653         return => {
654             desc => 'Session key',
655             type => 'string'
656         }
657     }
658 );
659
660 sub anon_cache {
661     my($self, $conn, $ses_key, $field_key, $value) = @_;
662
663     my $sc = OpenSRF::Utils::SettingsClient->new;
664     my $cache = OpenSRF::Utils::Cache->new('anon');
665     my $cache_timeout = $sc->config_value(cache => anon => 'max_cache_time') || 1800; # 30 minutes
666     my $cache_size = $sc->config_value(cache => anon => 'max_cache_size') || 102400; # 100k
667
668     if($self->api_name =~ /delete_session/) {
669
670        return $cache->delete_cache($ses_key); 
671
672     }  elsif( $self->api_name =~ /set_value/ ) {
673
674         $ses_key = md5_hex(time . rand($$)) unless $ses_key;
675         my $blob = $cache->get_cache($ses_key) || {};
676         $blob->{$field_key} = $value;
677         return undef if 
678             length(OpenSRF::Utils::JSON->perl2JSON($blob)) > $cache_size; # bytes, characters, whatever ;)
679         $cache->put_cache($ses_key, $blob, $cache_timeout);
680         return $ses_key;
681
682     } else {
683
684         my $blob = $cache->get_cache($ses_key) or return undef;
685         return $blob if (!defined($field_key));
686         return $blob->{$field_key};
687     }
688 }
689
690 sub batch_statcat_apply {
691     my $self = shift;
692     my $client = shift;
693     my $ses = shift;
694     my $c_id = shift;
695     my $changes = shift;
696
697     # $changes is a hashref that looks like:
698     #   {
699     #       remove  => [ qw/ stat cat ids to remove / ],
700     #       apply   => { $statcat_id => $value_string, ... }
701     #   }
702
703     my $class = 'user';
704     my $max = 0;
705     my $count = 0;
706     my $stage = 0;
707
708     my $e = new_editor(xact=>1, authtoken=>$ses);
709     return $e->die_event unless $e->checkauth;
710     $client->respond({ ord => $stage++, stage => 'CONTAINER_BATCH_UPDATE_PERM_CHECK' });
711     return $e->die_event unless $e->allowed('CONTAINER_BATCH_UPDATE');
712
713     my $meth = 'retrieve_' . $ctypes{$class};
714     my $bkt = $e->$meth($c_id) or return $e->die_event;
715
716     unless($bkt->owner eq $e->requestor->id) {
717         $client->respond({ ord => $stage++, stage => 'CONTAINER_PERM_CHECK' });
718         my $owner = $e->retrieve_actor_user($bkt->owner)
719             or return $e->die_event;
720         return $e->die_event unless (
721             $e->allowed('VIEW_CONTAINER', $bkt->owning_lib) || $e->allowed('VIEW_CONTAINER', $owner->home_ou)
722         );
723     }
724
725     $meth = 'search_' . $ctypes{$class} . '_item';
726     my $contents = $e->$meth({bucket => $c_id});
727
728     if ($self->{perms}) {
729         $max = scalar(@$contents);
730         $client->respond({ ord => $stage, max => $max, count => 0, stage => 'ITEM_PERM_CHECK' });
731         for my $item (@$contents) {
732             $count++;
733             $meth = 'retrieve_' . $itypes{$class};
734             my $field = 'target_'.$ttypes{$class};
735             my $obj = $e->$meth($item->$field);
736
737             for my $perm_field (keys %{$self->{perms}}) {
738                 my $perm_def = $self->{perms}->{$perm_field};
739                 my ($pwhat,$pwhere) = ([split ' ', $perm_def], $perm_field);
740                 for my $p (@$pwhat) {
741                     $e->allowed($p, $obj->$pwhere) or return $e->die_event;
742                 }
743             }
744             $client->respond({ ord => $stage, max => $max, count => $count, stage => 'ITEM_PERM_CHECK' });
745         }
746         $stage++;
747     }
748
749     my @users = map { $_->target_user } @$contents;
750     $max = scalar(@users) * scalar(@{$changes->{remove}});
751     $count = 0;
752     $client->respond({ ord => $stage, max => $max, count => $count, stage => 'STAT_CAT_REMOVE' });
753
754     my $chunk = int($max / 10) || 1;
755     my $to_remove = $e->search_actor_stat_cat_entry_user_map({ target_usr => \@users, stat_cat => $changes->{remove} });
756     for my $t (@$to_remove) {
757         $e->delete_actor_stat_cat_entry_user_map($t);
758         $count++;
759         $client->respond({ ord => $stage, max => $max, count => $count, stage => 'STAT_CAT_REMOVE' })
760             unless ($count % $chunk);
761     }
762
763     $stage++;
764
765     $max = scalar(@users) * scalar(keys %{$changes->{apply}});
766     $count = 0;
767     $client->respond({ ord => $stage, max => $max, count => $count, stage => 'STAT_CAT_APPLY' });
768
769     $chunk = int($max / 10) || 1;
770     for my $item (@$contents) {
771         for my $astatcat (keys %{$changes->{apply}}) {
772             my $new_value = $changes->{apply}->{$astatcat};
773             my $to_change = $e->search_actor_stat_cat_entry_user_map({ target_usr => $item->target_user, stat_cat => $astatcat });
774             if (@$to_change) {
775                 $to_change = $$to_change[0];
776                 $to_change->stat_cat_entry($new_value);
777                 $e->update_actor_stat_cat_entry_user_map($to_change);
778             } else {
779                 $to_change = new Fieldmapper::actor::stat_cat_entry_user_map;
780                 $to_change->stat_cat_entry($new_value);
781                 $to_change->stat_cat($astatcat);
782                 $to_change->target_usr($item->target_user);
783                 $e->create_actor_stat_cat_entry_user_map($to_change);
784             }
785             $count++;
786             $client->respond({ ord => $stage, max => $max, count => $count, stage => 'STAT_CAT_APPLY' })
787                 unless ($count % $chunk);
788         }
789     }
790
791     $e->commit;
792
793     return { stage => 'COMPLETE' };
794 }
795
796 __PACKAGE__->register_method(
797     method  => "batch_statcat_apply",
798     api_name    => "open-ils.actor.container.user.batch_statcat_apply",
799     ctype       => 'user',
800     perms       => {
801             home_ou     => 'UPDATE_USER', # field -> perm means "test this perm with field as context OU", both old and new
802     },
803     fields      => [ qw/active profile juvenile home_ou expire_date barred net_access_level/ ],
804     signature => {
805         desc => 'Edits allowed fields on users in a bucket',
806         params => [{
807             desc => 'Session key', type => 'string',
808             desc => 'User container id',
809             desc => 'Hash of statcats to apply or remove', type => 'hash',
810         }],
811         return => {
812             desc => 'Object with the structure { stage => "stage string", max => max_for_stage, count => count_in_stage }',
813             type => 'hash'
814         }
815     }
816 );
817
818
819 sub apply_rollback {
820     my $self = shift;
821     my $client = shift;
822     my $ses = shift;
823     my $c_id = shift;
824     my $main_fsg = shift;
825
826     my $max = 0;
827     my $count = 0;
828     my $stage = 0;
829
830     my $class = $self->{ctype} or return undef;
831
832     my $e = new_editor(xact=>1, authtoken=>$ses);
833     return $e->die_event unless $e->checkauth;
834
835     for my $bp (@{$batch_perm{$class}}) {
836         return { stage => 'COMPLETE' } unless $e->allowed($bp);
837     }
838
839     $client->respond({ ord => $stage++, stage => 'CONTAINER_BATCH_UPDATE_PERM_CHECK' });
840     return $e->die_event unless $e->allowed('CONTAINER_BATCH_UPDATE');
841
842     my $meth = 'retrieve_' . $ctypes{$class};
843     my $bkt = $e->$meth($c_id) or return $e->die_event;
844
845     unless($bkt->owner eq $e->requestor->id) {
846         $client->respond({ ord => $stage++, stage => 'CONTAINER_PERM_CHECK' });
847         my $owner = $e->retrieve_actor_user($bkt->owner)
848             or return $e->die_event;
849         return $e->die_event unless (
850             $e->allowed('VIEW_CONTAINER', $bkt->owning_lib) || $e->allowed('VIEW_CONTAINER', $owner->home_ou)
851         );
852     }
853
854     $main_fsg = $e->retrieve_action_fieldset_group($main_fsg);
855     return { stage => 'COMPLETE', error => 'No field set group' } unless $main_fsg;
856
857     my $rbg = $e->retrieve_action_fieldset_group($main_fsg->rollback_group);
858     return { stage => 'COMPLETE', error => 'No rollback field set group' } unless $rbg;
859
860     my $fieldsets = $e->search_action_fieldset({fieldset_group => $rbg->id});
861     $max = scalar(@$fieldsets);
862
863     $client->respond({ ord => $stage, max => $max, count => 0, stage => 'APPLY_EDITS' });
864     for my $fs (@$fieldsets) {
865         my $res = $e->json_query({
866             from => ['action.apply_fieldset', $fs->id, $table{$class}, 'id', undef]
867         })->[0]->{'action.apply_fieldset'};
868
869         $client->respond({
870             ord => $stage,
871             max => $max,
872             count => ++$count,
873             stage => 'APPLY_EDITS',
874             error => $res ? "Could not apply fieldset ".$fs->id.": $res" : undef
875         });
876     }
877
878     $main_fsg->rollback_time('now');
879     $e->update_action_fieldset_group($main_fsg);
880
881     $e->commit;
882
883     return { stage => 'COMPLETE' };
884 }
885 __PACKAGE__->register_method(
886     method  => "apply_rollback",
887     max_bundle_count => 1,
888     api_name    => "open-ils.actor.container.user.apply_rollback",
889     ctype       => 'user',
890     signature => {
891         desc => 'Applys rollback of a fieldset group to users in a bucket',
892         params => [
893             { desc => 'Session key', type => 'string' },
894             { desc => 'User container id', type => 'number' },
895             { desc => 'Main (non-rollback) fieldset group' },
896         ],
897         return => {
898             desc => 'Object with the structure { fieldset_group => $id, stage => "COMPLETE", error => ("error string if any"|undef if none) }',
899             type => 'hash'
900         }
901     }
902 );
903
904
905 sub batch_edit {
906     my $self = shift;
907     my $client = shift;
908     my $ses = shift;
909     my $c_id = shift;
910     my $edit_name = shift;
911     my $edits = shift;
912
913     my $max = 0;
914     my $count = 0;
915     my $stage = 0;
916
917     my $class = $self->{ctype} or return undef;
918
919     my $e = new_editor(xact=>1, authtoken=>$ses);
920     return $e->die_event unless $e->checkauth;
921
922     for my $bp (@{$batch_perm{$class}}) {
923         return { stage => 'COMPLETE' } unless $e->allowed($bp);
924     }
925
926     $client->respond({ ord => $stage++, stage => 'CONTAINER_BATCH_UPDATE_PERM_CHECK' });
927     return $e->die_event unless $e->allowed('CONTAINER_BATCH_UPDATE');
928
929     my $meth = 'retrieve_' . $ctypes{$class};
930     my $bkt = $e->$meth($c_id) or return $e->die_event;
931
932     unless($bkt->owner eq $e->requestor->id) {
933         $client->respond({ ord => $stage++, stage => 'CONTAINER_PERM_CHECK' });
934         my $owner = $e->retrieve_actor_user($bkt->owner)
935             or return $e->die_event;
936         return $e->die_event unless (
937             $e->allowed('VIEW_CONTAINER', $bkt->owning_lib) || $e->allowed('VIEW_CONTAINER', $owner->home_ou)
938         );
939     }
940
941     $meth = 'search_' . $ctypes{$class} . '_item';
942     my $contents = $e->$meth({bucket => $c_id});
943
944     $max = 0;
945     $max = scalar(@$contents) if ($self->{perms});
946     $max += scalar(@$contents) if ($self->{base_perm});
947
948     my $obj_cache = {};
949     if ($self->{base_perm}) {
950         $client->respond({ ord => $stage, max => $max, count => $count, stage => 'ITEM_PERM_CHECK' });
951         for my $item (@$contents) {
952             $count++;
953             $meth = 'retrieve_' . $itypes{$class};
954             my $field = 'target_'.$ttypes{$class};
955             my $obj = $$obj_cache{$item->$field} = $e->$meth($item->$field);
956
957             for my $perm_field (keys %{$self->{base_perm}}) {
958                 my $perm_def = $self->{base_perm}->{$perm_field};
959                 my ($pwhat,$pwhere) = ([split ' ', $perm_def], $perm_field);
960                 for my $p (@$pwhat) {
961                     $e->allowed($p, $obj->$pwhere) or return $e->die_event;
962                     if ($$edits{$pwhere}) {
963                         $e->allowed($p, $$edits{$pwhere}) or do {
964                             $logger->warn("Cannot update $class ".$obj->id.", $pwhat at $pwhere not allowed.");
965                             return $e->die_event;
966                         };
967                     }
968                 }
969             }
970             $client->respond({ ord => $stage, max => $max, count => $count, stage => 'ITEM_PERM_CHECK' });
971         }
972     }
973
974     if ($self->{perms}) {
975         $client->respond({ ord => $stage, max => $max, count => $count, stage => 'ITEM_PERM_CHECK' });
976         for my $item (@$contents) {
977             $count++;
978             $meth = 'retrieve_' . $itypes{$class};
979             my $field = 'target_'.$ttypes{$class};
980             my $obj = $$obj_cache{$item->$field} || $e->$meth($item->$field);
981
982             for my $perm_field (keys %{$self->{perms}}) {
983                 my $perm_def = $self->{perms}->{$perm_field};
984                 if (ref($perm_def) eq 'HASH') { # we care about specific values being set
985                     for my $perm_value (keys %$perm_def) {
986                         if (exists $$edits{$perm_field} && $$edits{$perm_field} eq $perm_value) { # check permission
987                             while (my ($pwhat,$pwhere) = each %{$$perm_def{$perm_value}}) {
988                                 if ($pwhere eq '*') {
989                                     $pwhere = undef;
990                                 } else {
991                                     $pwhere = $obj->$pwhere;
992                                 }
993                                 $pwhat = [ split / /, $pwhat ];
994                                 for my $p (@$pwhat) {
995                                     $e->allowed($p, $pwhere) or do {
996                                         $pwhere ||= "everywhere";
997                                         $logger->warn("Cannot update $class ".$obj->id.", $pwhat at $pwhere not allowed.");
998                                         return $e->die_event;
999                                     };
1000                                 }
1001                             }
1002                         }
1003                     }
1004                 } elsif (ref($perm_def) eq 'CODE') { # we need to run the code on old and new, and pass both tests
1005                     if (exists $$edits{$perm_field}) {
1006                         $perm_def->($e, $obj->$perm_field) or return $e->die_event;
1007                         $perm_def->($e, $$edits{$perm_field}) or return $e->die_event;
1008                     }
1009                 } else { # we're checking an ou field
1010                     my ($pwhat,$pwhere) = ([split ' ', $perm_def], $perm_field);
1011                     if ($$edits{$pwhere}) {
1012                         for my $p (@$pwhat) {
1013                             $e->allowed($p, $obj->$pwhere) or return $e->die_event;
1014                             $e->allowed($p, $$edits{$pwhere}) or do {
1015                                 $logger->warn("Cannot update $class ".$obj->id.", $pwhat at $pwhere not allowed.");
1016                                 return $e->die_event;
1017                             };
1018                         }
1019                     }
1020                 }
1021             }
1022             $client->respond({ ord => $stage, max => $max, count => $count, stage => 'ITEM_PERM_CHECK' });
1023         }
1024         $stage++;
1025     }
1026
1027     $client->respond({ ord => $stage++, stage => 'FIELDSET_GROUP_CREATE' });
1028     my $fsgroup = Fieldmapper::action::fieldset_group->new;
1029     $fsgroup->isnew(1);
1030     $fsgroup->name($edit_name);
1031     $fsgroup->creator($e->requestor->id);
1032     $fsgroup->owning_lib($e->requestor->ws_ou);
1033     $fsgroup->container($c_id);
1034     $fsgroup->container_type($ttypes{$class});
1035     $fsgroup = $e->create_action_fieldset_group($fsgroup);
1036
1037     $client->respond({ ord => $stage++, stage => 'FIELDSET_CREATE' });
1038     my $fieldset = Fieldmapper::action::fieldset->new;
1039     $fieldset->isnew(1);
1040     $fieldset->fieldset_group($fsgroup->id);
1041     $fieldset->owner($e->requestor->id);
1042     $fieldset->owning_lib($e->requestor->ws_ou);
1043     $fieldset->status('PENDING');
1044     $fieldset->classname($htypes{$class});
1045     $fieldset->name($edit_name . ' batch group fieldset');
1046     $fieldset->stored_query($qtypes{$class});
1047     $fieldset = $e->create_action_fieldset($fieldset);
1048
1049     my @keys = keys %$edits;
1050     $max = scalar(@keys);
1051     $count = 0;
1052     $client->respond({ ord => $stage, count=> $count, max => $max, stage => 'FIELDSET_EDITS_CREATE' });
1053     for my $key (@keys) {
1054         if ($self->{fields}) { # restrict edits to registered fields
1055             next unless (grep { $_ eq $key } @{$self->{fields}});
1056         }
1057         my $fs_cv = Fieldmapper::action::fieldset_col_val->new;
1058         $fs_cv->isnew(1);
1059         $fs_cv->fieldset($fieldset->id);
1060         $fs_cv->col($key);
1061         $fs_cv->val($$edits{$key});
1062         $e->create_action_fieldset_col_val($fs_cv);
1063         $count++;
1064         $client->respond({ ord => $stage, count=> $count, max => $max, stage => 'FIELDSET_EDITS_CREATE' });
1065     }
1066
1067     $client->respond({ ord => ++$stage, stage => 'CONSTRUCT_QUERY' });
1068     my $qstore = OpenSRF::AppSession->connect('open-ils.qstore');
1069     my $prep = $qstore->request('open-ils.qstore.prepare', $fieldset->stored_query)->gather(1);
1070     my $token = $prep->{token};
1071     $qstore->request('open-ils.qstore.bind_param', $token, {bucket => $c_id})->gather(1);
1072     my $sql = $qstore->request('open-ils.qstore.sql', $token)->gather(1);
1073     $sql =~ s/\n\s*/ /g; # normalize the string
1074     $sql =~ s/;\s*//g; # kill trailing semicolon
1075
1076     $client->respond({ ord => ++$stage, stage => 'APPLY_EDITS' });
1077     my $res = $e->json_query({
1078         from => ['action.apply_fieldset', $fieldset->id, $table{$class}, 'id', $sql]
1079     })->[0]->{'action.apply_fieldset'};
1080
1081     $e->commit;
1082     $qstore->disconnect;
1083
1084     return { fieldset_group => $fsgroup->id, stage => 'COMPLETE', error => $res };
1085 }
1086
1087 __PACKAGE__->register_method(
1088     method  => "batch_edit",
1089     max_bundle_count => 1,
1090     api_name    => "open-ils.actor.container.user.batch_edit",
1091     ctype       => 'user',
1092     base_perm   => { home_ou => 'UPDATE_USER' },
1093     perms       => {
1094             profile => sub {
1095                 my ($e, $group) = @_;
1096                 my $g = $e->retrieve_permission_grp_tree($group);
1097                 if (my $p = $g->application_perm()) {
1098                     return $e->allowed($p);
1099                 }
1100                 return 1;
1101             }, # code ref is run with params (editor,value), for both old and new value
1102             # home_ou => 'UPDATE_USER', # field -> perm means "test this perm with field as context OU", both old and new
1103             barred  => {
1104                     t => { BAR_PATRON => 'home_ou' },
1105                     f => { UNBAR_PATRON => 'home_ou' }
1106             } # field -> struct means "if field getting value "key" check -> perm -> at context org, both old and new
1107     },
1108     fields      => [ qw/active profile juvenile home_ou expire_date barred net_access_level/ ],
1109     signature => {
1110         desc => 'Edits allowed fields on users in a bucket',
1111         params => [
1112             { desc => 'Session key', type => 'string' },
1113             { desc => 'User container id', type => 'number' },
1114             { desc => 'Batch edit name', type => 'string' },
1115             { desc => 'Edit hash, key is column, value is new value to apply', type => 'hash' },
1116         ],
1117         return => {
1118             desc => 'Object with the structure { fieldset_group => $id, stage => "COMPLETE", error => ("error string if any"|undef if none) }',
1119             type => 'hash'
1120         }
1121     }
1122 );
1123
1124 __PACKAGE__->register_method(
1125     method  => "batch_edit",
1126     api_name    => "open-ils.actor.container.user.batch_delete",
1127     ctype       => 'user',
1128     perms       => {
1129             deleted => {
1130                     t => { 'DELETE_USER UPDATE_USER' => 'home_ou' },
1131                     f => { 'UPDATE_USER' => 'home_ou' }
1132             }
1133     },
1134     fields      => [ qw/deleted/ ],
1135     signature => {
1136         desc => 'Deletes users in a bucket',
1137         params => [{
1138             { desc => 'Session key', type => 'string' },
1139             { desc => 'User container id', type => 'number' },
1140             { desc => 'Batch delete name', type => 'string' },
1141             { desc => 'Edit delete, key is "deleted", value is new value to apply ("t")', type => 'hash' },
1142             
1143         }],
1144         return => {
1145             desc => 'Object with the structure { fieldset_group => $id, stage => "COMPLETE", error => ("error string if any"|undef if none) }',
1146             type => 'hash'
1147         }
1148     }
1149 );
1150
1151
1152
1153 1;
1154
1155