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