Open-ILS/src/perlmods/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/OpenSRF::Application/;
  18 use strict; use warnings;
  19 use OpenSRF::EX qw/:try/;
  20 use OpenILS::Application::AppUtils;
  21 use Data::Dumper;
  22 use Time::HiRes qw(time);
  23
  24 my $apputils = "OpenILS::Application::AppUtils";
  25
  26 # - creates a new survey
  27 # expects a survey complete with questions and answers
  28 __PACKAGE__->register_method(
  29         method  => "add_survey",
  30         api_name        => "open-ils.circ.survey.create");
  31
  32 sub add_survey {
  33         my( $self, $client, $user_session, $survey ) = @_;
  34
  35         my $user_obj = $apputils->check_user_session($user_session);
  36         my $session = $apputils->start_db_session();
  37         my $err = undef; my $id;
  38
  39         warn "Creating new survey\n" . Dumper($survey) . "\n";
  40
  41
  42         try {
  43
  44                 $survey = _add_survey($session, $survey);
  45                 _add_questions($session, $survey);
  46                 $apputils->commit_db_session($session);
  47
  48         } catch Error with {
  49                 my $e = shift;
  50                 $err = "Error creating survey: $e\n";
  51                 $apputils->rollback_db_session($session);
  52         };
  53
  54         if($err) { throw OpenSRF::EX::ERROR ($err); }
  55
  56         # re-retrieve the survey from the db and return it
  57         return $self->get_fleshed_survey( $client, $survey->id() );
  58 }
  59
  60
  61 sub _add_survey {
  62         my($session, $survey) = @_;
  63         my $req = $session->request(
  64                 "open-ils.storage.direct.action.survey.create",
  65                 $survey );
  66
  67         my $id = $req->gather(1);
  68
  69         if(!$id) {
  70                 throw OpenSRF::EX::ERROR
  71                         ("Unable to create new survey " . $survey->name());
  72         }
  73
  74         warn "Created new survey with id $id\n";
  75         $survey->id($id);
  76         return $survey;
  77 }
  78
  79 sub _update_survey {
  80         my($session, $survey) = @_;
  81 }
  82
  83 sub _add_questions {
  84         my($session, $survey) = @_;
  85
  86         # create new questions in the db
  87         if( $survey->questions() ) {
  88                 for my $question (@{$survey->questions()}){
  89
  90                         $question->survey($survey->id());
  91                         my $virtual_id = $question->id();
  92                         $question->clear_id();
  93
  94
  95                         warn "Creating new question: " . $question->question() . "\n";
  96                         warn Dumper $question;
  97
  98                         my $req = $session->request(
  99                                 'open-ils.storage.direct.action.survey_question.create',
 100                                 $question );
 101                         my $new_id = $req->gather(1);
 102
 103                         if(!$new_id) {
 104                                 throw OpenSRF::EX::ERROR
 105                                         ("Error creating new survey question " . $question->question() . "\n")
 106                         }
 107
 108                         warn "added new question with id $new_id\n";
 109
 110                         # now update the responses to this question
 111                         if($question->answers()) {
 112                                 for my $answer (@{$question->answers()}) {
 113                                         $answer->question($new_id);
 114                                         _add_answer($session,$answer);
 115                                 }
 116                         }
 117                 }
 118         }
 119 }
 120
 121
 122 sub _add_answer {
 123         my($session, $answer) = @_;
 124         warn "Adding answer " . $answer->answer() . "\n";
 125         $answer->clear_id();
 126         my $req = $session->request(
 127                 "open-ils.storage.direct.action.survey_answer.create",
 128                 $answer );
 129         my $id = $req->gather(1);
 130         if(!$id) {
 131                 throw OpenSRF::EX::ERROR
 132                         ("Error creating survey answer " . $answer->answer() );
 133         }
 134
 135         warn "Added new answer with id $id\n";
 136 }
 137
 138
 139
 140 # retrieve surveys for a specific org subtree.
 141 __PACKAGE__->register_method(
 142         method  => "get_required_surveys",
 143         api_name        => "open-ils.circ.survey.retrieve.required");
 144
 145 sub get_required_surveys {
 146         my( $self, $client, $user_session ) = @_;
 147
 148         warn "Retrieving required surveys\n";
 149
 150         my $user_obj = $apputils->check_user_session($user_session);
 151         my $orgid = $user_obj->ws_ou() ? $user_obj->ws_ou() : $user_obj->home_ou();
 152         my $surveys = $apputils->simple_scalar_request(
 153                 "open-ils.storage",
 154                 "open-ils.storage.action.survey.required.atomic",
 155                 $orgid );
 156
 157         if($surveys) {
 158                 warn "Retrieved " . scalar(@$surveys)." required surveys\n";
 159         }
 160
 161         my @fleshed;
 162         for my $survey (@$surveys) {
 163                 push(@fleshed, $self->get_fleshed_survey($client, $survey));
 164         }
 165         return \@fleshed;
 166
 167 }
 168
 169 __PACKAGE__->register_method(
 170         method  => "get_survey_responses",
 171         api_name        => "open-ils.circ.survey.response.retrieve");
 172
 173 sub get_survey_responses {
 174         my( $self, $client, $user_session, $survey_id, $user_id ) = @_;
 175
 176         warn "retrieing responses $user_session $survey_id $user_id\n";
 177         if(!$user_id) {
 178                 my $user_obj = $apputils->check_user_session($user_session);
 179                 $user_id = $user_obj->id;
 180         }
 181
 182         my $res = $apputils->simple_scalar_request(
 183                 "open-ils.storage",
 184                 "open-ils.storage.direct.action.survey_response.search.atomic",
 185                 { usr => $user_id, survey => $survey_id } );
 186
 187         warn "Surveys: " .  Dumper($res);
 188
 189         if( $res && ref($res) and $res->[0]) {
 190                 return [ sort { $a->id() <=> $b->id() } @$res ];
 191         }
 192
 193         return [];
 194 }
 195
 196 __PACKAGE__->register_method(
 197         method  => "get_all_surveys",
 198         api_name        => "open-ils.circ.survey.retrieve.all");
 199
 200 sub get_all_surveys {
 201         my( $self, $client, $user_session ) = @_;
 202
 203         my $user_obj = $apputils->check_user_session($user_session);
 204         my $orgid = $user_obj->ws_ou() ? $user_obj->ws_ou() : $user_obj->home_ou();
 205         my $surveys = $apputils->simple_scalar_request(
 206                 "open-ils.storage",
 207                 "open-ils.storage.action.survey.all.atomic",
 208                 $orgid );
 209
 210         my @fleshed;
 211         for my $survey (@$surveys) {
 212                 push(@fleshed, $self->get_fleshed_survey($client, $survey));
 213         }
 214         return \@fleshed;
 215 }
 216
 217
 218
 219
 220 __PACKAGE__->register_method(
 221         method  => "get_fleshed_survey",
 222         api_name        => "open-ils.circ.survey.fleshed.retrieve");
 223
 224 sub get_fleshed_survey {
 225         my( $self, $client, $survey_id ) = @_;
 226
 227         my $session = OpenSRF::AppSession->create("open-ils.storage");
 228
 229         warn "Searching for survey $survey_id\n";
 230
 231         my $survey;
 232         if( ref($survey_id) and
 233                         (ref($survey_id) =~ /^Fieldmapper/)) {
 234                 $survey = $survey_id;
 235
 236         } else {
 237
 238                 my $sreq = $session->request(
 239                         "open-ils.storage.direct.action.survey.retrieve",
 240                         $survey_id );
 241                 $survey = $sreq->gather(1);
 242                 if(! $survey) { return undef; }
 243         }
 244
 245         $survey->questions([]);
 246
 247
 248         warn "Grabbing survey questions\n";
 249         my $qreq = $session->request(
 250                 "open-ils.storage.direct.action.survey_question.search.survey.atomic",
 251                 $survey->id() );
 252
 253         my $questions = $qreq->gather(1);
 254         use Data::Dumper;
 255         warn "Question: " . Dumper($questions);
 256
 257         if($questions) {
 258
 259                 for my $question (@$questions) {
 260                         next unless defined $question;
 261
 262                         # add this question to the survey
 263                         push( @{$survey->questions()}, $question );
 264
 265                         warn "Grabbing question answers\n";
 266
 267                         my $ans_req = $session->request(
 268                                 "open-ils.storage.direct.action.survey_answer.search.question.atomic",
 269                                 $question->id() );
 270
 271                         # add this array of answers to this question
 272                         $question->answers( $ans_req->gather(1) );
 273
 274                 }
 275         }
 276
 277         $session->disconnect();
 278         return $survey;
 279
 280 }
 281
 282
 283
 284 __PACKAGE__->register_method(
 285         method  => "submit_survey",
 286         api_name        => "open-ils.circ.survey.submit.session");
 287
 288 __PACKAGE__->register_method(
 289         method  => "submit_survey",
 290         api_name        => "open-ils.circ.survey.submit.user_id");
 291
 292 __PACKAGE__->register_method(
 293         method  => "submit_survey",
 294         api_name        => "open-ils.circ.survey.submit.anon");
 295
 296
 297 sub submit_survey {
 298         my( $self, $client, $responses ) = @_;
 299
 300         if(!$responses) {
 301                 throw OpenSRF::EX::ERROR
 302                         ("No survey object sent in update");
 303         }
 304
 305         use Data::Dumper;
 306         warn "Submitting survey " . Dumper($responses) . "\n";
 307
 308         if(!ref($responses)) { $responses = [$responses]; }
 309
 310         my $session = $apputils->start_db_session();
 311
 312         my $group_id = $session->request(
 313                 "open-ils.storage.action.survey_response.next_group_id")->gather(1);
 314
 315         my %already_seen;
 316         for my $res (@$responses) {
 317
 318                 my $id;
 319
 320                 if($self->api_name =~ /session/) {
 321                         if( ! ($id = $already_seen{$res->usr}) ) {
 322                                 my $user_obj = $apputils->check_user_session($res->usr);
 323                                 $id = $user_obj->id;
 324                                 $already_seen{$res->usr} = $id;
 325                         }
 326                         $res->usr($id);
 327                 } elsif( $self->api_name =~ /anon/ ) {
 328                         $res->clear_usr();
 329                 }
 330
 331                 warn "Submitting response with question " .
 332                         $res->question . " and group $group_id \n";
 333
 334                 $res->response_group_id($group_id);
 335                 my $req = $session->request(
 336                         "open-ils.storage.direct.action.survey_response.create",
 337                         $res );
 338                 my $newid = $req->gather(1);
 339                 warn "New response id: $newid\n";
 340
 341                 if(!$newid) {
 342                         throw OpenSRF::EX::ERROR
 343                                 ("Error creating new survey response");
 344                 }
 345         }
 346
 347         $apputils->commit_db_session($session);
 348         warn "survey response update completed\n";
 349
 350         return 1;
 351 }
 352
 353
 354 __PACKAGE__->register_method(
 355         method  => "get_random_survey",
 356         api_name        => "open-ils.circ.survey.retrieve.opac.random");
 357
 358 sub get_random_survey {
 359         my( $self, $client, $user_session ) = @_;
 360
 361         warn "retrieving random survey\n";
 362         my $user_obj = $apputils->check_user_session($user_session);
 363         my $surveys = $apputils->simple_scalar_request(
 364                 "open-ils.storage",
 365                 "open-ils.storage.action.survey.opac.atomic",
 366                 $user_obj->home_ou() );
 367
 368         my $random = int(rand(scalar(@$surveys)));
 369         warn "Random survey index for process $$ is $random\n";
 370         my $surv = $surveys->[$random];
 371
 372         return $self->get_fleshed_survey($client, $surv);
 373
 374 }
 375
 376 __PACKAGE__->register_method(
 377         method  => "get_random_survey_global",
 378         api_name        => "open-ils.circ.survey.retrieve.opac.random.global");
 379
 380 sub get_random_survey_global {
 381         my( $self, $client ) = @_;
 382
 383         warn "retrieving random global survey\n";
 384         my $surveys = $apputils->simple_scalar_request(
 385                 "open-ils.storage",
 386                 "open-ils.storage.direct.action.survey.search.atomic",
 387                 # XXX grab the org tree to get the root id...
 388                 { owner => 1, opac => 't' } );
 389
 390         my $random = int(rand(scalar(@$surveys)));
 391         warn "Random survey index for process $$ is $random\n";
 392         my $surv = $surveys->[$random];
 393
 394         return $self->get_fleshed_survey($client, $surv);
 395
 396 }
 397
 398
 399
 400
 401
 402
 403
 404
 405
 406
 407 1;
 408
 409
 410
 411
 412