| 1 | ################################################################################ |
1 | ################################################################################ |
| 2 | # WeBWorK Online Homework Delivery System |
2 | # WeBWorK Online Homework Delivery System |
| 3 | # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ |
3 | # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ |
| 4 | # $CVSHeader: webwork2/lib/WeBWorK/CGI.pm,v 1.8 2006/07/11 14:44:55 gage Exp $ |
4 | # $CVSHeader: webwork-modperl/lib/WeBWorK/CGI.pm,v 1.9 2006/07/11 15:04:49 gage Exp $ |
| 5 | # |
5 | # |
| 6 | # This program is free software; you can redistribute it and/or modify it under |
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 |
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 |
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. |
9 | # version, or (b) the "Artistic License" which comes with this package. |
| … | |
… | |
| 34 | my $postlog = ''; |
34 | my $postlog = ''; |
| 35 | # handle special cases |
35 | # handle special cases |
| 36 | $func =~/^(checkbox|hidden)$/ && do { |
36 | $func =~/^(checkbox|hidden)$/ && do { |
| 37 | my $type = $func; |
37 | my $type = $func; |
| 38 | $func ='input', |
38 | $func ='input', |
|
|
39 | my %inputs = (ref($_[0])=~/HASH/) ? %{$_[0]} : @inputs; |
| 39 | push @inputs, '-type',$type; |
40 | $inputs{-type} = $type; |
| 40 | my %inputs = @inputs; |
|
|
| 41 | my $labels_key = normalizeName('labels?',@inputs); |
41 | my $labels_key = normalizeName('labels?',keys %inputs); |
| 42 | my $label = ($labels_key)?$inputs{$labels_key}:''; |
42 | my $label = ($labels_key)?$inputs{$labels_key}:''; |
| 43 | delete($inputs{$labels_key}) if defined $labels_key and exists($inputs{$labels_key}); |
43 | delete($inputs{$labels_key}) if defined $labels_key and exists($inputs{$labels_key}); |
| 44 | @inputs = (\%inputs); |
44 | @inputs = (\%inputs); |
| 45 | if (defined($label) and $label) { |
45 | if (defined($label) and $label) { |
| 46 | $prolog = "<label>"; |
46 | $prolog = "<label>"; |
| … | |
… | |
| 51 | my $type = 'text'; |
51 | my $type = 'text'; |
| 52 | $func ='input'; |
52 | $func ='input'; |
| 53 | push @inputs, '-type',$type; |
53 | push @inputs, '-type',$type; |
| 54 | }; |
54 | }; |
| 55 | $func =~/^textarea$/ && do { |
55 | $func =~/^textarea$/ && do { |
| 56 | my %inputs = @inputs; |
56 | my %inputs = (ref($_[0])=~/HASH/) ? %{$_[0]} : @inputs; |
| 57 | my $default_label = normalizeName('defaults?',keys %inputs); |
57 | my $default_label = normalizeName('defaults?',keys %inputs); |
| 58 | $inputs{-text} = $inputs{$default_label}; |
58 | $inputs{-text} = $inputs{$default_label}; |
| 59 | @inputs = %{removeParam($default_label, \%inputs)}; |
59 | @inputs = %{removeParam($default_label, \%inputs)}; |
| 60 | |
60 | |
| 61 | }; |
61 | }; |
| 62 | $func =~/^submit$/ && do { |
62 | $func =~/^submit$/ && do { |
| 63 | my $type = $func; |
63 | my $type = $func; |
| 64 | $func ='input', |
64 | $func ='input', |
|
|
65 | my %inputs = (ref($_[0])=~/HASH/) ? %{$_[0]} : @inputs; |
| 65 | push @inputs, '-type',$type; |
66 | $inputs{-type} = $type; |
| 66 | my %inputs = @inputs; |
|
|
| 67 | my ($labels_key) = normalizeName('labels?',@inputs); |
67 | my ($labels_key) = normalizeName('labels?',key %inputs); |
| 68 | $inputs{-value}= $inputs{$labels_key} if defined $labels_key and exists $inputs{$labels_key}; # use value for name |
68 | $inputs{-value}= $inputs{$labels_key} if defined $labels_key and exists $inputs{$labels_key}; # use value for name |
| 69 | delete($inputs{$labels_key}) if defined $labels_key and exists $inputs{$labels_key}; |
69 | delete($inputs{$labels_key}) if defined $labels_key and exists $inputs{$labels_key}; |
| 70 | @inputs = (\%inputs); |
70 | @inputs = (\%inputs); |
| 71 | }; |
71 | }; |
| 72 | $func =~/^radio$/ && do { |
72 | $func =~/^radio$/ && do { |
| 73 | my $type = $func; |
73 | my $type = $func; |
| 74 | $func ='input', |
74 | $func ='input', |
| 75 | push @inputs, '-type',$type; |
75 | my %inputs = (ref($_[0])=~/HASH/) ? %{$_[0]} : @inputs; |
| 76 | my %inputs = @inputs; |
76 | $inputs{-type} = $type; |
| 77 | my ($values_key) = normalizeName('values?',@inputs); |
77 | my ($values_key) = normalizeName('values?',keys %inputs); |
| 78 | $inputs{-value}= $inputs{$values_key}; # use value for name |
78 | $inputs{-value}= $inputs{$values_key}; # use value for name |
| 79 | delete($inputs{$values_key}) if defined $values_key and exists $inputs{$values_key}; |
79 | delete($inputs{$values_key}) if defined $values_key and exists $inputs{$values_key}; |
| 80 | @inputs = (\%inputs); |
80 | @inputs = (\%inputs); |
| 81 | }; |
81 | }; |
| 82 | $func =~/^(p|Tr|td|li|hidden|table|div|th)$/ && do { # concatenate inputs |
82 | $func =~/^(p|Tr|td|li|hidden|table|div|th)$/ && do { # concatenate inputs |
| … | |
… | |
| 135 | @text = map {$_ .$ret} @values; |
135 | @text = map {$_ .$ret} @values; |
| 136 | } |
136 | } |
| 137 | @inputs = (-type=>'radio',-value=>\@values, -text=>\@text); |
137 | @inputs = (-type=>'radio',-value=>\@values, -text=>\@text); |
| 138 | }; |
138 | }; |
| 139 | $func =~/^(popup_menu|scrolling_list)$/ &&do{ |
139 | $func =~/^(popup_menu|scrolling_list)$/ &&do{ |
| 140 | my %inputs = @inputs; |
140 | my %inputs = (ref($_[0])=~/HASH/) ? %{$_[0]} : @inputs; |
| 141 | %inputs = %{removeParam('override',\%inputs)}; |
141 | %inputs = %{removeParam('override',\%inputs)}; |
| 142 | my $values_key = normalizeName('values?',@inputs); #get keys |
142 | my $values_key = normalizeName('values?',keys %inputs); #get keys |
| 143 | my $labels_key = normalizeName('labels?',@inputs); |
143 | my $labels_key = normalizeName('labels?',keys %inputs); |
| 144 | my $ra_value = $inputs{$values_key}; |
144 | my $ra_value = $inputs{$values_key}; |
| 145 | my $rh_labels = $inputs{labels_key}; |
145 | my $rh_labels = $inputs{labels_key}; |
| 146 | my @values = @{$inputs{$values_key}}; |
146 | my @values = eval{ @{$inputs{$values_key}} }; |
|
|
147 | warn "error in $values_key $inputs{$values_key}",join(' ', @inputs), caller(), $@ if $@; |
| 147 | |
148 | |
| 148 | # deal with the default option |
149 | # deal with the default option |
| 149 | my $default = normalizeName('default', @inputs); |
150 | my $default = normalizeName('default', @inputs); |
| 150 | my $selected_option = ''; |
151 | my $selected_option = ''; |
| 151 | my $text = ''; |
152 | my $text = ''; |
| … | |
… | |
| 200 | return $result; |
201 | return $result; |
| 201 | } |
202 | } |
| 202 | sub normalizeName { |
203 | sub normalizeName { |
| 203 | my $name = shift; #name to find |
204 | my $name = shift; #name to find |
| 204 | my @inputs = @_; #inputs |
205 | my @inputs = @_; #inputs |
| 205 | my ($key) = grep /-?$name/, @inputs; |
206 | my ($key) = grep /^-?$name$/, @inputs; |
| 206 | return $key; |
207 | return $key; |
| 207 | } |
208 | } |
| 208 | |
209 | |
| 209 | # possible utility subroutines. |
210 | # possible utility subroutines. |
| 210 | sub removeParam { |
211 | sub removeParam { |
Parent Directory
| 
Revision Log
| 
Patch