lib/CXGN/Page/Form/MultiSelect.pm

   1 =head1 NAME
   2
   3 CXGN::Page::Form::MultiSelect;
   4
   5 =head1 DESCRIPTION
   6
   7 Implements a static (non-editable) multiple-selection list on a static form. For more information, see L<CXGN::Page::Form>.
   8
   9 Currently a MultiSelect displays as a multiple-selection drop-down menu. It could also be a series of checkboxes with the same field name;
  10 implement that yourself if you need it.
  11
  12 =head1 AUTHOR(S)
  13
  14 Evan Herbst
  15
  16 =cut
  17
  18 use strict;
  19 use CXGN::Page::Form::ElementI;
  20
  21 package CXGN::Page::Form::MultiSelect;
  22
  23 use base qw/ CXGN::Page::Form::ElementI /;
  24
  25 =head2 new
  26
  27  Usage:
  28  Desc:
  29  Ret:
  30  Args:         a hashref with the following keys:
  31                display_name  (name of the field for display purposes)
  32                field_name (name of the variable)
  33                                         choices (an arrayref of IDs for the strings to be shown)
  34                                         labels (an arrayref of strings to be shown)
  35                                         contents (an arrayref of values that will be evaluated as Booleans to get the initial selection)
  36                object (the object this field maps to)
  37                getter (the getter function for this field in the object)
  38                setter (the setter function for this field in the object)
  39  Side Effects:
  40  Example:
  41
  42 =cut
  43
  44 sub new
  45 {
  46         my $class = shift;
  47         my %params = @_;
  48         my $self = $class->SUPER::new(%params);
  49         #store the parameters that aren't handled by our superclass
  50         foreach my $param (qw(choices labels))
  51         {
  52                 my $set_func = "set_$param";
  53                 $self->$set_func($params{$param});
  54         }
  55         return $self;
  56 }
  57
  58 =head2 render
  59
  60  Usage:
  61  Desc:
  62  Ret:
  63  Args:
  64  Side Effects:
  65  Example:
  66
  67 =cut
  68
  69 sub render
  70 {
  71         my $self = shift;
  72         #render as a comma-separated list of labels
  73         my @selected_labels = ();
  74         for(my $i = 0; $i < scalar($self->get_choice_array()); $i++)
  75         {
  76                 if($self->is_selected($i))
  77                 {
  78                         push @selected_labels, $self->get_label($i);
  79                 }
  80         }
  81         return join(", ", @selected_labels);
  82 }
  83
  84 =head2 set_from_external
  85
  86 Args: string with all values for this field separated by \0
  87
  88 =cut
  89
  90 sub set_from_external
  91 {
  92         my ($self, $value_string) = @_;
  93         my %values = map {$_ => 1} split(/\0/, $value_string); #map only values that appear to 1
  94         my @choices = $self->get_choice_array();
  95         for(my $i = 0; $i < scalar(@choices); $i++)
  96         {
  97                 if($values{$choices[$i]})
  98                 {
  99                         $self->set_selected($i, 1);
 100                 }
 101         }
 102 }
 103
 104 =head2 get_choice
 105
 106 Args: choice index
 107
 108 =cut
 109
 110 sub get_choice
 111 {
 112         my ($self, $i) = @_;
 113         return $self->{choices}->[$i];
 114 }
 115
 116 =head2 get_choice_array
 117
 118 Ret: array (not arrayref) of choices
 119
 120 =cut
 121
 122 sub get_choice_array
 123 {
 124         my $self = shift;
 125         return @{$self->{choices}};
 126 }
 127
 128 =head2 set_choices
 129
 130 Args: arrayref of choices
 131
 132 =cut
 133
 134 sub set_choices
 135 {
 136         my ($self, $choices) = @_;
 137         $self->{choices} = $choices;
 138 }
 139
 140 =head2 get_label
 141
 142 Args: label index
 143
 144 =cut
 145
 146 sub get_label
 147 {
 148         my ($self, $i) = @_;
 149         return $self->{labels}->[$i];
 150 }
 151
 152 =head2 set_labels
 153
 154 Args: arrayref of labels
 155
 156 =cut
 157
 158 sub set_labels
 159 {
 160         my ($self, $labels) = @_;
 161         $self->{labels} = $labels;
 162 }
 163
 164 =head2 is_selected
 165
 166 Args: index to check
 167
 168 =cut
 169
 170 sub is_selected
 171 {
 172         my ($self, $i) = @_;
 173         return $self->{contents}->[$i];
 174 }
 175
 176 =head2 set_selected
 177
 178 Args: index, an expression that will be evaluated in Boolean context
 179
 180 =cut
 181
 182 sub set_selected
 183 {
 184         my ($self, $i, $val) = @_;
 185         $self->{contents}->[$i] = ($val ? 1 : 0);
 186 }
 187
 188 return 1;