[system] / trunk / pg / lib / PGresponsegroup.pm Repository:
ViewVC logotype

View of /trunk/pg/lib/PGresponsegroup.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6292 - (download) (as text) (annotate)
Tue Jun 8 18:00:53 2010 UTC (9 years, 8 months ago) by mgage
File size: 6947 byte(s)
syncing cvn with changes made to the cvs

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: pg/lib/PGresponsegroup.pm,v 1.2 2010/05/25 22:13:52 gage Exp $
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 package PGresponsegroup;
   17 
   18 use strict;
   19 use Exporter;
   20 use PGcore  qw(not_null) ;
   21 use PGanswergroup;
   22 use Tie::IxHash;
   23 
   24 #############################################
   25 # An object which contains the student response(s)
   26 # 1. needs to be able to hold one or more responses
   27 # 2. needs space for auxiliary answer labels
   28 #      for example all of the entries in an array
   29 # 3. needs to coordinate answer labels with the PGanswergroup holding it
   30 #    We'll accomplish this by having it point to it's enclosing answergroup
   31 # 4. may have additional methods for processing and storing response strings
   32 #      the responses for radio buttons should be of the form   response_label=>[button1, button2, button3,  ...]
   33 # 5. should be called with at least one label, response pair
   34 # 6. By convention the first response usually has the same label as the parent answergroup.
   35 #    This is always true if there is only a single response.
   36 #############################################
   37 our @ISA= qw(PGanswergroup);
   38 
   39 ###
   40 # new ( label, response, label, response)
   41 #
   42 # create a new empty response group object
   43 # Optionally append label/response pairs
   44 ###
   45 sub new {
   46   my $class = shift;
   47   my $answergroup_label = shift;
   48   my $self = {
   49       answergroup_label  => $answergroup_label,    # enclosing answergroup that created this responsegroup
   50     response_order     => [],         # response labels
   51     responses          => {},         # response label/response value pair,
   52                                  # value could be an arrayref in the case of radio or checkbox groups
   53   };
   54   bless $self, $class;
   55   $self->append_responses(@_);
   56   return $self;
   57 
   58 }
   59 ###############
   60 # append_response (label, response)
   61 #
   62 # Append label/response pairs to the response hash.
   63 # order is recorded in the response_order array
   64 ###############
   65 
   66 sub append_response{
   67 
   68   my $self = shift;
   69   my $response_label = shift;
   70   my $response_value =shift;
   71   if (not_null($response_label) ) {
   72     if (not exists ($self->{responses}->{$response_label}) ) {
   73       push @{ $self->{response_order}} , $response_label;
   74       $self->{responses}->{$response_label} = $response_value;
   75     } else {
   76       $self->internal_debug_message( "PGresponsegroup::append_response error: there is already an answer labeled $response_label", caller(2),"\n");
   77     }
   78   } else {
   79         $self->internal_debug_message(  "PGresponsegroup::append_response error: undefined or empty response label");
   80   }
   81   #warn "\n content of responses  is ",join(' ',%{$self->{responses}});
   82 }
   83 
   84 ###############
   85 # append_response (label, response, label, responses)
   86 #
   87 # Append label/response pairs to the response hash.
   88 # order is recorded in the response_order array
   89 ###############
   90 
   91 sub append_responses {   #no error checking
   92   my $self = shift;
   93   my @response_list  = @_;
   94   #warn "working with @response_list,", caller(2);
   95   while (@response_list) {
   96     $self->append_response(shift @response_list , shift @response_list);
   97   }
   98 }
   99 
  100 ################
  101 # replace_response(label, response)
  102 #
  103 # replace the response to one response label entry
  104 ################
  105 sub replace_response {
  106   my $self = shift;
  107   my $response_label = shift;
  108   my $response_value = shift;
  109   if (defined $self->{responses}->{$response_label}) {
  110     $self->{responses}->{$response_label}=$response_value if defined $response_value;
  111     return $self->{responses}->{$response_label};
  112   } else {
  113     warn "response label |$response_label| not defined" ;
  114     return undef;
  115     }
  116 }
  117 ################
  118 # extend_response(label, response)
  119 #
  120 # extend the annonymous response to one response label entry  -- used for check boxes and radio buttons
  121 ################
  122 sub extend_response {
  123   my $self = shift;
  124   my $response_label = shift;
  125   my $new_value_key  = shift;
  126   my $selected       = shift;
  127   if (defined $self->{responses}->{$response_label}) {
  128     my $response_value = $self->{responses}->{$response_label};
  129     !defined($response_value) && do{ $response_value = {} };
  130     ref($response_value) !~/HASH/ && do{
  131                 $self->internal_debug_message("PGresponsegroup::extend_response: error in storing hash ", ref($response_value),$response_value);
  132                 $response_value = {$response_value=>$selected};
  133               };
  134         #should not happen this means that a non-hash entry was made into this response label
  135         # this converts it to a hash entry
  136     $response_value->{$new_value_key} =  $selected;
  137     $self->{responses}->{$response_label} = $response_value;
  138     return $response_value;
  139     # a hash of key/value pairs -- the key labels the radio button or checkbox,
  140     # the value whether it is selected
  141   } else {
  142     $self->internal_debug_message("PGresponsegroup::extend_response: response label |$response_label| not defined") ;
  143     return undef;
  144     }
  145 
  146 }
  147 ################
  148 # get_response(label)
  149 #
  150 # returns  response for that label entry
  151 ################
  152 sub get_response {
  153   my $self = shift;
  154   my $response_label = shift;
  155   $self->{responses}->{$response_label};
  156 }
  157 sub get_answergroup_label {
  158   my $self = shift;
  159   if ( ! not_null ($self->{answergroup_label}) ) { #if $answergroup is not yet defined
  160     $self->{answergroup_label} = ${$self->{response_order}}[0];
  161   }
  162   if ( not_null ($self->{answergroup_label}) ) { #if $answergroup is now defined
  163     return $self->{answergroup_label};
  164   } else {
  165     warn "This answer group has no labeled responses.";
  166   }
  167 }
  168 
  169 
  170 
  171 
  172 
  173 ################
  174 # clear()
  175 #
  176 # sets PGresponse group to empty
  177 ################
  178 sub clear {
  179   my $self = shift;
  180   $self->{response_order}=[];
  181   $self->{responses} ={};
  182 }
  183 ################
  184 # response_labels()
  185 #
  186 # returns entry ordered list of response labels
  187 ################
  188 
  189 
  190 sub response_labels {
  191   my $self = shift;
  192   @{$self->{response_order}};
  193 }
  194 
  195 ################
  196 #values()
  197 #
  198 # returns entry ordered list of response values
  199 ################
  200 
  201 sub values {
  202   my $self = shift;
  203   my @out = ();
  204   foreach my $key ( @{$self->{response_order}} ) {
  205     push @out, $self->get_response($key);
  206   }
  207   @out;
  208 }
  209 # synonym for values
  210 sub responses {
  211     my $self = shift;
  212   $self->values(@_);
  213 }
  214 
  215 sub data {
  216   my $self = shift;
  217   return { %$self };
  218 }
  219 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9