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 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  24
  25 my $apputils = "OpenILS::Application::AppUtils";
  26
  27 # - creates a new survey
  28 # expects a survey complete with questions and answers
  29 __PACKAGE__->register_method(
  30         method  => "add_survey",
  31         api_name        => "open-ils.circ.survey.create");
  32
  33 sub add_survey {
  34         my( $self, $client, $user_session, $survey ) = @_;
  35
  36         my $user_obj = $apputils->check_user_session($user_session);
  37         my $session = $apputils->start_db_session();
  38         my $err = undef; my $id;
  39
  40         warn "Creating new survey\n" . Dumper($survey) . "\n";
  41
  42
  43         try {
  44
  45                 $survey = _add_survey($session, $survey);
  46                 _add_questions($session, $survey);
  47                 $apputils->commit_db_session($session);
  48
  49         } catch Error with {
  50                 my $e = shift;
  51                 $err = "Error creating survey: $e\n";
  52                 $apputils->rollback_db_session($session);
  53         };
  54
  55         if($err) { throw OpenSRF::EX::ERROR ($err); }
  56
  57         # re-retrieve the survey from the db and return it
  58         return $self->get_fleshed_survey( $client, $survey->id() );
  59 }
  60
  61
  62 sub _add_survey {
  63         my($session, $survey) = @_;
  64         my $req = $session->request(
  65                 "open-ils.storage.direct.action.survey.create",
  66                 $survey );
  67
  68         my $id = $req->gather(1);
  69
  70         if(!$id) {
  71                 throw OpenSRF::EX::ERROR
  72                         ("Unable to create new survey " . $survey->name());
  73         }
  74
  75         warn "Created new survey with id $id\n";
  76         $survey->id($id);
  77         return $survey;
  78 }
  79
  80 sub _update_survey {
  81         my($session, $survey) = @_;
  82 }
  83
  84 sub _add_questions {
  85         my($session, $survey) = @_;
  86
  87         # create new questions in the db
  88         if( $survey->questions() ) {
  89                 for my $question (@{$survey->questions()}){
  90
  91                         $question->survey($survey->id());
  92                         my $virtual_id = $question->id();
  93                         $question->clear_id();
  94
  95
  96                         warn "Creating new question: " . $question->question() . "\n";
  97                         warn Dumper $question;
  98
  99                         my $req = $session->request(
 100                                 'open-ils.storage.direct.action.survey_question.create',
 101                                 $question );
 102                         my $new_id = $req->gather(1);
 103
 104                         if(!$new_id) {
 105                                 throw OpenSRF::EX::ERROR
 106                                         ("Error creating new survey question " . $question->question() . "\n")
 107                         }
 108
 109                         warn "added new question with id $new_id\n";
 110
 111                         # now update the responses to this question
 112                         if($question->answers()) {
 113                                 for my $answer (@{$question->answers()}) {
 114                                         $answer->question($new_id);
 115                                         _add_answer($session,$answer);
 116                                 }
 117                         }
 118                 }
 119         }
 120 }
 121
 122
 123 sub _add_answer {
 124         my($session, $answer) = @_;
 125         warn "Adding answer " . $answer->answer() . "\n";
 126         $answer->clear_id();
 127         my $req = $session->request(
 128                 "open-ils.storage.direct.action.survey_answer.create",
 129                 $answer );
 130         my $id = $req->gather(1);
 131         if(!$id) {
 132                 throw OpenSRF::EX::ERROR
 133                         ("Error creating survey answer " . $answer->answer() );
 134         }
 135
 136         warn "Added new answer with id $id\n";
 137 }
 138
 139
 140
 141 # retrieve surveys for a specific org subtree.
 142 __PACKAGE__->register_method(
 143         method  => "get_required_surveys",
 144         api_name        => "open-ils.circ.survey.retrieve.required");
 145
 146 sub get_required_surveys {
 147         my( $self, $client, $user_session ) = @_;
 148
 149         warn "Retrieving required surveys\n";
 150
 151         my $user_obj = $apputils->check_user_session($user_session);
 152         my $orgid = $user_obj->ws_ou() ? $user_obj->ws_ou() : $user_obj->home_ou();
 153         my $surveys = $apputils->simple_scalar_request(
 154                 "open-ils.storage",
 155                 "open-ils.storage.action.survey.required.atomic",
 156                 $orgid );
 157
 158         if($surveys) {
 159                 warn "Retrieved " . scalar(@$surveys)." required surveys\n";
 160         }
 161
 162         my @fleshed;
 163         for my $survey (@$surveys) {
 164                 push(@fleshed, $self->get_fleshed_survey($client, $survey));
 165         }
 166         return \@fleshed;
 167
 168 }
 169
 170 __PACKAGE__->register_method(
 171         method  => "get_survey_responses",
 172         api_name        => "open-ils.circ.survey.response.retrieve");
 173
 174 sub get_survey_responses {
 175         my( $self, $client, $user_session, $survey_id, $user_id ) = @_;
 176
 177         warn "retrieing responses $user_session $survey_id $user_id\n";
 178         if(!$user_id) {
 179                 my $user_obj = $apputils->check_user_session($user_session);
 180                 $user_id = $user_obj->id;
 181         }
 182
 183         my $res = $apputils->simple_scalar_request(
 184                 "open-ils.cstore",
 185                 "open-ils.cstore.direct.action.survey_response.search.atomic",
 186                 { usr => $user_id, survey => $survey_id } );
 187
 188         warn "Surveys: " .  Dumper($res);
 189
 190         if( $res && ref($res) and $res->[0]) {
 191                 return [ sort { $a->id() <=> $b->id() } @$res ];
 192         }
 193
 194         return [];
 195 }
 196
 197 __PACKAGE__->register_method(
 198         method  => "get_all_surveys",
 199         api_name        => "open-ils.circ.survey.retrieve.all");
 200
 201 sub get_all_surveys {
 202         my( $self, $client, $user_session ) = @_;
 203
 204         my $user_obj = $apputils->check_user_session($user_session);
 205         my $orgid = $user_obj->ws_ou() ? $user_obj->ws_ou() : $user_obj->home_ou();
 206         my $surveys = $apputils->simple_scalar_request(
 207                 "open-ils.storage",
 208                 "open-ils.storage.action.survey.all.atomic",
 209                 $orgid );
 210
 211         my @fleshed;
 212         for my $survey (@$surveys) {
 213                 push(@fleshed, $self->get_fleshed_survey($client, $survey));
 214         }
 215         return \@fleshed;
 216 }
 217
 218
 219
 220
 221 __PACKAGE__->register_method(
 222         method  => "get_fleshed_survey",
 223         api_name        => "open-ils.circ.survey.fleshed.retrieve");
 224
 225 sub get_fleshed_survey {
 226         my( $self, $client, $survey_id ) = @_;
 227
 228         my $session = OpenSRF::AppSession->create("open-ils.storage");
 229
 230         warn "Searching for survey $survey_id\n";
 231
 232         my $survey;
 233         if( ref($survey_id) and
 234                         (ref($survey_id) =~ /^Fieldmapper/)) {
 235                 $survey = $survey_id;
 236
 237         } else {
 238
 239                 my $sreq = $session->request(
 240                         "open-ils.storage.direct.action.survey.retrieve",
 241                         $survey_id );
 242                 $survey = $sreq->gather(1);
 243                 if(! $survey) { return undef; }
 244         }
 245
 246         $survey->questions([]);
 247
 248
 249         warn "Grabbing survey questions\n";
 250         my $qreq = $session->request(
 251                 "open-ils.storage.direct.action.survey_question.search.survey.atomic",
 252                 $survey->id() );
 253
 254         my $questions = $qreq->gather(1);
 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