View of /branches/rel-2-2-dev/webwork2/lib/WeBWorK/HTML/OptionList.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader:
    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 
   17 package WeBWorK::HTML::OptionList;
   18 use base qw(Exporter);
   19 
   20 =head1 NAME
   21 
   22 WeBWorK::HTML::ScrollingRecordList - HTML widget for a textfield with a dropdown list
   23 
   24 =cut
   25 
   26 use strict;
   27 use warnings;
   28 use Carp;
   29 
   30 our @EXPORT    = ();
   31 our @EXPORT_OK = qw(
   32   optionList
   33 );
   34 
   35 
   36 
   37 sub optionList {
   38   my ($options, @Records) = @_;
   39 
   40   my %options = (%$options);
   41   # %options must contain:
   42   #  name - name of option list -- use $r->param("$name")
   43   #  request - the WeBWorK::Request object for the current request
   44   # may contain:
   45   #  default - default selection from pop_up list
   46   #  size - number of rows shown in option list
   47   #  multiple - are multiple selections allowed?
   48 
   49   croak "name not found in options" unless exists $options{name};
   50   croak "request not found in options" unless exists $options{request};
   51   my $name = $options{name};
   52   my $r = $options{request};
   53 
   54   my $default = $options{default};
   55   my $size = $options{size};
   56   $size = 1 unless defined $size;
   57   my $multiple = $options{multiple};
   58   $multiple = 0 unless defined $multiple;
   59 
   60   my $value = $r->param($name) || "";
   61 
   62   my @values = ref $options{values} eq "ARRAY" ? @{ $options{values} } : ();
   63   my %labels = ref $options{labels} eq "HASH" ? %{ $options{labels} } : map { $_ => $_ } @values;
   64 
   65   # if someone just sends in the labels parameter, use all of them as values
   66   @values = keys %labels if (%labels and not @values);
   67 
   68 
   69   map { $size = 4 + length if (length) > $size } @values;
   70 
   71   my %textfield_options = (
   72       name => $name,
   73       value => $value,
   74       size => $size,    # we need to calculate this to be the same as the popup_menu
   75   );
   76 
   77   my %popup_options = (
   78       -name => $name,
   79       -values => \@values,
   80       -labels => \%labels,
   81       -default => $default || $r->param($name) || 0,
   82   );
   83 
   84   return CGI::span({-class=>"OptionList"},
   85     CGI::table({cellpadding => 0, cellspacing => 0, border => 0},
   86       CGI::Tr({}, CGI::td({}, CGI::textfield({%textfield_options}))),
   87       CGI::Tr({}, CGI::td({}, CGI::popup_menu({%popup_options}))),
   88     )
   89   );
   90 
   91   return CGI::span({-class=>"OptionList"},
   92     CGI::textfield({
   93       name => $name,
   94       value => $value,
   95       size => $size,    # we need to calculate this to be the same as the popup_menu
   96     }), CGI::br(),
   97     CGI::popup_menu(
   98       -name => $name,
   99       -values => \@values,
  100       -labels => \%labels,
  101       -default => $r->param($name),
  102     ),
  103   );
  104 }
  105 
  106 1;