Open-ILS/src/perlmods/lib/OpenILS/Application/Circ/Survey.pm

   1 # ---------------------------------------------------------------
   2 # Copyright (C) 2005  Georgia Public Library Service
   3 # Bill Erickson <highfalutin@gmail.com>
   4
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 # ---------------------------------------------------------------
  15
  16 package OpenILS::Application::Circ::Survey;
  17 use base qw/OpenILS::Application/;
  18 use strict; use warnings;
  19 use OpenSRF::EX qw/:try/;
  20 use OpenILS::Application::AppUtils;
  21 use Data::Dumper;
  22 use OpenILS::Event;
  23 use Time::HiRes qw(time);
  24 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  25 use OpenSRF::Utils::Logger qw/$logger/;
  26
  27 my $apputils = "OpenILS::Application::AppUtils";
  28
  29 __PACKAGE__->register_method(
  30     method => "update_survey",
  31     api_name => "open-ils.circ.survey.update",
  32     signature => {
  33         desc => q/Create, update, delete surveys, survey questions, and
  34             survey answers.  Relies on isnew ; isnchanged ; isdeleted
  35             attributes of provided objects to determine outcome.
  36         /,
  37         params => [
  38             {desc => 'Authtoken', type => 'string'},
  39             {desc => 'Fleshed survey (asv) object', type => 'object'}
  40         ],
  41         return => '1 on success, event on error'
  42     }
  43 );
  44
  45
  46 sub update_survey {
  47     my ($self, $client, $auth, $survey) = @_;
  48
  49     my $e = new_editor(authtoken => $auth, xact => 1);
  50     return $e->die_event unless $e->checkauth;
  51     return $e->die_event unless $e->allowed('ADMIN_SURVEY', $survey->owner);
  52
  53     my $questions = $survey->questions || [];
  54
  55     if ($survey->isdeleted) {
  56
  57         $questions = $e->search_action_survey_question({survey => $survey->id});
  58         $_->isdeleted(1) for @$questions;
  59         $survey->questions($questions);
  60
  61         # Remove dependent data first.
  62         return $e->die_event if update_questions($e, $survey);
  63         return $e->die_event unless $e->delete_action_survey($survey);
  64
  65     } else {
  66
  67         if ($survey->isnew) {
  68
  69             $survey->clear_id;
  70             return $e->die_event unless $e->create_action_survey($survey);
  71
  72             $_->isnew(1) for @$questions;
  73
  74         } elsif ($survey->ischanged) {
  75
  76             return $e->die_event unless $e->update_action_survey($survey);
  77         }
  78
  79         return $e->die_event if update_questions($e, $survey);
  80     }
  81
  82     $e->commit;
  83
  84     $e->xact_begin;
  85     $survey = $e->retrieve_action_survey([
  86         $survey->id,
  87         {   flesh => 2,
  88             flesh_fields => {asv => ['questions'], 'asvq' => ['answers']}
  89         }
  90     ]);
  91     $e->rollback;
  92
  93     return $survey;
  94 }
  95
  96 # returns undef on success, event on error
  97 sub update_questions {
  98     my ($e, $survey) = @_;
  99
 100     for my $question (@{$survey->questions}) {
 101
 102         if ($question->isdeleted) {
 103
 104             # Get the full set
 105             my $answers =
 106                 $e->search_action_survey_answer({question => $question->id});
 107             $_->isdeleted(1) for @$answers;
 108             $question->answers($answers);
 109
 110             # Delete linked objects first.
 111             return 1 if update_answers($e, $question);
 112             return $e->die_event
 113                 unless $e->delete_action_survey_question($question);
 114
 115         } else {
 116
 117             if ($question->ischanged) {
 118
 119                 return $e->die_event
 120                     unless $e->update_action_survey_question($question);
 121
 122             } elsif ($question->isnew) {
 123
 124                 $question->survey($survey->id);
 125                 $question->clear_id;
 126
 127                 return $e->die_event unless $e->create_action_survey_question($question);
 128             }
 129
 130             return 1 if update_answers($e, $question);
 131         }
 132     }
 133
 134     return undef;
 135 }
 136
 137 sub update_answers {
 138     my ($e, $question) = @_;
 139
 140     return undef unless $question->answers;
 141
 142     for my $answer (@{$question->answers}) {
 143
 144         if ($answer->isdeleted) {
 145             my $responses =
 146                 $e->search_action_survey_response({answer => $answer->id});
 147
 148             for my $response (@$responses) {
 149                 return $e->die_event unless
 150                     $e->delete_action_survey_response($response);
 151             }
 152
 153             return $e->die_event unless $e->delete_action_survey_answer($answer);
 154
 155         } elsif ($answer->isnew) {
 156
 157             $answer->clear_id;
 158             $answer->question($question->id);
 159
 160             return $e->die_event
 161                 unless $e->create_action_survey_answer($answer);
 162
 163         } elsif ($answer->ischanged) {
 164             return $e->die_event
 165                 unless $e->update_action_survey_answer($answer);
 166         }
 167     }
 168
 169     return undef;
 170 }
 171
 172
 173
 174 # - creates a new survey
 175 # expects a survey complete with questions and answers
 176 __PACKAGE__->register_method(
 177     method  => "add_survey",
 178     api_name    => "open-ils.circ.survey.create");
 179
 180 sub add_survey {
 181     my( $self, $client, $user_session, $survey ) = @_;
 182
 183     my($user_obj, $evt) = $apputils->checkses($user_session);
 184     return $evt if $evt;
 185
 186     my $session = $apputils->start_db_session();
 187     $apputils->set_audit_info($session, $user_session, $user_obj->id, $user_obj->wsid);
 188     my $err = undef; my $id;
 189
 190
 191     try {
 192
 193         $survey = _add_survey($session, $survey);
 194         _add_questions($session, $survey);
 195         $apputils->commit_db_session($session);
 196
 197     } catch Error with {
 198         my $e = shift;
 199         $err = "Error creating survey: $e\n";
 200         $apputils->rollback_db_session($session);
 201     };
 202
 203     if($err) { throw OpenSRF::EX::ERROR ($err); }
 204
 205     # re-retrieve the survey from the db and return it
 206     return get_fleshed_survey($self, $client, $survey->id() );
 207 }
 208
 209
 210 sub _add_survey {
 211     my($session, $survey) = @_;
 212     my $req = $session->request(
 213         "open-ils.storage.direct.action.survey.create",
 214         $survey );
 215
 216     my $id = $req->gather(1);
 217
 218     if(!$id) {
 219         throw OpenSRF::EX::ERROR
 220             ("Unable to create new survey " . $survey->name());
 221     }
 222
 223     $survey->id($id);
 224     return $survey;
 225 }
 226
 227 sub _add_questions {
 228     my($session, $survey) = @_;
 229
 230     # create new questions in the db
 231     if( $survey->questions() ) {
 232         for my $question (@{$survey->questions()}){
 233
 234             $question->survey($survey->id());
 235             my $virtual_id = $question->id();
 236             $question->clear_id();
 237
 238
 239             my $req = $session->request(
 240                 'open-ils.storage.direct.action.survey_question.create',
 241                 $question );
 242             my $new_id = $req->gather(1);
 243
 244             if(!$new_id) {
 245                 throw OpenSRF::EX::ERROR
 246                     ("Error creating new survey question " . $question->question() . "\n")
 247             }
 248
 249             # now update the responses to this question
 250             if($question->answers()) {
 251                 for my $answer (@{$question->answers()}) {
 252                     $answer->question($new_id);
 253                     _add_answer($session,$answer);
 254                 }
 255             }
 256         }
 257     }
 258 }
 259
 260
 261 sub _add_answer {
 262     my($session, $answer) = @_;
 263     $answer->clear_id();
 264     my $req = $session->request(
 265         "open-ils.storage.direct.action.survey_answer.create",
 266         $answer );
 267     my $id = $req->gather(1);
 268     if(!$id) {
 269         throw OpenSRF::EX::ERROR
 270             ("Error creating survey answer " . $answer->answer() );
 271     }
 272
 273 }
 274
 275
 276
 277 # retrieve surveys for a specific org subtree.
 278 __PACKAGE__->register_method(
 279     method  => "get_required_surveys",
 280     api_name    => "open-ils.circ.survey.retrieve.required");
 281
 282 sub get_required_surveys {
 283     my( $self, $client, $user_session ) = @_;
 284
 285
 286     my ($user_obj, $evt) = $apputils->checkses($user_session);
 287     return $evt if $evt;
 288
 289     my $orgid = $user_obj->ws_ou() ? $user_obj->ws_ou() : $user_obj->home_ou();
 290     my $surveys = $apputils->simple_scalar_request(
 291         "open-ils.storage",
 292         "open-ils.storage.action.survey.required.atomic",
 293         $orgid );
 294
 295     my @fleshed;
 296     for my $survey (@$surveys) {
 297         push(@fleshed, get_fleshed_survey($self, $client, $survey));
 298     }
 299     return \@fleshed;
 300
 301 }
 302
 303 __PACKAGE__->register_method(
 304     method  => "get_survey_responses",
 305     api_name    => "open-ils.circ.survey.response.retrieve");
 306
 307 sub get_survey_responses {
 308     my( $self, $client, $user_session, $survey_id, $user_id ) = @_;
 309
 310     if(!$user_id) {
 311         my ($user_obj, $evt) = $apputils->checkses($user_session);
 312         return $evt if $evt;
 313         $user_id = $user_obj->id;
 314     }
 315
 316     my $res = $apputils->simple_scalar_request(
 317         "open-ils.cstore",
 318         "open-ils.cstore.direct.action.survey_response.search.atomic",
 319         { usr => $user_id, survey => $survey_id } );
 320
 321     if( $res && ref($res) and $res->[0]) {
 322         return [ sort { $a->id() <=> $b->id() } @$res ];
 323     }
 324
 325     return [];
 326 }
 327
 328 __PACKAGE__->register_method(
 329     method  => "get_all_surveys",
 330     api_name    => "open-ils.circ.survey.retrieve.all");
 331
 332 sub get_all_surveys {
 333     my( $self, $client, $user_session ) = @_;
 334
 335     my ($user_obj, $evt) = $apputils->checkses($user_session);
 336     return $evt if $evt;
 337
 338     my $orgid = $user_obj->ws_ou() ? $user_obj->ws_ou() : $user_obj->home_ou();
 339     my $surveys = $apputils->simple_scalar_request(
 340         "open-ils.storage",
 341         "open-ils.storage.action.survey.all.atomic",
 342         $orgid );
 343
 344     my @fleshed;
 345     for my $survey (@$surveys) {
 346         push(@fleshed, get_fleshed_survey($self, $client, $survey));
 347     }
 348     return \@fleshed;
 349 }
 350
 351
 352
 353
 354 __PACKAGE__->register_method(
 355     method  => "get_fleshed_survey",
 356     api_name    => "open-ils.circ.survey.fleshed.retrieve");
 357
 358 sub get_fleshed_survey {
 359     my( $self, $client, $survey_id ) = @_;
 360
 361     my $session = OpenSRF::AppSession->create("open-ils.storage");
 362
 363     my $survey;
 364     if( ref($survey_id) and
 365             (ref($survey_id) =~ /^Fieldmapper/)) {
 366         $survey = $survey_id;
 367
 368     } else {
 369
 370         my $sreq = $session->request(
 371             "open-ils.storage.direct.action.survey.retrieve",
 372             $survey_id );
 373         $survey = $sreq->gather(1);
 374         if(! $survey) { return undef; }
 375     }
 376
 377     $survey->questions([]);
 378
 379
 380     my $qreq = $session->request(
 381         "open-ils.storage.direct.action.survey_question.search.survey.atomic",
 382         $survey->id() );
 383
 384     my $questions = $qreq->gather(1);
 385
 386     if($questions) {
 387
 388         for my $question (@$questions) {
 389             next unless defined $question;
 390
 391             # add this question to the survey
 392             push( @{$survey->questions()}, $question );
 393
 394
 395             my $ans_req = $session->request(
 396                 "open-ils.storage.direct.action.survey_answer.search.question.atomic",
 397                 $question->id() );
 398
 399             # add this array of answers to this question
 400             $question->answers( $ans_req->gather(1) );
 401
 402         }
 403     }
 404
 405     $session->disconnect();
 406     return $survey;
 407
 408 }
 409
 410
 411
 412 __PACKAGE__->register_method(
 413     method  => "submit_survey",
 414     api_name    => "open-ils.circ.survey.submit.session");
 415
 416 __PACKAGE__->register_method(
 417     method  => "submit_survey",
 418     api_name    => "open-ils.circ.survey.submit.user_id");
 419
 420 __PACKAGE__->register_method(
 421     method  => "submit_survey",
 422     api_name    => "open-ils.circ.survey.submit.anon");
 423
 424
 425 sub submit_survey {
 426     my( $self, $client, $responses ) = @_;
 427
 428     if(!$responses) {
 429         throw OpenSRF::EX::ERROR
 430             ("No survey object sent in update");
 431     }
 432
 433
 434     if(!ref($responses)) { $responses = [$responses]; }
 435
 436     my $session = $apputils->start_db_session();
 437
 438     my $group_id = $session->request(
 439         "open-ils.storage.action.survey_response.next_group_id")->gather(1);
 440
 441     my %already_seen;
 442     for my $res (@$responses) {
 443
 444         my $id;
 445
 446         if($self->api_name =~ /session/) {
 447             if( ! ($id = $already_seen{$res->usr}) ) {
 448                 my ($user_obj, $evt) = $apputils->checkses($res->usr);
 449                 return $evt if $evt;
 450                 $id = $user_obj->id;
 451                 $already_seen{$res->usr} = $id;
 452             }
 453             $res->usr($id);
 454         } elsif( $self->api_name =~ /anon/ ) {
 455             $res->clear_usr();
 456         }
 457
 458         $res->response_group_id($group_id);
 459         my $req = $session->request(
 460             "open-ils.storage.direct.action.survey_response.create",
 461             $res );
 462         my $newid = $req->gather(1);
 463
 464         if(!$newid) {
 465             throw OpenSRF::EX::ERROR
 466                 ("Error creating new survey response");
 467         }
 468     }
 469
 470     $apputils->commit_db_session($session);
 471
 472     return 1;
 473 }
 474
 475
 476 __PACKAGE__->register_method(
 477     method  => "get_random_survey",
 478     api_name    => "open-ils.circ.survey.retrieve.opac.random");
 479
 480 sub get_random_survey {
 481     my( $self, $client, $user_session ) = @_;
 482
 483     my ($user_obj, $evt) = $apputils->checkses($user_session);
 484     return $evt if $evt;
 485
 486     my $surveys = $apputils->simple_scalar_request(
 487         "open-ils.storage",
 488         "open-ils.storage.action.survey.opac.atomic",
 489         $user_obj->home_ou() );
 490
 491     my $random = int(rand(scalar(@$surveys)));
 492     my $surv = $surveys->[$random];
 493
 494     return get_fleshed_survey($self, $client, $surv);
 495
 496 }
 497
 498 __PACKAGE__->register_method(
 499     method  => "get_random_survey_global",
 500     api_name    => "open-ils.circ.survey.retrieve.opac.random.global");
 501
 502 sub get_random_survey_global {
 503     my( $self, $client ) = @_;
 504
 505     my $surveys = $apputils->simple_scalar_request(
 506         "open-ils.storage",
 507         "open-ils.storage.direct.action.survey.search.atomic",
 508         # XXX grab the org tree to get the root id...
 509         { owner => 1, opac => 't' } );
 510
 511     my $random = int(rand(scalar(@$surveys)));
 512     my $surv = $surveys->[$random];
 513
 514     return get_fleshed_survey($self, $client, $surv);
 515
 516 }
 517
 518
 519 __PACKAGE__->register_method (
 520     method      => 'delete_survey',
 521     api_name    => 'open-ils.circ.survey.delete.cascade'
 522 );
 523 __PACKAGE__->register_method (
 524     method      => 'delete_survey',
 525     api_name    => 'open-ils.circ.survey.delete.cascade.override'
 526 );
 527
 528 sub delete_survey {
 529     my($self, $conn, $auth, $survey_id, $oargs) = @_;
 530     my $e = new_editor(authtoken => $auth, xact => 1);
 531     return $e->die_event unless $e->checkauth;
 532     $oargs = { all => 1 } unless defined $oargs;
 533
 534     my $survey = $e->retrieve_action_survey($survey_id)
 535         or return $e->die_event;
 536     return $e->die_event unless $e->allowed('ADMIN_SURVEY', $survey->owner);
 537
 538     my $questions = $e->search_action_survey_question({survey => $survey_id});
 539     my @answers;
 540     push(@answers, @{$e->search_action_survey_answer({question => $_->id})}) for @$questions;
 541     my $responses = $e->search_action_survey_response({survey => $survey_id});
 542
 543     return OpenILS::Event->new('SURVEY_RESPONSES_EXIST')
 544         if @$responses and ($self->api_name =! /override/ || !($oargs->{all} || grep { $_ eq 'SURVEY_RESPONSES_EXIST' } @{$oargs->{events}}));
 545
 546     for my $resp (@$responses) {
 547         $e->delete_action_survey_response($resp) or return $e->die_event;
 548     }
 549
 550     for my $ans (@answers) {
 551         $e->delete_action_survey_answer($ans) or return $e->die_event;
 552     }
 553
 554     for my $quest (@$questions) {
 555         $e->delete_action_survey_question($quest) or return $e->die_event;
 556     }
 557
 558     $e->delete_action_survey($survey) or return $e->die_event;
 559
 560     $e->commit;
 561     return 1;
 562 }
 563
 564
 565
 566
 567
 568 1;