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 $surveys = $apputils->simple_scalar_request(
 205                 "open-ils.storage",
 206                 "open-ils.storage.action.survey.all.atomic",
 207                 $user_obj->home_ou() );
 208
 209         my @fleshed;
 210         for my $survey (@$surveys) {
 211                 push(@fleshed, $self->get_fleshed_survey($client, $survey));
 212         }
 213         return \@fleshed;
 214 }
 215
 216
 217
 218
 219 __PACKAGE__->register_method(
 220         method  => "get_fleshed_survey",
 221         api_name        => "open-ils.circ.survey.fleshed.retrieve");
 222
 223 sub get_fleshed_survey {
 224         my( $self, $client, $survey_id ) = @_;
 225
 226         my $session = OpenSRF::AppSession->create("open-ils.storage");
 227
 228         warn "Searching for survey $survey_id\n";
 229
 230         my $survey;
 231         if( ref($survey_id) and
 232                         (ref($survey_id) =~ /^Fieldmapper/)) {
 233                 $survey = $survey_id;
 234
 235         } else {
 236
 237                 my $sreq = $session->request(
 238                         "open-ils.storage.direct.action.survey.retrieve",
 239                         $survey_id );
 240                 $survey = $sreq->gather(1);
 241                 if(! $survey) { return undef; }
 242         }
 243
 244         $survey->questions([]);
 245
 246
 247         warn "Grabbing survey questions\n";
 248         my $qreq = $session->request(
 249                 "open-ils.storage.direct.action.survey_question.search.survey.atomic",
 250                 $survey->id() );
 251
 252         my $questions = $qreq->gather(1);
 253         use Data::Dumper;
 254         warn "Question: " . Dumper($questions);
 255
 256         if($questions) {
 257
 258                 for my $question (@$questions) {
 259                         next unless defined $question;
 260
 261                         # add this question to the survey
 262                         push( @{$survey->questions()}, $question );
 263
 264                         warn "Grabbing question answers\n";
 265
 266                         my $ans_req = $session->request(
 267                                 "open-ils.storage.direct.action.survey_answer.search.question.atomic",
 268                                 $question->id() );
 269
 270                         # add this array of answers to this question
 271                         $question->answers( $ans_req->gather(1) );
 272
 273                 }
 274         }
 275
 276         $session->disconnect();
 277         return $survey;
 278
 279 }
 280
 281
 282
 283 __PACKAGE__->register_method(
 284         method  => "submit_survey",
 285         api_name        => "open-ils.circ.survey.submit.session");
 286
 287 __PACKAGE__->register_method(
 288         method  => "submit_survey",
 289         api_name        => "open-ils.circ.survey.submit.user_id");
 290
 291 __PACKAGE__->register_method(
 292         method  => "submit_survey",
 293         api_name        => "open-ils.circ.survey.submit.anon");
 294
 295
 296 sub submit_survey {
 297         my( $self, $client, $responses ) = @_;
 298
 299         if(!$responses) {
 300                 throw OpenSRF::EX::ERROR
 301                         ("No survey object sent in update");
 302         }
 303
 304         use Data::Dumper;
 305         warn "Submitting survey " . Dumper($responses) . "\n";
 306
 307         if(!ref($responses)) { $responses = [$responses]; }
 308
 309         my $session = $apputils->start_db_session();
 310
 311         my $group_id = $session->request(
 312                 "open-ils.storage.action.survey_response.next_group_id")->gather(1);
 313
 314         my %already_seen;
 315         for my $res (@$responses) {
 316
 317                 my $id;
 318
 319                 if($self->api_name =~ /session/) {
 320                         if( ! ($id = $already_seen{$res->usr}) ) {
 321                                 my $user_obj = $apputils->check_user_session($res->usr);
 322                                 $id = $user_obj->id;
 323                                 $already_seen{$res->usr} = $id;
 324                         }
 325                         $res->usr($id);
 326                 } elsif( $self->api_name =~ /anon/ ) {
 327                         $res->clear_usr();
 328                 }
 329
 330                 warn "Submitting response with question " .
 331                         $res->question . " and group $group_id \n";
 332
 333                 $res->response_group_id($group_id);
 334                 my $req = $session->request(
 335                         "open-ils.storage.direct.action.survey_response.create",
 336                         $res );
 337                 my $newid = $req->gather(1);
 338                 warn "New response id: $newid\n";
 339
 340                 if(!$newid) {
 341                         throw OpenSRF::EX::ERROR
 342                                 ("Error creating new survey response");
 343                 }
 344         }
 345
 346         $apputils->commit_db_session($session);
 347         warn "survey response update completed\n";
 348
 349         return 1;
 350 }
 351
 352
 353 __PACKAGE__->register_method(
 354         method  => "get_random_survey",
 355         api_name        => "open-ils.circ.survey.retrieve.opac.random");
 356
 357 sub get_random_survey {
 358         my( $self, $client, $user_session ) = @_;
 359
 360         warn "retrieving random survey\n";
 361         my $user_obj = $apputils->check_user_session($user_session);
 362         my $surveys = $apputils->simple_scalar_request(
 363                 "open-ils.storage",
 364                 "open-ils.storage.action.survey.opac.atomic",
 365                 $user_obj->home_ou() );
 366
 367         my $random = int(rand(scalar(@$surveys)));
 368         warn "Random survey index for process $$ is $random\n";
 369         my $surv = $surveys->[$random];
 370
 371         return $self->get_fleshed_survey($client, $surv);
 372
 373 }
 374
 375 __PACKAGE__->register_method(
 376         method  => "get_random_survey_global",
 377         api_name        => "open-ils.circ.survey.retrieve.opac.random.global");
 378
 379 sub get_random_survey_global {
 380         my( $self, $client ) = @_;
 381
 382         warn "retrieving random global survey\n";
 383         my $surveys = $apputils->simple_scalar_request(
 384                 "open-ils.storage",
 385                 "open-ils.storage.direct.action.survey.search.atomic",
 386                 # XXX grab the org tree to get the root id...
 387                 { owner => 1, opac => 't' } );
 388
 389         my $random = int(rand(scalar(@$surveys)));
 390         warn "Random survey index for process $$ is $random\n";
 391         my $surv = $surveys->[$random];
 392
 393         return $self->get_fleshed_survey($client, $surv);
 394
 395 }
 396
 397
 398
 399
 400
 401
 402
 403
 404
 405
 406 1;
 407
 408
 409
 410
 411