Parent Directory
| 
Revision Log
Still working on getting the select lists to work correctly
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ 4 5 # $CVSHeader: webwork-modperl/lib/WeBWorK/CGI.pm,v 1.15 2006/07/13 15:01:05 gage Exp $ 6 # 7 # This program is free software; you can redistribute it and/or modify it under 8 # the terms of either: (a) the GNU General Public License as published by the 9 # Free Software Foundation; either version 2, or (at your option) any later 10 # version, or (b) the "Artistic License" which comes with this package. 11 # 12 # This program is distributed in the hope that it will be useful, but WITHOUT 13 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 14 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 15 # Artistic License for more details. 16 ################################################################################ 17 18 19 20 21 use HTML::EasyTags; 22 use strict; 23 package CGI; # (override standard CGI namespace!!) 24 25 @CGI::ISA = qw(HTML::EasyTags); 26 our $html2 = HTML::EasyTags->new(); 27 our $AUTOLOAD; 28 29 sub AUTOLOAD { 30 my $func = $AUTOLOAD; 31 $func =~ s/^CGI:://; 32 my $result; 33 my @inputs = @_; 34 # reverse order to make this compatible with CGI 35 36 $func=~s/^start_?(.*)$/$1_start/; 37 $func=~s/^end_?(.*)$/$1_end/; 38 my $prolog = ''; 39 my $postlog = ''; 40 # handle special cases 41 $func =~/^(checkbox)$/ && do { 42 my $type = $func; 43 $func ='input'; 44 my %inputs = (ref($_[0])=~/HASH/) ? %{$_[0]} : @inputs; 45 $inputs{-type} = $type; 46 my $labels_key = normalizeName('labels?',keys %inputs); 47 my $label = ($labels_key)?$inputs{$labels_key}:''; 48 delete($inputs{$labels_key}) if defined $labels_key and exists($inputs{$labels_key}); 49 @inputs = (\%inputs); 50 if (defined($label) and $label) { 51 $prolog = "<label>"; 52 $postlog = "$label</label>"; 53 } 54 }; 55 $func =~/^textfield$/ && do { 56 my $type = 'text'; 57 $func ='input'; 58 push @inputs, '-type',$type; 59 }; 60 $func =~/^password_field$/ && do { 61 my $type = 'password'; 62 $func ='input'; 63 push @inputs, '-type',$type; 64 }; 65 $func =~/^textarea$/ && do { 66 my %inputs = (ref($_[0])=~/HASH/) ? %{$_[0]} : @inputs; 67 my $default_label = normalizeName('defaults?',keys %inputs); 68 $inputs{-text} = $inputs{$default_label}; 69 @inputs = %{removeParam($default_label, \%inputs)}; 70 71 }; 72 $func =~/^submit$/ && do { 73 my $type = $func; 74 $func ='input'; 75 my %inputs = (ref($_[0])=~/HASH/) ? %{$_[0]} : @inputs; 76 $inputs{-type} = $type; 77 my ($labels_key) = normalizeName('labels?',keys %inputs); 78 $inputs{-value}= $inputs{$labels_key} if defined $labels_key and exists $inputs{$labels_key}; # use value for name 79 delete($inputs{$labels_key}) if defined $labels_key and exists $inputs{$labels_key}; 80 @inputs = (\%inputs); 81 }; 82 $func =~/^radio$/ && do { 83 my $type = $func; 84 $func ='input'; 85 my %inputs = (ref($_[0])=~/HASH/) ? %{$_[0]} : @inputs; 86 $inputs{-type} = $type; 87 my ($values_key) = normalizeName('values?',keys %inputs); 88 $inputs{-value}= $inputs{$values_key}; # use value for name 89 delete($inputs{$values_key}) if defined $values_key and exists $inputs{$values_key}; 90 @inputs = (\%inputs); 91 }; 92 $func =~/^(p|Tr|td|li|table|div|th)$/ && do { # concatenate inputs 93 my $attributes; 94 $attributes = shift @inputs if ref($inputs[0]) =~/HASH/; 95 if (ref($inputs[0]) =~/ARRAY/) { # implied group 96 $func = $func.'_group' if ref($inputs[0]) =~/ARRAY/; 97 } else { #combine inputs 98 my $text = join("", @inputs); 99 @inputs = ($text); 100 } 101 unshift @inputs, $attributes if defined $attributes; 102 }; 103 $func =~ /^hidden/ && do { # handles name value pairs 104 my $type = $func; 105 $func ='input'; 106 my %inputs; 107 if (@inputs == 2) { #name value pair 108 $inputs{-type} = $type; 109 $inputs{-name} = $inputs[0]; 110 $inputs{-value}= $inputs[1]; 111 $inputs{-value} = 1 unless defined($inputs{-value}); 112 @inputs = (\%inputs); 113 } elsif( ref($inputs[0])=~/HASH/ ){ 114 $inputs[0]->{-type} = $type; 115 } else { # labeled entries 116 117 %inputs = @inputs; 118 $inputs{-type} = $type; 119 @inputs = (\%inputs); 120 } 121 122 #warn "hidden inputs are ", join(" ", @inputs); 123 124 }; 125 126 $func =~/^radio_group$/ &&do { 127 my $type = $func; 128 $func ='input_group', 129 push @inputs, '-type','radio'; 130 my %inputs = @inputs; 131 %inputs = %{removeParam('override',\%inputs)}; 132 my $labels_key = normalizeName('labels?',@inputs); 133 my $values_key = normalizeName('values?',@inputs); 134 my $name_key = normalizeName('name',@inputs); 135 my $ra_value = $inputs{$values_key}; 136 my $rh_labels = $inputs{labels_key}; 137 my @values = @{$inputs{$values_key}}; 138 my $ret = (defined($inputs{'-linebreak'}) and $inputs{'-linebreak'} )?"<br>":''; 139 # deal with the default option 140 my $default = normalizeName('default', @inputs); 141 my $selected_button = ''; 142 my $text = ''; 143 if (defined($default) and $default and defined($inputs{$default})) { 144 # grab the selected options 145 my $selected_value = $inputs{$default}; 146 147 if (defined $labels_key) { 148 $text = $inputs{$labels_key}->{$selected_value}.$ret; 149 delete($inputs{$labels_key}->{$selected_value}); 150 } else { 151 $text = $selected_value; 152 } 153 @values = grep !/$selected_value/, @values; 154 $prolog.= $html2->input({-name=>$inputs{$name_key},-type=>'radio', 155 -checked=>1, -text=>$text, 156 -value=>$selected_value})."\n"; 157 158 } 159 %inputs = %{removeParam('default',\%inputs)}; 160 ## match labels to values 161 my @text=(); 162 if (defined($labels_key) and $labels_key) { 163 my %labels= %{$inputs{$labels_key}}; 164 delete($inputs{$labels_key}) if exists $inputs{$labels_key}; 165 @text = map {( exists($labels{$_}) )? $labels{$_}.$ret: $_.$ret } @values; 166 } else { # no labels 167 @text = map {$_ .$ret} @values; 168 } 169 @inputs = (-type=>'radio',-value=>\@values, -text=>\@text); 170 }; 171 $func =~/^(popup_menu|scrolling_list)$/ &&do{ 172 my %inputs = (ref($_[0])=~/HASH/) ? %{$_[0]} : @inputs; 173 %inputs = %{removeParam('override',\%inputs)}; 174 my $values_key = normalizeName('values?',keys %inputs); #get keys 175 my $labels_key = normalizeName('labels?',keys %inputs); 176 my $ra_value = $inputs{$values_key}; 177 my $rh_labels = $inputs{labels_key}; 178 my @values = eval{ @{$inputs{$values_key}} }; 179 @values = grep {defined($_) and $_} @values; 180 warn "error in $values_key $inputs{$values_key}",join(' ', @inputs), caller(), $@ if $@; 181 182 # deal with the default option 183 my $default = normalizeName('default', @inputs); 184 my $selected_option = ''; 185 my $text = ''; 186 my @selected_values = ($values[0]); # select the first value by default 187 if (defined($default) and $default and defined($inputs{$default}) and $inputs{$default}) { 188 # grab the selected options 189 if (ref($inputs{$default})=~/ARRAY/ ) { 190 @selected_values = @{$inputs{$default}}; 191 } elsif ($inputs{$default}) { 192 @selected_values = ($inputs{$default}); 193 } 194 } 195 foreach my $selected_value (@selected_values) { 196 if (defined $labels_key) { 197 $text = $inputs{$labels_key}->{$selected_value}; 198 delete($inputs{$labels_key}->{$selected_value}); 199 } else { 200 $text = $selected_value; 201 } 202 @values = grep !/$selected_value/, @values; 203 $selected_option .= $html2->option({-selected=>1, -text=>$text, -value=>$selected_value})."\n"; 204 } 205 206 %inputs = %{removeParam('default',\%inputs)}; 207 ## match labels to values 208 return unless @values; # don't try to call options_group on an empty list 209 my @text=(); 210 if (defined($labels_key) and $labels_key) { 211 my %labels= %{$inputs{$labels_key}}; 212 delete($inputs{$labels_key}) if exists $inputs{$labels_key}; 213 @text = map {( exists($labels{$_}) )? $labels{$_}: $_ } @values; 214 } else { # no labels 215 @text = @values; 216 } 217 delete($inputs{$values_key}); 218 # end match labels to values 219 $prolog = $html2->select_start(\%inputs).$selected_option; 220 $postlog = $html2->select_end(); 221 $func = 'option_group'; 222 @inputs =({-value=>\@values, -text=>\@text }); 223 }; 224 225 #my @singles = grep /override|enable|disable|selected/, @inputs; 226 #warn "possible problem with single names (no values)", join(" ", @singles) if @singles; 227 228 if (ref($inputs[0]) or @inputs==1 or @inputs%2 == 0 or $func eq 'td') { # even number of hash elements 229 #$result = "OK: $func( @inputs )"; 230 $result = eval { $html2->$func(@inputs) }; 231 } else { 232 $result = "ERROR: bad number of inputs $func( " .join(" ", @_)." )"; 233 } 234 #$result = eval { use WeBWorK::CGI; $html2->$func(@_) }; 235 #handle special cases 236 if ( $prolog or $postlog ) { 237 $result =~ s/^\n//; # get rid of extra return?? 238 $result = "$prolog$result$postlog" ; 239 } 240 return $result; 241 } 242 sub normalizeName { 243 my $name = shift; #name to find 244 my @inputs = @_; #inputs 245 my ($key) = grep /^-?$name$/, @inputs; 246 return $key; 247 } 248 249 # possible utility subroutines. 250 sub removeParam { 251 my $name = shift; 252 my $rh_inputs = shift; 253 delete($rh_inputs->{$name}) if defined $name and exists $rh_inputs->{$name}; 254 delete($rh_inputs->{-$name}) if defined $name and exists $rh_inputs->{-$name}; 255 $rh_inputs; 256 } 257 sub labelsToText { #takes labels attached to values and distributes them into a text variable 258 my $rh_labels = shift; 259 my $rh_values = shift; 260 } 261 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |