From: Steve Peters Date: Mon, 5 Dec 2005 16:20:17 +0000 (+0000) Subject: Upgrade to CGI.pm-3.13 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0a9bdad46b06555ba154417c5a8961c69cfa8b21;p=p5sagit%2Fp5-mst-13.2.git Upgrade to CGI.pm-3.13 p4raw-id: //depot/perl@26260 --- diff --git a/MANIFEST b/MANIFEST index d403629..df6805e 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1331,6 +1331,7 @@ lib/CGI/t/fast.t See if CGI::Fast works (if FCGI is installed) lib/CGI/t/form.t See if CGI.pm works lib/CGI/t/function.t See if CGI.pm works lib/CGI/t/html.t See if CGI.pm works +lib/CGI/t/no_tabindex.t See if CGI.pm works lib/CGI/t/pretty.t See if CGI.pm works lib/CGI/t/push.t See if CGI::Push works lib/CGI/t/request.t See if CGI.pm works diff --git a/lib/CGI.pm b/lib/CGI.pm index f5ecc2d..27ca5bb 100644 --- a/lib/CGI.pm +++ b/lib/CGI.pm @@ -18,8 +18,8 @@ use Carp 'croak'; # The most recent version and complete docs are available at: # http://stein.cshl.org/WWW/software/CGI/ -$CGI::revision = '$Id: CGI.pm,v 1.185 2005/08/03 21:14:55 lstein Exp $'; -$CGI::VERSION='3.11_01'; +$CGI::revision = '$Id: CGI.pm,v 1.193 2005/12/05 13:52:24 lstein Exp $'; +$CGI::VERSION='3.13_01'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. @@ -77,6 +77,9 @@ sub initialize_globals { # 2) CGI::private_tempfiles(1); $PRIVATE_TEMPFILES = 0; + # Set this to 1 to generate automatic tab indexes + $TABINDEX = 0; + # Set this to 1 to cause files uploaded in multipart documents # to be closed, instead of caching the file handle # or: @@ -367,9 +370,11 @@ sub new { # user is still holding any reference to them as well. sub DESTROY { my $self = shift; - foreach my $href (values %{$self->{'.tmpfiles'}}) { - $href->{hndl}->DESTROY if defined $href->{hndl}; - $href->{name}->DESTROY if defined $href->{name}; + if ($OS eq 'WINDOWS') { + foreach my $href (values %{$self->{'.tmpfiles'}}) { + $href->{hndl}->DESTROY if defined $href->{hndl}; + $href->{name}->DESTROY if defined $href->{name}; + } } } @@ -381,7 +386,13 @@ sub r { } sub upload_hook { - my ($self,$hook,$data) = self_or_default(@_); + my $self; + if (ref $_[0] eq 'CODE') { + $CGI::Q = $self = $CGI::DefaultClass->new(@_); + } else { + $self = shift; + } + my ($hook,$data) = @_; $self->{'.upload_hook'} = $hook; $self->{'.upload_data'} = $data; } @@ -499,16 +510,15 @@ sub init { if (($POST_MAX > 0) && ($content_length > $POST_MAX)) { # quietly read and discard the post my $buffer; - my $max = $content_length; - while ($max > 0 && - (my $bytes = $MOD_PERL - ? $self->r->read($buffer,$max < 10000 ? $max : 10000) - : read(STDIN,$buffer,$max < 10000 ? $max : 10000) - )) { - $self->cgi_error("413 Request entity too large"); - last METHOD; - } - } + my $tmplength = $content_length; + while($tmplength > 0) { + my $maxbuffer = ($tmplength < 10000)?$tmplength:10000; + my $bytesread = $MOD_PERL ? $self->r->read($buffer,$maxbuffer) : read(STDIN,$buffer,$maxbuffer); + $tmplength -= $bytesread; + } + $self->cgi_error("413 Request entity too large"); + last METHOD; + } # Process multipart postings, but only if the initializer is # not defined. @@ -821,14 +831,14 @@ sub _selected { my $self = shift; my $value = shift; return '' unless $value; - return $XHTML ? qq( selected="selected") : qq( selected); + return $XHTML ? qq(selected="selected" ) : qq(selected ); } sub _checked { my $self = shift; my $value = shift; return '' unless $value; - return $XHTML ? qq( checked="checked") : qq( checked); + return $XHTML ? qq(checked="checked" ) : qq(checked ); } sub _reset_globals { initialize_globals(); } @@ -851,6 +861,7 @@ sub _setup_symbols { $XHTML=0, next if /^[:-]no_?xhtml$/; $USE_PARAM_SEMICOLONS=0, next if /^[:-]oldstyle_urls$/; $PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/; + $TABINDEX++, next if /^[:-]tabindex$/; $CLOSE_UPLOAD_FILES++, next if /^[:-]close_upload_files$/; $EXPORT{$_}++, next if /^[:-]any$/; $compile++, next if /^[:-]compile$/; @@ -892,7 +903,9 @@ sub element_tab { my ($self,$new_value) = self_or_default(@_); $self->{'.etab'} ||= 1; $self->{'.etab'} = $new_value if defined $new_value; - $self->{'.etab'}++; + my $tab = $self->{'.etab'}++; + return '' unless $TABINDEX or defined $new_value; + return qq(tabindex="$tab" ); } ############################################################################### @@ -1769,10 +1782,7 @@ sub startform { $action = $self->escapeHTML($action); } else { - $action = $self->escapeHTML($self->url(-absolute=>1,-path=>1)); - if (exists $ENV{QUERY_STRING} && length($ENV{QUERY_STRING})>0) { - $action .= "?".$self->escapeHTML($ENV{QUERY_STRING},1); - } + $action = $self->escapeHTML($self->request_uri); } $action = qq(action="$action"); my($other) = @other ? " @other" : ''; @@ -1801,7 +1811,7 @@ END_OF_FUNC 'start_multipart_form' => <<'END_OF_FUNC', sub start_multipart_form { my($self,@p) = self_or_default(@_); - if (defined($param[0]) && substr($param[0],0,1) eq '-') { + if (defined($p[0]) && substr($p[0],0,1) eq '-') { my(%p) = @p; $p{'-enctype'}=&MULTIPART; return $self->startform(%p); @@ -1818,12 +1828,16 @@ END_OF_FUNC # End a form 'endform' => <<'END_OF_FUNC', sub endform { - my($self,@p) = self_or_default(@_); + my($self,@p) = self_or_default(@_); if ( $NOSTICKY ) { return wantarray ? ("") : "\n"; } else { - return wantarray ? ("
",$self->get_fields,"
","") : - "
".$self->get_fields ."
\n"; + if (my @fields = $self->get_fields) { + return wantarray ? ("
",@fields,"
","") + : "
".(join '',@fields)."
\n"; + } else { + return ""; + } } } END_OF_FUNC @@ -1847,7 +1861,7 @@ sub _textfield { # and WebTV -- not sure it won't break stuff my($value) = $current ne '' ? qq(value="$current") : ''; $tabindex = $self->element_tab($tabindex); - return $XHTML ? qq() + return $XHTML ? qq() : qq(); } END_OF_FUNC @@ -1929,7 +1943,7 @@ sub textarea { my($c) = $cols ? qq/ cols="$cols"/ : ''; my($other) = @other ? " @other" : ''; $tabindex = $self->element_tab($tabindex); - return qq{}; + return qq{}; } END_OF_FUNC @@ -1963,7 +1977,7 @@ sub button { $script = qq/ onclick="$script"/ if $script; my($other) = @other ? " @other" : ''; $tabindex = $self->element_tab($tabindex); - return $XHTML ? qq() + return $XHTML ? qq() : qq(); } END_OF_FUNC @@ -1987,15 +2001,15 @@ sub submit { $label=$self->escapeHTML($label); $value=$self->escapeHTML($value,1); - my $name = $NOSTICKY ? '' : ' name=".submit"'; - $name = qq/ name="$label"/ if defined($label); + my $name = $NOSTICKY ? '' : 'name=".submit" '; + $name = qq/name="$label" / if defined($label); $value = defined($value) ? $value : $label; my $val = ''; - $val = qq/ value="$value"/ if defined($value); + $val = qq/value="$value" / if defined($value); $tabindex = $self->element_tab($tabindex); - my($other) = @other ? " @other" : ''; - return $XHTML ? qq() - : qq(); + my($other) = @other ? "@other " : ''; + return $XHTML ? qq() + : qq(); } END_OF_FUNC @@ -2020,7 +2034,7 @@ sub reset { $val = qq/ value="$value"/ if defined($value); my($other) = @other ? " @other" : ''; $tabindex = $self->element_tab($tabindex); - return $XHTML ? qq() + return $XHTML ? qq() : qq(); } END_OF_FUNC @@ -2048,7 +2062,7 @@ sub defaults { my($value) = qq/ value="$label"/; my($other) = @other ? " @other" : ''; $tabindex = $self->element_tab($tabindex); - return $XHTML ? qq() + return $XHTML ? qq() : qq//; } END_OF_FUNC @@ -2095,10 +2109,10 @@ sub checkbox { $name = $self->escapeHTML($name); $value = $self->escapeHTML($value,1); $the_label = $self->escapeHTML($the_label); - my($other) = @other ? " @other" : ''; + my($other) = @other ? "@other " : ''; $tabindex = $self->element_tab($tabindex); $self->register_parameter($name); - return $XHTML ? CGI::label(qq{$the_label}) + return $XHTML ? CGI::label(qq{$the_label}) : qq{$the_label}; } END_OF_FUNC @@ -2280,7 +2294,7 @@ sub _box_group { $name=$self->escapeHTML($name); my %tabs = (); - if ($tabindex) { + if ($TABINDEX && $tabindex) { if (!ref $tabindex) { $self->element_tab($tabindex); } elsif (ref $tabindex eq 'ARRAY') { @@ -2291,7 +2305,7 @@ sub _box_group { } %tabs = map {$_=>$self->element_tab} @values unless %tabs; - my $other = @other ? " @other" : ''; + my $other = @other ? "@other " : ''; my $radio_checked; foreach (@values) { my $checkit = $self->_checked($box_type eq 'radio' ? ($checked{$_} && !$radio_checked++) @@ -2310,12 +2324,12 @@ sub _box_group { $label = $self->escapeHTML($label,1); } my $attribs = $self->_set_attributes($_, $attributes); - my $tab = qq( tabindex="$tabs{$_}") if exists $tabs{$_}; + my $tab = $tabs{$_}; $_=$self->escapeHTML($_); if ($XHTML) { push @elements, CGI::label( - qq($label)).${break}; + qq($label)).${break}; } else { push(@elements,qq/${label}${break}/); } @@ -2362,7 +2376,7 @@ sub popup_menu { my(@values); @values = $self->_set_values_and_labels($values,\$labels,$name); $tabindex = $self->element_tab($tabindex); - $result = qq/\n/; foreach (@values) { if (/{$_} if defined($labels) && defined($labels->{$_}); my($value) = $self->escapeHTML($_); $label=$self->escapeHTML($label,1); - $result .= "$label\n"; + $result .= "\n"; } } @@ -2487,7 +2501,7 @@ sub scrolling_list { $name=$self->escapeHTML($name); $tabindex = $self->element_tab($tabindex); - $result = qq/\n/; foreach (@values) { my($selectit) = $self->_selected($selected{$_}); my($label) = $_; @@ -2602,13 +2616,23 @@ END_OF_FUNC 'url' => <<'END_OF_FUNC', sub url { my($self,@p) = self_or_default(@_); - my ($relative,$absolute,$full,$path_info,$query,$base) = - rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING'],'BASE'],@p); - my $url; + my ($relative,$absolute,$full,$path_info,$query,$base,$rewrite) = + rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING'],'BASE','REWRITE'],@p); + my $url = ''; $full++ if $base || !($relative || $absolute); + $rewrite++ unless defined $rewrite; - my $path = $self->path_info; - my $script_name = $self->script_name; + my $path = $self->path_info; + my $script_name = $self->script_name; + my $request_uri = $self->request_uri || ''; + my $query_str = $self->query_string; + + my $rewrite_in_use = $request_uri && $request_uri !~ /^$script_name/; + undef $path if $rewrite_in_use && $rewrite; # path not valid when rewriting active + + my $uri = $rewrite && $request_uri ? $request_uri : $script_name; + $uri =~ s/\?.+$// if defined $query_str; + $uri =~ s/$path$// if defined $path; # remove path from URI if ($full) { my $protocol = $self->protocol(); @@ -2624,16 +2648,15 @@ sub url { || (lc($protocol) eq 'https' && $port == 443); } return $url if $base; - $url .= $script_name; + $url .= $uri; } elsif ($relative) { ($url) = $script_name =~ m!([^/]+)$!; } elsif ($absolute) { - $url = $script_name; + $url = $uri; } - $url .= $path if $path_info and defined $path; - $url .= "?" . $self->query_string if $query and $self->query_string; - $url = '' unless defined $url; + $url .= $path if $path_info and defined $path; + $url .= "?$query_str" if $query and $query_str ne ''; $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/sprintf("%%%02X",ord($1))/eg; return $url; } @@ -2745,6 +2768,10 @@ sub _name_and_path_from_env { my $raw_path_info = $ENV{PATH_INFO} || ''; my $uri = $ENV{REQUEST_URI} || ''; + if ($raw_script_name =~ m/$raw_path_info$/) { + $raw_script_name =~ s/$raw_path_info$//; + } + my @uri_double_slashes = $uri =~ m^(/{2,}?)^g; my @path_double_slashes = "$raw_script_name $raw_path_info" =~ m^(/{2,}?)^g; @@ -3008,8 +3035,9 @@ END_OF_FUNC sub virtual_port { my($self) = self_or_default(@_); my $vh = $self->http('x_forwarded_host') || $self->http('host'); + my $protocol = $self->protocol; if ($vh) { - return ($vh =~ /:(\d+)$/)[0] || '80'; + return ($vh =~ /:(\d+)$/)[0] || ($protocol eq 'https' ? 443 : 80); } else { return $self->server_port(); } @@ -3365,7 +3393,11 @@ sub read_multipart { # Save some information about the uploaded file where we can get # at it later. - $self->{'.tmpfiles'}->{fileno($filehandle)}= { + # Use the typeglob as the key, as this is guaranteed to be + # unique for each filehandle. Don't use the file descriptor as + # this will be re-used for each filehandle if the + # close_upload_files feature is used. + $self->{'.tmpfiles'}->{$$filehandle}= { hndl => $filehandle, name => $tmpfile, info => {%header}, @@ -3388,8 +3420,8 @@ END_OF_FUNC 'tmpFileName' => <<'END_OF_FUNC', sub tmpFileName { my($self,$filename) = self_or_default(@_); - return $self->{'.tmpfiles'}->{fileno($filename)}->{name} ? - $self->{'.tmpfiles'}->{fileno($filename)}->{name}->as_string + return $self->{'.tmpfiles'}->{$$filename}->{name} ? + $self->{'.tmpfiles'}->{$$filename}->{name}->as_string : ''; } END_OF_FUNC @@ -3397,7 +3429,7 @@ END_OF_FUNC 'uploadInfo' => <<'END_OF_FUNC', sub uploadInfo { my($self,$filename) = self_or_default(@_); - return $self->{'.tmpfiles'}->{fileno($filename)}->{info}; + return $self->{'.tmpfiles'}->{$$filename}->{info}; } END_OF_FUNC @@ -3781,11 +3813,10 @@ END_OF_AUTOLOAD package CGITempFile; sub find_tempdir { - undef $TMPDIRECTORY; $SL = $CGI::SL; $MAC = $CGI::OS eq 'MACINTOSH'; my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : ""; - unless ($TMPDIRECTORY) { + unless (defined $TMPDIRECTORY) { @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp", "C:${SL}temp","${SL}tmp","${SL}temp", "${vol}${SL}Temporary Items", @@ -4269,6 +4300,21 @@ that all the defaults are taken when you create a fill-out form. Use Delete_all() instead if you are using the function call interface. +=head2 HANDLING NON-URLENCODED ARGUMENTS + + +If POSTed data is not of type application/x-www-form-urlencoded or +multipart/form-data, then the POSTed data will not be processed, but +instead be returned as-is in a parameter named POSTDATA. To retrieve +it, use code like this: + + my $data = $query->param('POSTDATA'); + +(If you don't know what the preceding means, don't worry about it. It +only affects people trying to use CGI for XML processing and other +specialized tasks.) + + =head2 DIRECT ACCESS TO THE PARAMETER LIST: $q->param_fetch('address')->[1] = '1313 Mockingbird Lane'; @@ -4578,6 +4624,12 @@ Sometimes this isn't what you want. The B<-nosticky> pragma prevents this behavior. You can also selectively change the sticky behavior in each element that you generate. +=item -tabindex + +Automatically add tab index attributes to each form field. With this +option turned off, you can still add tab indexes manually by passing a +-tabindex option to each field-generating method. + =item -no_undef_params This keeps CGI.pm from including undef params in the parameter list. @@ -5169,6 +5221,16 @@ as a synonym. Generate just the protocol and net location, as in http://www.foo.com:8000 +=item B<-rewrite> + +If Apache's mod_rewrite is turned on, then the script name and path +info probably won't match the request that the user sent. Set +-rewrite=>1 (default) to return URLs that match what the user sent +(the original request URI). Set -rewrite->0 to return URLs that match +the URL after mod_rewrite's rules have run. Because the additional +path information only makes sense in the context of the rewritten URL, +-rewrite is set to false when you request path info in the URL. + =back =head2 MIXING POST AND URL PARAMETERS @@ -5817,8 +5879,7 @@ UPLOAD_HOOK facility available in Apache::Request, with the exception that the first argument to the callback is an Apache::Upload object, here it's the remote filename. - $q = CGI->new(); - $q->upload_hook(\&hook,$data); + $q = CGI->new(\&hook,$data); sub hook { @@ -7378,13 +7439,11 @@ To make it easier to port existing programs that use cgi-lib.pl the compatibility routine "ReadParse" is provided. Porting is simple: OLD VERSION - require "cgi-lib.pl"; &ReadParse; print "The value of the antique is $in{antique}.\n"; NEW VERSION - use CGI; CGI::ReadParse(); print "The value of the antique is $in{antique}.\n"; diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm index bb4b2c7..2d1daad 100644 --- a/lib/CGI/Carp.pm +++ b/lib/CGI/Carp.pm @@ -466,7 +466,7 @@ END if ($mod_perl) { my $r; - if ($ENV{MOD_PERL_API_VERSION}) { + if ($ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { $mod_perl = 2; require Apache2::RequestRec; require Apache2::RequestIO; diff --git a/lib/CGI/Changes b/lib/CGI/Changes index e469933..b4b4619 100644 --- a/lib/CGI/Changes +++ b/lib/CGI/Changes @@ -1,3 +1,23 @@ + Version 3.13 + 1. Removed extraneous empty "?" from end of self_url(). + + Version 3.12 + 1. Fixed virtual_port so that it works properly with https protocol. + 2. Fixed documentation for upload_hook(). + 3. Added POSTDATA documentation. + 4. Made upload_hook() work in function-oriented mode. + 5. Fixed POST_MAX behavior so that it doesn't cause client to hang. + 6. Disabled automatic tab indexes and added new -tabindex pragma to + turn automatic indexes back on. + 7. The url() and self_url() methods now work better in the context of Apache + mod_rewrite. Be advised that path_info() may give you confusing results + when mod_rewrite is active because Apache calculates the path info *after* + rewriting. This is mostly worked around in url() and self_url(), but you + may notice some anomalies. + 8. Removed empty (and non-validating)
from code emitted by end_form(). + 9. Fixed CGI::Carp to work correctly with Mod_perl 1.29 in an Apache 2 environment. + 10. Setting $CGI::TMPDIRECTORY should now be effective. + Version 3.11 1. Killed warning in CGI::Cookie about MOD_PERL_API_VERSION 2. Fixed append() so that it works in function mode. diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm index 0b915f0..789aa25 100644 --- a/lib/CGI/Cookie.pm +++ b/lib/CGI/Cookie.pm @@ -159,7 +159,7 @@ sub as_string { push(@constant_values,"secure") if $secure = $self->secure; my($key) = escape($self->name); - my($cookie) = join("=",$key,join("&",map escape($_),$self->value)); + my($cookie) = join("=",($key||''),join("&",map escape($_||''),$self->value)); return join("; ",$cookie,@constant_values); } diff --git a/lib/CGI/t/form.t b/lib/CGI/t/form.t index dd8338c..558dce9 100755 --- a/lib/CGI/t/form.t +++ b/lib/CGI/t/form.t @@ -7,7 +7,7 @@ use lib qw(. ./blib/lib ./blib/arch); use Test::More tests => 17; BEGIN { use_ok('CGI'); }; -use CGI (':standard','-no_debug'); +use CGI (':standard','-no_debug','-tabindex'); my $CRLF = "\015\012"; if ($^O eq 'VMS') { @@ -111,7 +111,7 @@ is(popup_menu(-name => 'game', '-values' => [qw/checkers chess cribbage/], -default => 'cribbage', -override => 1), - ' diff --git a/lib/CGI/t/no_tabindex.t b/lib/CGI/t/no_tabindex.t new file mode 100644 index 0000000..c9a7fb8 --- /dev/null +++ b/lib/CGI/t/no_tabindex.t @@ -0,0 +1,126 @@ +#!/usr/local/bin/perl -w + +# Due to a bug in older versions of MakeMaker & Test::Harness, we must +# ensure the blib's are in @INC, else we might use the core CGI.pm +use lib qw(. ./blib/lib ./blib/arch); + +use Test::More tests => 18; + +BEGIN { use_ok('CGI'); }; +use CGI (':standard','-no_debug'); + +my $CRLF = "\015\012"; +if ($^O eq 'VMS') { + $CRLF = "\n"; # via web server carriage is inserted automatically +} +if (ord("\t") != 9) { # EBCDIC? + $CRLF = "\r\n"; +} + + +# Set up a CGI environment +$ENV{REQUEST_METHOD} = 'GET'; +$ENV{QUERY_STRING} = 'game=chess&game=checkers&weather=dull'; +$ENV{PATH_INFO} = '/somewhere/else'; +$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else'; +$ENV{SCRIPT_NAME} ='/cgi-bin/foo.cgi'; +$ENV{SERVER_PROTOCOL} = 'HTTP/1.0'; +$ENV{SERVER_PORT} = 8080; +$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com'; + +ok( (not $CGI::TABINDEX), "Tab index turned off."); + +is(submit(), + qq(), + "submit()"); + +is(submit(-name => 'foo', + -value => 'bar'), + qq(), + "submit(-name,-value)"); + +is(submit({-name => 'foo', + -value => 'bar'}), + qq(), + "submit({-name,-value})"); + +is(textfield(-name => 'weather'), + qq(), + "textfield({-name})"); + +is(textfield(-name => 'weather', + -value => 'nice'), + qq(), + "textfield({-name,-value})"); + +is(textfield(-name => 'weather', + -value => 'nice', + -override => 1), + qq(), + "textfield({-name,-value,-override})"); + +is(checkbox(-name => 'weather', + -value => 'nice'), + qq(), + "checkbox()"); + +is(checkbox(-name => 'weather', + -value => 'nice', + -label => 'forecast'), + qq(), + "checkbox()"); + +is(checkbox(-name => 'weather', + -value => 'nice', + -label => 'forecast', + -checked => 1, + -override => 1), + qq(), + "checkbox()"); + +is(checkbox(-name => 'weather', + -value => 'dull', + -label => 'forecast'), + qq(), + "checkbox()"); + +is(radio_group(-name => 'game'), + qq( ), + 'radio_group()'); + +is(radio_group(-name => 'game', + -labels => {'chess' => 'ping pong'}), + qq( ), + 'radio_group()'); + +is(checkbox_group(-name => 'game', + -Values => [qw/checkers chess cribbage/]), + qq( ), + 'checkbox_group()'); + +is(checkbox_group(-name => 'game', + '-values' => [qw/checkers chess cribbage/], + '-defaults' => ['cribbage'], + -override=>1), + qq( ), + 'checkbox_group()'); + +is(popup_menu(-name => 'game', + '-values' => [qw/checkers chess cribbage/], + -default => 'cribbage', + -override => 1), + '', + 'popup_menu()'); + + +is(textarea(-name=>'foo', + -default=>'starting value', + -rows=>10, + -columns=>50), + '', + 'textarea()'); +