# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/
-$CGI::revision = '$Id: CGI.pm,v 1.165 2004/04/12 20:37:26 lstein Exp $';
-$CGI::VERSION=3.05;
+$CGI::revision = '$Id: CGI.pm,v 1.177 2005/03/09 21:04:48 lstein Exp $';
+$CGI::VERSION=3.06;
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
':all' => [qw/:html2 :html3 :netscape :form :cgi :internal :html4/]
);
+# Custom 'can' method for both autoloaded and non-autoloaded subroutines.
+# Author: Cees Hek <cees@sitesuite.com.au>
+
+sub can {
+ my($class, $method) = @_;
+
+ # See if UNIVERSAL::can finds it.
+
+ if (my $func = $class -> SUPER::can($method) ){
+ return $func;
+ }
+
+ # Try to compile the function.
+
+ eval {
+ # _compile looks at $AUTOLOAD for the function name.
+
+ local $AUTOLOAD = join "::", $class, $method;
+ &_compile;
+ };
+
+ # Now that the function is loaded (if it exists)
+ # just use UNIVERSAL::can again to do the work.
+
+ return $class -> SUPER::can($method);
+}
+
# to import symbols into caller
sub import {
my $self = shift;
my($sub) = \%{"$pack\:\:SUBS"};
unless (%$sub) {
my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"};
+ local ($@,$!);
eval "package $pack; $$auto";
croak("$AUTOLOAD: $@") if $@;
$$auto = ''; # Free the unneeded storage (but don't undef it!!!)
}
}
croak("Undefined subroutine $AUTOLOAD\n") unless $code;
+ local ($@,$!);
eval "package $pack; $code";
if ($@) {
$@ =~ s/ at .*\n//;
$self->{'.charset'};
}
+sub element_id {
+ my ($self,$new_value) = self_or_default(@_);
+ $self->{'.elid'} = $new_value if defined $new_value;
+ sprintf('%010d',$self->{'.elid'}++);
+}
+
+sub element_tab {
+ my ($self,$new_value) = self_or_default(@_);
+ $self->{'.etab'} = $new_value if defined $new_value;
+ $self->{'.etab'}++;
+}
+
###############################################################################
################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
###############################################################################
sub start_html {
my($self,@p) = &self_or_default(@_);
my($title,$author,$base,$xbase,$script,$noscript,
- $target,$meta,$head,$style,$dtd,$lang,$encoding,@other) =
- rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD,LANG,ENCODING],@p);
+ $target,$meta,$head,$style,$dtd,$lang,$encoding,$declare_xml,@other) =
+ rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,
+ META,HEAD,STYLE,DTD,LANG,ENCODING,DECLARE_XML],@p);
+
+ $self->element_id(0);
+ $self->element_tab(0);
$encoding = 'iso-8859-1' unless defined $encoding;
$xml_dtd++ if ref($dtd) eq 'ARRAY' && $dtd->[0] =~ /\bXHTML\b/i;
$xml_dtd++ if ref($dtd) eq '' && $dtd =~ /\bXHTML\b/i;
- push @result,qq(<?xml version="1.0" encoding="$encoding"?>) if $xml_dtd;
+ push @result,qq(<?xml version="1.0" encoding="$encoding"?>) if $xml_dtd && $declare_xml;
if (ref($dtd) && ref($dtd) eq 'ARRAY') {
push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd->[0]"\n\t "$dtd->[1]">));
$lang = 'en-US' unless defined $lang;
}
- push(@result,$XHTML ? qq(<html xmlns="http://www.w3.org/1999/xhtml" lang="$lang" xml:lang="$lang"><head><title>$title</title>)
- : ($lang ? qq(<html lang="$lang">) : "<html>")
+ my $lang_bits = $lang ne '' ? qq( lang="$lang" xml:lang="$lang") : '';
+ my $meta_bits = qq(<meta http-equiv="Content-Type" content="text/html; charset=$encoding" />)
+ if $XHTML && $encoding && !$declare_xml;
+
+ push(@result,$XHTML ? qq(<html xmlns="http://www.w3.org/1999/xhtml"$lang_bits>\n<head>\n<title>$title</title>)
+ : ($lang ? qq(<html lang="$lang">) : "<html>")
. "<head><title>$title</title>");
if (defined $author) {
push(@result,$XHTML ? "<link rev=\"made\" href=\"mailto:$author\" />"
- : "<link rev=\"made\" href=\"mailto:$author\">");
+ : "<link rev=\"made\" href=\"mailto:$author\">");
}
if ($base || $xbase || $target) {
# handle the infrequently-used -style and -script parameters
push(@result,$self->_style($style)) if defined $style;
push(@result,$self->_script($script)) if defined $script;
+ push(@result,$meta_bits) if defined $meta_bits;
# handle -noscript parameter
push(@result,<<END) if $noscript;
END
;
my($other) = @other ? " @other" : '';
- push(@result,"</head><body$other>");
+ push(@result,"</head>\n<body$other>\n");
return join("\n",@result);
}
END_OF_FUNC
push(@satts,'src'=>$src) if $src;
push(@satts,'language'=>$language) unless defined $type;
push(@satts,'type'=>$type);
- $code = "$cdata_start$code$cdata_end" if defined $code;
- push(@result,script({@satts},$code || ''));
+ $code = $cdata_start . $code . $cdata_end if defined $code;
+ push(@result,$self->script({@satts},$code || ''));
}
@result;
}
####
'end_html' => <<'END_OF_FUNC',
sub end_html {
- return "</body></html>";
+ return "\n</body>\n</html>";
}
END_OF_FUNC
# synonym for startform
'start_form' => <<'END_OF_FUNC',
sub start_form {
- &startform;
+ $XHTML ? &start_multipart_form : &startform;
}
END_OF_FUNC
'_textfield' => <<'END_OF_FUNC',
sub _textfield {
my($self,$tag,@p) = self_or_default(@_);
- my($name,$default,$size,$maxlength,$override,@other) =
- rearrange([NAME,[DEFAULT,VALUE,VALUES],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
+ my($name,$default,$size,$maxlength,$override,$tabindex,@other) =
+ rearrange([NAME,[DEFAULT,VALUE,VALUES],SIZE,MAXLENGTH,[OVERRIDE,FORCE],TABINDEX],@p);
my $current = $override ? $default :
(defined($self->param($name)) ? $self->param($name) : $default);
# this entered at cristy's request to fix problems with file upload fields
# and WebTV -- not sure it won't break stuff
my($value) = $current ne '' ? qq(value="$current") : '';
- return $XHTML ? qq(<input type="$tag" name="$name" $value$s$m$other />)
+ $tabindex = $self->element_tab($tabindex);
+ return $XHTML ? qq(<input type="$tag" name="$name" tabindex="$tabindex" $value$s$m$other />)
: qq(<input type="$tag" name="$name" $value$s$m$other>);
}
END_OF_FUNC
'textarea' => <<'END_OF_FUNC',
sub textarea {
my($self,@p) = self_or_default(@_);
-
- my($name,$default,$rows,$cols,$override,@other) =
- rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE]],@p);
+ my($name,$default,$rows,$cols,$override,$tabindex,@other) =
+ rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE],TABINDEX],@p);
my($current)= $override ? $default :
(defined($self->param($name)) ? $self->param($name) : $default);
my($r) = $rows ? qq/ rows="$rows"/ : '';
my($c) = $cols ? qq/ cols="$cols"/ : '';
my($other) = @other ? " @other" : '';
- return qq{<textarea name="$name"$r$c$other>$current</textarea>};
+ $tabindex = $self->element_tab($tabindex);
+ return qq{<textarea name="$name" tabindex="$tabindex"$r$c$other>$current</textarea>};
}
END_OF_FUNC
sub button {
my($self,@p) = self_or_default(@_);
- my($label,$value,$script,@other) = rearrange([NAME,[VALUE,LABEL],
- [ONCLICK,SCRIPT]],@p);
+ my($label,$value,$script,$tabindex,@other) = rearrange([NAME,[VALUE,LABEL],
+ [ONCLICK,SCRIPT],TABINDEX],@p);
$label=$self->escapeHTML($label);
$value=$self->escapeHTML($value,1);
$val = qq/ value="$value"/ if $value;
$script = qq/ onclick="$script"/ if $script;
my($other) = @other ? " @other" : '';
- return $XHTML ? qq(<input type="button"$name$val$script$other />)
+ $tabindex = $self->element_tab($tabindex);
+ return $XHTML ? qq(<input type="button" tabindex="$tabindex"$name$val$script$other />)
: qq(<input type="button"$name$val$script$other>);
}
END_OF_FUNC
sub submit {
my($self,@p) = self_or_default(@_);
- my($label,$value,@other) = rearrange([NAME,[VALUE,LABEL]],@p);
+ my($label,$value,$tabindex,@other) = rearrange([NAME,[VALUE,LABEL],TABINDEX],@p);
$label=$self->escapeHTML($label);
$value=$self->escapeHTML($value,1);
$value = defined($value) ? $value : $label;
my $val = '';
$val = qq/ value="$value"/ if defined($value);
+ $tabindex = $self->element_tab($tabindex);
my($other) = @other ? " @other" : '';
- return $XHTML ? qq(<input type="submit"$name$val$other />)
+ return $XHTML ? qq(<input type="submit" tabindex="$tabindex"$name$val$other />)
: qq(<input type="submit"$name$val$other>);
}
END_OF_FUNC
'reset' => <<'END_OF_FUNC',
sub reset {
my($self,@p) = self_or_default(@_);
- my($label,$value,@other) = rearrange(['NAME',['VALUE','LABEL']],@p);
+ my($label,$value,$tabindex,@other) = rearrange(['NAME',['VALUE','LABEL'],TABINDEX],@p);
$label=$self->escapeHTML($label);
$value=$self->escapeHTML($value,1);
my ($name) = ' name=".reset"';
my($val) = '';
$val = qq/ value="$value"/ if defined($value);
my($other) = @other ? " @other" : '';
- return $XHTML ? qq(<input type="reset"$name$val$other />)
+ $tabindex = $self->element_tab($tabindex);
+ return $XHTML ? qq(<input type="reset" tabindex="$tabindex"$name$val$other />)
: qq(<input type="reset"$name$val$other>);
}
END_OF_FUNC
sub defaults {
my($self,@p) = self_or_default(@_);
- my($label,@other) = rearrange([[NAME,VALUE]],@p);
+ my($label,$tabindex,@other) = rearrange([[NAME,VALUE],TABINDEX],@p);
$label=$self->escapeHTML($label,1);
$label = $label || "Defaults";
my($value) = qq/ value="$label"/;
my($other) = @other ? " @other" : '';
- return $XHTML ? qq(<input type="submit" name=".defaults"$value$other />)
+ $tabindex = $self->element_tab($tabindex);
+ return $XHTML ? qq(<input type="submit" name=".defaults" tabindex="$tabindex"$value$other />)
: qq/<input type="submit" NAME=".defaults"$value$other>/;
}
END_OF_FUNC
sub checkbox {
my($self,@p) = self_or_default(@_);
- my($name,$checked,$value,$label,$override,@other) =
- rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE]],@p);
-
+ my($name,$checked,$value,$label,$override,$tabindex,@other) =
+ rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE],TABINDEX],@p);
+
$value = defined $value ? $value : 'on';
if (!$override && ($self->{'.fieldnames'}->{$name} ||
$value = $self->escapeHTML($value,1);
$the_label = $self->escapeHTML($the_label);
my($other) = @other ? " @other" : '';
+ $tabindex = $self->element_tab($tabindex);
$self->register_parameter($name);
- return $XHTML ? qq{<input type="checkbox" name="$name" value="$value"$checked$other />$the_label}
+ return $XHTML ? CGI::label(qq{<input type="checkbox" name="$name" value="$value" tabindex="$tabindex"$checked$other />$the_label})
: qq{<input type="checkbox" name="$name" value="$value"$checked$other>$the_label};
}
END_OF_FUNC
-#### Method: checkbox_group
-# Create a list of logically-linked checkboxes.
-# Parameters:
-# $name -> Common name for all the check boxes
-# $values -> A pointer to a regular array containing the
-# values for each checkbox in the group.
-# $defaults -> (optional)
-# 1. If a pointer to a regular array of checkbox values,
-# then this will be used to decide which
-# checkboxes to turn on by default.
-# 2. If a scalar, will be assumed to hold the
-# value of a single checkbox in the group to turn on.
-# $linebreak -> (optional) Set to true to place linebreaks
-# between the buttons.
-# $labels -> (optional)
-# A pointer to an associative array of labels to print next to each checkbox
-# in the form $label{'value'}="Long explanatory label".
-# Otherwise the provided values are used as the labels.
-# Returns:
-# An ARRAY containing a series of <input type="checkbox"> fields
-####
-'checkbox_group' => <<'END_OF_FUNC',
-sub checkbox_group {
- my($self,@p) = self_or_default(@_);
-
- my($name,$values,$defaults,$linebreak,$labels,$attributes,$rows,$columns,
- $rowheaders,$colheaders,$override,$nolabels,@other) =
- rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
- LINEBREAK,LABELS,ATTRIBUTES,ROWS,[COLUMNS,COLS],
- ROWHEADERS,COLHEADERS,
- [OVERRIDE,FORCE],NOLABELS],@p);
-
- my($checked,$break,$result,$label);
-
- my(%checked) = $self->previous_or_default($name,$defaults,$override);
-
- if ($linebreak) {
- $break = $XHTML ? "<br />" : "<br>";
- }
- else {
- $break = '';
- }
- $name=$self->escapeHTML($name);
-
- # Create the elements
- my(@elements,@values);
-
- @values = $self->_set_values_and_labels($values,\$labels,$name);
-
- my($other) = @other ? " @other" : '';
- foreach (@values) {
- $checked = $self->_checked($checked{$_});
- $label = '';
- unless (defined($nolabels) && $nolabels) {
- $label = $_;
- $label = $labels->{$_} if defined($labels) && defined($labels->{$_});
- $label = $self->escapeHTML($label);
- }
- my $attribs = $self->_set_attributes($_, $attributes);
- $_ = $self->escapeHTML($_,1);
- push(@elements,$XHTML ? qq(<input type="checkbox" name="$name" value="$_"$checked$other$attribs />${label}${break})
- : qq/<input type="checkbox" name="$name" value="$_"$checked$other$attribs>${label}${break}/);
- }
- $self->register_parameter($name);
- return wantarray ? @elements : join(' ',@elements)
- unless defined($columns) || defined($rows);
- $rows = 1 if $rows && $rows < 1;
- $cols = 1 if $cols && $cols < 1;
- return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
-}
-END_OF_FUNC
# Escape HTML -- used internally
'escapeHTML' => <<'END_OF_FUNC',
'_tableize' => <<'END_OF_FUNC',
sub _tableize {
my($rows,$columns,$rowheaders,$colheaders,@elements) = @_;
- $rowheaders = [] unless defined $rowheaders;
- $colheaders = [] unless defined $colheaders;
+ my @rowheaders = $rowheaders ? @$rowheaders : ();
+ my @colheaders = $colheaders ? @$colheaders : ();
my($result);
if (defined($columns)) {
if (defined($rows)) {
$columns = int(0.99 + @elements/$rows) unless defined($columns);
}
-
+
# rearrange into a pretty table
$result = "<table>";
my($row,$column);
- unshift(@$colheaders,'') if @$colheaders && @$rowheaders;
- $result .= "<tr>" if @{$colheaders};
- foreach (@{$colheaders}) {
+ unshift(@colheaders,'') if @colheaders && @rowheaders;
+ $result .= "<tr>" if @colheaders;
+ foreach (@colheaders) {
$result .= "<th>$_</th>";
}
for ($row=0;$row<$rows;$row++) {
$result .= "<tr>";
- $result .= "<th>$rowheaders->[$row]</th>" if @$rowheaders;
+ $result .= "<th>$rowheaders[$row]</th>" if @rowheaders;
for ($column=0;$column<$columns;$column++) {
$result .= "<td>" . $elements[$column*$rows + $row] . "</td>"
if defined($elements[$column*$rows + $row]);
'radio_group' => <<'END_OF_FUNC',
sub radio_group {
my($self,@p) = self_or_default(@_);
+ $self->_box_group('radio',@p);
+}
+END_OF_FUNC
+
+#### Method: checkbox_group
+# Create a list of logically-linked checkboxes.
+# Parameters:
+# $name -> Common name for all the check boxes
+# $values -> A pointer to a regular array containing the
+# values for each checkbox in the group.
+# $defaults -> (optional)
+# 1. If a pointer to a regular array of checkbox values,
+# then this will be used to decide which
+# checkboxes to turn on by default.
+# 2. If a scalar, will be assumed to hold the
+# value of a single checkbox in the group to turn on.
+# $linebreak -> (optional) Set to true to place linebreaks
+# between the buttons.
+# $labels -> (optional)
+# A pointer to an associative array of labels to print next to each checkbox
+# in the form $label{'value'}="Long explanatory label".
+# Otherwise the provided values are used as the labels.
+# Returns:
+# An ARRAY containing a series of <input type="checkbox"> fields
+####
+
+'checkbox_group' => <<'END_OF_FUNC',
+sub checkbox_group {
+ my($self,@p) = self_or_default(@_);
+ $self->_box_group('checkbox',@p);
+}
+END_OF_FUNC
- my($name,$values,$default,$linebreak,$labels,$attributes,
- $rows,$columns,$rowheaders,$colheaders,$override,$nolabels,@other) =
- rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS,ATTRIBUTES,
- ROWS,[COLUMNS,COLS],
- ROWHEADERS,COLHEADERS,
- [OVERRIDE,FORCE],NOLABELS],@p);
+'_box_group' => <<'END_OF_FUNC',
+sub _box_group {
+ my $self = shift;
+ my $box_type = shift;
+
+ my($name,$values,$defaults,$linebreak,$labels,$attributes,
+ $rows,$columns,$rowheaders,$colheaders,
+ $override,$nolabels,$tabindex,@other) =
+ rearrange([ NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LINEBREAK,LABELS,ATTRIBUTES,
+ ROWS,[COLUMNS,COLS],ROWHEADERS,COLHEADERS,
+ [OVERRIDE,FORCE],NOLABELS,TABINDEX
+ ],@_);
my($result,$checked);
- if (!$override && defined($self->param($name))) {
- $checked = $self->param($name);
- } else {
- $checked = $default;
- }
+
my(@elements,@values);
@values = $self->_set_values_and_labels($values,\$labels,$name);
+ my %checked = $self->previous_or_default($name,$defaults,$override);
# If no check array is specified, check the first by default
- $checked = $values[0] unless defined($checked) && $checked ne '';
+ $checked{$values[0]}++ if $box_type eq 'radio' && !%checked;
+
$name=$self->escapeHTML($name);
- my($other) = @other ? " @other" : '';
+ my %tabs = ();
+ if ($tabindex) {
+ if (!ref $tabindex) {
+ $self->element_tab($tabindex);
+ } elsif (ref $tabindex eq 'ARRAY') {
+ %tabs = map {$_=>$self->element_tab} @$tabindex;
+ } elsif (ref $tabindex eq 'HASH') {
+ %tabs = %$tabindex;
+ }
+ }
+ %tabs = map {$_=>$self->element_tab} @values unless %tabs;
+
+ my $other = @other ? " @other" : '';
+ my $radio_checked;
foreach (@values) {
- my($checkit) = $checked eq $_ ? qq/ checked="checked"/ : '';
+ my $checkit = $self->_checked($box_type eq 'radio' ? ($checked{$_} && !$radio_checked++)
+ : $checked{$_});
my($break);
if ($linebreak) {
$break = $XHTML ? "<br />" : "<br>";
$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
$label = $self->escapeHTML($label,1);
}
- my $attribs = $self->_set_attributes($_, $attributes);
+ my $attribs = $self->_set_attributes($_, $attributes);
+ my $tab = qq( tabindex="$tabs{$_}") if exists $tabs{$_};
$_=$self->escapeHTML($_);
- push(@elements,$XHTML ? qq(<input type="radio" name="$name" value="$_"$checkit$other$attribs />${label}${break})
- : qq/<input type="radio" name="$name" value="$_"$checkit$other$attribs>${label}${break}/);
+ if ($XHTML) {
+ push @elements,
+ CGI::label(
+ qq(<input type="$box_type" name="$name" value="$_"$checkit$other$tab$attribs />$label)).${break};
+ } else {
+ push(@elements,qq/<input type="$box_type" name="$name" value="$_"$checkit$other$tab$attribs>${label}${break}/);
+ }
}
$self->register_parameter($name);
- return wantarray ? @elements : join(' ',@elements)
+ return wantarray ? @elements : "@elements"
unless defined($columns) || defined($rows);
return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
}
sub popup_menu {
my($self,@p) = self_or_default(@_);
- my($name,$values,$default,$labels,$attributes,$override,@other) =
+ my($name,$values,$default,$labels,$attributes,$override,$tabindex,@other) =
rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,
- ATTRIBUTES,[OVERRIDE,FORCE]],@p);
+ ATTRIBUTES,[OVERRIDE,FORCE],TABINDEX],@p);
my($result,$selected);
if (!$override && defined($self->param($name))) {
my(@values);
@values = $self->_set_values_and_labels($values,\$labels,$name);
-
- $result = qq/<select name="$name"$other>\n/;
+ $tabindex = $self->element_tab($tabindex);
+ $result = qq/<select name="$name" tabindex="$tabindex"$other>\n/;
foreach (@values) {
if (/<optgroup/) {
foreach (split(/\n/)) {
'scrolling_list' => <<'END_OF_FUNC',
sub scrolling_list {
my($self,@p) = self_or_default(@_);
- my($name,$values,$defaults,$size,$multiple,$labels,$attributes,$override,@other)
+ my($name,$values,$defaults,$size,$multiple,$labels,$attributes,$override,$tabindex,@other)
= rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
- SIZE,MULTIPLE,LABELS,ATTRIBUTES,[OVERRIDE,FORCE]],@p);
+ SIZE,MULTIPLE,LABELS,ATTRIBUTES,[OVERRIDE,FORCE],TABINDEX],@p);
my($result,@values);
@values = $self->_set_values_and_labels($values,\$labels,$name);
my($other) = @other ? " @other" : '';
$name=$self->escapeHTML($name);
- $result = qq/<select name="$name"$has_size$is_multiple$other>\n/;
+ $tabindex = $self->element_tab($tabindex);
+ $result = qq/<select name="$name" tabindex="$tabindex"$has_size$is_multiple$other>\n/;
foreach (@values) {
my($selectit) = $self->_selected($selected{$_});
my($label) = $_;
}
# choose a relatively unpredictable tmpfile sequence number
- my $seqno = unpack("%16C*",join('',localtime,values %ENV));
+ my $seqno = unpack("%16C*",join('',localtime,grep {defined $_} values %ENV));
for (my $cnt=10;$cnt>0;$cnt--) {
next unless $tmpfile = new CGITempFile($seqno);
$tmp = $tmpfile->as_string;
*Fh::AUTOLOAD = \&CGI::AUTOLOAD;
+sub DESTROY {
+ my $self = shift;
+ close $self;
+}
+
$AUTOLOADED_ROUTINES = ''; # prevent -w error
$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
%SUBS = (
}
END_OF_FUNC
-'DESTROY' => <<'END_OF_FUNC',
-sub DESTROY {
- my $self = shift;
- close $self;
-}
-END_OF_FUNC
-
);
END_OF_AUTOLOAD
my($package,$interface,$boundary,$length) = @_;
$FILLUNIT = $INITIAL_FILLUNIT;
$CGI::DefaultClass->binmode($IN); # if $CGI::needs_binmode; # just do it always
-
+
# If the user types garbage into the file upload field,
# then Netscape passes NOTHING to the server (not good).
# We may hang on this read in that case. So we implement
}
my $self = {LENGTH=>$length,
+ CHUNKED=>!defined $length,
BOUNDARY=>$boundary,
INTERFACE=>$interface,
BUFFER=>'',
my $start = index($self->{BUFFER},$boundary_start);
warn "boundary=$self->{BOUNDARY} length=$self->{LENGTH} start=$start\n" if DEBUG;
- # protect against malformed multipart POST operations
- die "Malformed multipart POST\n" unless ($start >= 0) || ($self->{LENGTH} > 0);
+ # protect against malformed multipart POST operations
+ die "Malformed multipart POST\n" unless $self->{CHUNKED} || ($start >= 0 || $self->{LENGTH} > 0);
#EBCDIC NOTE: want to translate boundary search into ASCII here.
'fillBuffer' => <<'END_OF_FUNC',
sub fillBuffer {
my($self,$bytes) = @_;
- return unless $self->{LENGTH};
+ return unless $self->{CHUNKED} || $self->{LENGTH};
my($boundaryLength) = length($self->{BOUNDARY});
my($bufferLength) = length($self->{BUFFER});
my($bytesToRead) = $bytes - $bufferLength + $boundaryLength + 2;
- $bytesToRead = $self->{LENGTH} if $self->{LENGTH} < $bytesToRead;
+ $bytesToRead = $self->{LENGTH} if !$self->{CHUNKED} && $self->{LENGTH} < $bytesToRead;
# Try to read some data. We may hang here if the browser is screwed up.
my $bytesRead = $self->{INTERFACE}->read_from_client(\$self->{BUFFER},
# remote user aborts during a file transfer. I don't know how
# they manage this, but the workaround is to abort if we get
# more than SPIN_LOOP_MAX consecutive zero reads.
- if ($bytesRead == 0) {
+ if ($bytesRead <= 0) {
die "CGI.pm: Server closed socket during multipart read (client aborted?).\n"
if ($self->{ZERO_LOOP_COUNTER}++ >= $SPIN_LOOP_MAX);
} else {
$self->{ZERO_LOOP_COUNTER}=0;
}
- $self->{LENGTH} -= $bytesRead;
+ $self->{LENGTH} -= $bytesRead if !$self->{CHUNKED} && $bytesRead;
}
END_OF_FUNC
=head2 SAVING THE STATE OF THE SCRIPT TO A FILE:
- $query->save(FILEHANDLE)
+ $query->save(\*FILEHANDLE)
This will write the current state of the form to the provided
filehandle. You can read it back in by providing a filehandle
foreach (0..$records) {
my $q = new CGI;
$q->param(-name=>'counter',-value=>$_);
- $q->save(OUT);
+ $q->save(\*OUT);
}
close OUT;
# reopen for reading
open (IN,"test.out") || die;
while (!eof(IN)) {
- my $q = new CGI(IN);
+ my $q = new CGI(\*IN);
print $q->param('counter'),"\n";
}
=item -nosticky
-This makes CGI.pm not generating the hidden fields .submit
-and .cgifields. It is very useful if you don't want to
-have the hidden fields appear in the querystring in a GET method.
-For example, a search script generated this way will have
-a very nice url with search parameters for bookmarking.
+By default the CGI module implements a state-preserving behavior
+called "sticky" fields. The way this works is that if you are
+regenerating a form, the methods that generate the form field values
+will interrogate param() to see if similarly-named parameters are
+present in the query string. If they find a like-named parameter, they
+will use it to set their default values.
+
+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 -no_undef_params
manipulated for special purposes, such as server push and pay per view
pages.
- print $query->header;
+ print header;
-or-
- print $query->header('image/gif');
+ print header('image/gif');
-or-
- print $query->header('text/html','204 No response');
+ print header('text/html','204 No response');
-or-
- print $query->header(-type=>'image/gif',
+ print header(-type=>'image/gif',
-nph=>1,
-status=>'402 Payment required',
-expires=>'+3d',
header fields, allowing you to specify any HTTP header you desire.
Internal underscores will be turned into hyphens:
- print $query->header(-Content_length=>3002);
+ print header(-Content_length=>3002);
Most browsers will not cache the output from CGI scripts. Every time
the browser reloads the page, the script is invoked anew. You can
=head2 GENERATING A REDIRECTION HEADER
- print $query->redirect('http://somewhere.else/in/movie/land');
+ print redirect('http://somewhere.else/in/movie/land');
Sometimes you don't want to produce a document yourself, but simply
redirect the browser elsewhere, perhaps choosing a URL based on the
You can also use named arguments:
- print $query->redirect(-uri=>'http://somewhere.else/in/movie/land',
+ print redirect(-uri=>'http://somewhere.else/in/movie/land',
-nph=>1,
-status=>301);
=head2 CREATING THE HTML DOCUMENT HEADER
- print $query->start_html(-title=>'Secrets of the Pyramids',
+ print start_html(-title=>'Secrets of the Pyramids',
-author=>'fred@capricorn.org',
-base=>'true',
-target=>'_blank',
The B<-encoding> argument can be used to specify the character set for
XHTML. It defaults to iso-8859-1 if not specified.
+The B<-declare_xml> argument, when used in conjunction with XHTML,
+will put a <?xml> declaration at the top of the HTML header. The sole
+purpose of this declaration is to declare the character set
+encoding. In the absence of -declare_xml, the output HTML will contain
+a <meta> tag that specifies the encoding, allowing the HTML to pass
+most validators. The default for -declare_xml is false.
+
You can place other arbitrary HTML elements to the <head> section with the
B<-head> tag. For example, to place the rarely-used <link> element in the
head section, use this:
B<-script> field:
$query = new CGI;
- print $query->header;
+ print header;
$JSCRIPT=<<END;
// Ask a silly question
function riddle_me_this() {
alert("Wrong! Guess again.");
}
END
- print $query->start_html(-title=>'The Riddle of the Sphinx',
+ print start_html(-title=>'The Riddle of the Sphinx',
-script=>$JSCRIPT);
Use the B<-noScript> parameter to pass some HTML text that will be displayed on
=head2 ENDING THE HTML DOCUMENT:
- print $query->end_html
+ print end_html
This ends an HTML document by printing the </body></html> tags.
=head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
- $myself = $query->self_url;
+ $myself = self_url;
print q(<a href="$myself">I'm talking to myself.</a>);
self_url() will return a URL, that, when selected, will reinvoke
internal anchors but you don't want to disrupt the current contents
of the form(s). Something like this will do the trick.
- $myself = $query->self_url;
+ $myself = self_url;
print "<a href=\"$myself#table1\">See table 1</a>";
print "<a href=\"$myself#table2\">See table 2</a>";
print "<a href=\"$myself#yourself\">See for yourself</a>";
You can also retrieve the unprocessed query string with query_string():
- $the_string = $query->query_string;
+ $the_string = query_string;
=head2 OBTAINING THE SCRIPT'S URL
- $full_url = $query->url();
- $full_url = $query->url(-full=>1); #alternative syntax
- $relative_url = $query->url(-relative=>1);
- $absolute_url = $query->url(-absolute=>1);
- $url_with_path = $query->url(-path_info=>1);
- $url_with_path_and_query = $query->url(-path_info=>1,-query=>1);
- $netloc = $query->url(-base => 1);
+ $full_url = url();
+ $full_url = url(-full=>1); #alternative syntax
+ $relative_url = url(-relative=>1);
+ $absolute_url = url(-absolute=>1);
+ $url_with_path = url(-path_info=>1);
+ $url_with_path_and_query = url(-path_info=>1,-query=>1);
+ $netloc = url(-base => 1);
B<url()> returns the script's URL in a variety of formats. Called
without any arguments, it returns the full form of the URL, including
=head2 MIXING POST AND URL PARAMETERS
- $color = $query->url_param('color');
+ $color = url_param('color');
It is possible for a script to receive CGI parameters in the URL as
well as in the fill-out form by creating a form that POSTs to a URL
This example shows how to use the HTML methods:
- $q = new CGI;
print $q->blockquote(
"Many years ago on the island of",
$q->a({href=>"http://crete.org/"},"Crete"),
(2) use the -override (alias -force) parameter (a new feature in version 2.15).
This forces the default value to be used, regardless of the previous value:
- print $query->textfield(-name=>'field_name',
+ print textfield(-name=>'field_name',
-default=>'starting value',
-override=>1,
-size=>50,
autoEscape() method with a false value immediately after creating the CGI object:
$query = new CGI;
- $query->autoEscape(undef);
+ autoEscape(undef);
I<A Lurking Trap!> Some of the form-element generating methods return
multiple tags. In a scalar context, the tags will be concatenated
elements, allowing you to modify them if you wish. Usually you will
not notice this behavior, but beware of this:
- printf("%s\n",$query->end_form())
+ printf("%s\n",end_form())
end_form() produces several tags, and only the first of them will be
printed because the format only expects one value.
=head2 CREATING AN ISINDEX TAG
- print $query->isindex(-action=>$action);
+ print isindex(-action=>$action);
-or-
- print $query->isindex($action);
+ print isindex($action);
Prints out an <isindex> tag. Not very exciting. The parameter
-action specifies the URL of the script to process the query. The
=head2 STARTING AND ENDING A FORM
- print $query->start_form(-method=>$method,
- -action=>$action,
- -enctype=>$encoding);
+ print start_form(-method=>$method,
+ -action=>$action,
+ -enctype=>$encoding);
<... various form stuff ...>
- print $query->endform;
+ print endform;
-or-
- print $query->start_form($method,$action,$encoding);
+ print start_form($method,$action,$encoding);
<... various form stuff ...>
- print $query->endform;
+ print endform;
start_form() will return a <form> tag with the optional method,
action and form encoding that you specify. The defaults are:
by CGI scripts unless they use CGI.pm or another library designed
to handle them.
+If XHTML is activated (the default), then forms will be automatically
+created using this type of encoding.
+
=back
For compatibility, the start_form() method uses the older form of
block in the HTML header and -onSubmit points to one of these function
call. See start_html() for details.
+=head2 FORM ELEMENTS
+
+After starting a form, you will typically create one or more
+textfields, popup menus, radio groups and other form elements. Each
+of these elements takes a standard set of named arguments. Some
+elements also have optional arguments. The standard arguments are as
+follows:
+
+=over 4
+
+=item B<-name>
+
+The name of the field. After submission this name can be used to
+retrieve the field's value using the param() method.
+
+=item B<-value>, B<-values>
+
+The initial value of the field which will be returned to the script
+after form submission. Some form elements, such as text fields, take
+a single scalar -value argument. Others, such as popup menus, take a
+reference to an array of values. The two arguments are synonyms.
+
+=item B<-tabindex>
+
+A numeric value that sets the order in which the form element receives
+focus when the user presses the tab key. Elements with lower values
+receive focus first.
+
+=item B<-id>
+
+A string identifier that can be used to identify this element to
+JavaScript and DHTML.
+
+=item B<-override>
+
+A boolean, which, if true, forces the element to take on the value
+specified by B<-value>, overriding the sticky behavior described
+earlier for the B<-no_sticky> pragma.
+
+=item B<-onChange>, B<-onFocus>, B<-onBlur>, B<-onMouseOver>, B<-onMouseOut>, B<-onSelect>
+
+These are used to assign JavaScript event handlers. See the
+JavaScripting section for more details.
+
+=back
+
+Other common arguments are described in the next section. In addition
+to these, all attributes described in the HTML specifications are
+supported.
+
=head2 CREATING A TEXT FIELD
- print $query->textfield(-name=>'field_name',
- -default=>'starting value',
- -size=>50,
- -maxlength=>80);
+ print textfield(-name=>'field_name',
+ -value=>'starting value',
+ -size=>50,
+ -maxlength=>80);
-or-
- print $query->textfield('field_name','starting value',50,80);
+ print textfield('field_name','starting value',50,80);
-textfield() will return a text input field.
+textfield() will return a text input field.
=over 4
=item 1.
-The first parameter is the required name for the field (-name).
+The first parameter is the required name for the field (-name).
=item 2.
The optional second parameter is the default starting value for the field
-contents (-default).
+contents (-value, formerly known as -default).
=item 3.
When the form is processed, the value of the text field can be
retrieved with:
- $value = $query->param('foo');
+ $value = param('foo');
If you want to reset it from its initial value after the script has been
called once, you can do so like this:
- $query->param('foo',"I'm taking over this value!");
-
-NEW AS OF VERSION 2.15: If you don't want the field to take on its previous
-value, you can force its current value by using the -override (alias -force)
-parameter:
-
- print $query->textfield(-name=>'field_name',
- -default=>'starting value',
- -override=>1,
- -size=>50,
- -maxlength=>80);
-
-JAVASCRIPTING: You can also provide B<-onChange>, B<-onFocus>,
-B<-onBlur>, B<-onMouseOver>, B<-onMouseOut> and B<-onSelect>
-parameters to register JavaScript event handlers. The onChange
-handler will be called whenever the user changes the contents of the
-text field. You can do text validation if you like. onFocus and
-onBlur are called respectively when the insertion point moves into and
-out of the text field. onSelect is called when the user changes the
-portion of the text that is selected.
+ param('foo',"I'm taking over this value!");
=head2 CREATING A BIG TEXT FIELD
- print $query->textarea(-name=>'foo',
+ print textarea(-name=>'foo',
-default=>'starting value',
-rows=>10,
-columns=>50);
-or
- print $query->textarea('foo','starting value',10,50);
+ print textarea('foo','starting value',10,50);
textarea() is just like textfield, but it allows you to specify
rows and columns for a multiline text entry box. You can provide
a starting value for the field, which can be long and contain
multiple lines.
-JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur> ,
-B<-onMouseOver>, B<-onMouseOut>, and B<-onSelect> parameters are
-recognized. See textfield().
-
=head2 CREATING A PASSWORD FIELD
- print $query->password_field(-name=>'secret',
+ print password_field(-name=>'secret',
-value=>'starting value',
-size=>50,
-maxlength=>80);
-or-
- print $query->password_field('secret','starting value',50,80);
+ print password_field('secret','starting value',50,80);
password_field() is identical to textfield(), except that its contents
will be starred out on the web page.
-JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
-B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
-recognized. See textfield().
-
=head2 CREATING A FILE UPLOAD FIELD
- print $query->filefield(-name=>'uploaded_file',
+ print filefield(-name=>'uploaded_file',
-default=>'starting value',
-size=>50,
-maxlength=>80);
-or-
- print $query->filefield('uploaded_file','starting value',50,80);
+ print filefield('uploaded_file','starting value',50,80);
filefield() will return a file upload field for Netscape 2.0 browsers.
In order to take full advantage of this I<you must use the new
When the form is processed, you can retrieve the entered filename
by calling param():
- $filename = $query->param('uploaded_file');
+ $filename = param('uploaded_file');
Different browsers will return slightly different things for the
name. Some browsers return the filename only. Others return the full
called with the name of an upload field, I<upload()> returns a
filehandle, or undef if the parameter is not a valid filehandle.
- $fh = $query->upload('uploaded_file');
+ $fh = upload('uploaded_file');
while (<$fh>) {
print;
}
retrieve this information, call uploadInfo(). It returns a reference to
an associative array containing all the document headers.
- $filename = $query->param('uploaded_file');
- $type = $query->uploadInfo($filename)->{'Content-Type'};
+ $filename = param('uploaded_file');
+ $type = uploadInfo($filename)->{'Content-Type'};
unless ($type eq 'text/html') {
die "HTML FILES ONLY!";
}
you can incorporate it into a status code to be sent to the browser.
Example:
- $file = $query->upload('uploaded_file');
- if (!$file && $query->cgi_error) {
- print $query->header(-status=>$query->cgi_error);
+ $file = upload('uploaded_file');
+ if (!$file && cgi_error) {
+ print header(-status=>cgi_error);
exit 0;
}
=head2 CREATING A POPUP MENU
- print $query->popup_menu('menu_name',
+ print popup_menu('menu_name',
['eenie','meenie','minie'],
'meenie');
'meenie'=>'your second choice',
'minie'=>'your third choice');
%attributes = ('eenie'=>{'class'=>'class of first choice'});
- print $query->popup_menu('menu_name',
+ print popup_menu('menu_name',
['eenie','meenie','minie'],
'meenie',\%labels,\%attributes);
-or (named parameter style)-
- print $query->popup_menu(-name=>'menu_name',
+ print popup_menu(-name=>'menu_name',
-values=>['eenie','meenie','minie'],
-default=>'meenie',
-labels=>\%labels,
When the form is processed, the selected value of the popup menu can
be retrieved using:
- $popup_menu_value = $query->param('menu_name');
-
-JAVASCRIPTING: popup_menu() recognizes the following event handlers:
-B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>, and
-B<-onBlur>. See the textfield() section for details on when these
-handlers are called.
+ $popup_menu_value = param('menu_name');
=head2 CREATING AN OPTION GROUP
Named parameter style
- print $query->popup_menu(-name=>'menu_name',
+ print popup_menu(-name=>'menu_name',
-values=>[qw/eenie meenie minie/,
- $q->optgroup(-name=>'optgroup_name',
- -values ['moe','catch'],
- -attributes=>{'catch'=>{'class'=>'red'}}),
+ optgroup(-name=>'optgroup_name',
+ -values => ['moe','catch'],
+ -attributes=>{'catch'=>{'class'=>'red'}})],
-labels=>{'eenie'=>'one',
'meenie'=>'two',
'minie'=>'three'},
-default=>'meenie');
Old style
- print $query->popup_menu('menu_name',
+ print popup_menu('menu_name',
['eenie','meenie','minie',
- $q->optgroup('optgroup_name', ['moe', 'catch'],
- {'catch'=>{'class'=>'red'}})],'meenie',
+ optgroup('optgroup_name', ['moe', 'catch'],
+ {'catch'=>{'class'=>'red'}})],'meenie',
{'eenie'=>'one','meenie'=>'two','minie'=>'three'});
-optgroup creates an option group within a popup menu.
+optgroup() creates an option group within a popup menu.
=over 4
=head2 CREATING A SCROLLING LIST
- print $query->scrolling_list('list_name',
+ print scrolling_list('list_name',
['eenie','meenie','minie','moe'],
['eenie','moe'],5,'true',{'moe'=>{'class'=>'red'}});
-or-
- print $query->scrolling_list('list_name',
+ print scrolling_list('list_name',
['eenie','meenie','minie','moe'],
['eenie','moe'],5,'true',
\%labels,%attributes);
-or-
- print $query->scrolling_list(-name=>'list_name',
+ print scrolling_list(-name=>'list_name',
-values=>['eenie','meenie','minie','moe'],
-default=>['eenie','moe'],
-size=>5,
a list under the parameter name 'list_name'. The values of the
selected items can be retrieved with:
- @selected = $query->param('list_name');
+ @selected = param('list_name');
=back
-JAVASCRIPTING: scrolling_list() recognizes the following event
-handlers: B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>
-and B<-onBlur>. See textfield() for the description of when these
-handlers are called.
-
=head2 CREATING A GROUP OF RELATED CHECKBOXES
- print $query->checkbox_group(-name=>'group_name',
+ print checkbox_group(-name=>'group_name',
-values=>['eenie','meenie','minie','moe'],
-default=>['eenie','moe'],
-linebreak=>'true',
-labels=>\%labels,
-attributes=>\%attributes);
- print $query->checkbox_group('group_name',
+ print checkbox_group('group_name',
['eenie','meenie','minie','moe'],
['eenie','moe'],'true',\%labels,
{'moe'=>{'class'=>'red'}});
HTML3-COMPATIBLE BROWSERS ONLY:
- print $query->checkbox_group(-name=>'group_name',
+ print checkbox_group(-name=>'group_name',
-values=>['eenie','meenie','minie','moe'],
-rows=2,-columns=>2);
line breaks between the checkboxes so that they appear as a vertical
list. Otherwise, they will be strung together on a horizontal line.
-=item 4.
+=back
-The optional fifth argument is a pointer to an associative array
-relating the checkbox values to the user-visible labels that will
-be printed next to them (-labels). If not provided, the values will
-be used as the default.
-=item 5.
+The optional b<-labels> argument is a pointer to an associative array
+relating the checkbox values to the user-visible labels that will be
+printed next to them. If not provided, the values will be used as the
+default.
-B<HTML3-compatible browsers> (such as Netscape) can take advantage of
-the optional parameters B<-rows>, and B<-columns>. These parameters
-cause checkbox_group() to return an HTML3 compatible table containing
-the checkbox group formatted with the specified number of rows and
-columns. You can provide just the -columns parameter if you wish;
-checkbox_group will calculate the correct number of rows for you.
-=item 6.
+Modern browsers can take advantage of the optional parameters
+B<-rows>, and B<-columns>. These parameters cause checkbox_group() to
+return an HTML3 compatible table containing the checkbox group
+formatted with the specified number of rows and columns. You can
+provide just the -columns parameter if you wish; checkbox_group will
+calculate the correct number of rows for you.
-The optional sixth parameter (-attributes) is provided to assign
-any of the common HTML attributes to an individual menu item. It's
-a pointer to an associative array relating menu values to another
-associative array with the attribute's name as the key and the
-attribute's value as the value.
-To include row and column headings in the returned table, you
-can use the B<-rowheaders> and B<-colheaders> parameters. Both
-of these accept a pointer to an array of headings to use.
-The headings are just decorative. They don't reorganize the
-interpretation of the checkboxes -- they're still a single named
-unit.
+The optional B<-attributes> argument is provided to assign any of the
+common HTML attributes to an individual menu item. It's a pointer to
+an associative array relating menu values to another associative array
+with the attribute's name as the key and the attribute's value as the
+value.
-=back
+The optional B<-tabindex> argument can be used to control the order in which
+radio buttons receive focus when the user presses the tab button. If
+passed a scalar numeric value, the first element in the group will
+receive this tab index and subsequent elements will be incremented by
+one. If given a reference to an array of radio button values, then
+the indexes will be jiggered so that the order specified in the array
+will correspond to the tab order. You can also pass a reference to a
+hash in which the hash keys are the radio button values and the values
+are the tab indexes of each button. Examples:
+
+ -tabindex => 100 # this group starts at index 100 and counts up
+ -tabindex => ['moe','minie','eenie','meenie'] # tab in this order
+ -tabindex => {meenie=>100,moe=>101,minie=>102,eenie=>200} # tab in this order
When the form is processed, all checked boxes will be returned as
a list under the parameter name 'group_name'. The values of the
"on" checkboxes can be retrieved with:
- @turned_on = $query->param('group_name');
+ @turned_on = param('group_name');
The value returned by checkbox_group() is actually an array of button
elements. You can capture them and use them within tables, lists,
or in other creative ways:
- @h = $query->checkbox_group(-name=>'group_name',-values=>\@values);
+ @h = checkbox_group(-name=>'group_name',-values=>\@values);
&use_in_creative_way(@h);
-JAVASCRIPTING: checkbox_group() recognizes the B<-onClick>
-parameter. This specifies a JavaScript code fragment or
-function call to be executed every time the user clicks on
-any of the buttons in the group. You can retrieve the identity
-of the particular button clicked on using the "this" variable.
-
=head2 CREATING A STANDALONE CHECKBOX
- print $query->checkbox(-name=>'checkbox_name',
+ print checkbox(-name=>'checkbox_name',
-checked=>1,
-value=>'ON',
-label=>'CLICK ME');
-or-
- print $query->checkbox('checkbox_name','checked','ON','CLICK ME');
+ print checkbox('checkbox_name','checked','ON','CLICK ME');
checkbox() is used to create an isolated checkbox that isn't logically
related to any others.
The value of the checkbox can be retrieved using:
- $turned_on = $query->param('checkbox_name');
-
-JAVASCRIPTING: checkbox() recognizes the B<-onClick>
-parameter. See checkbox_group() for further details.
+ $turned_on = param('checkbox_name');
=head2 CREATING A RADIO BUTTON GROUP
- print $query->radio_group(-name=>'group_name',
+ print radio_group(-name=>'group_name',
-values=>['eenie','meenie','minie'],
-default=>'meenie',
-linebreak=>'true',
-or-
- print $query->radio_group('group_name',['eenie','meenie','minie'],
+ print radio_group('group_name',['eenie','meenie','minie'],
'meenie','true',\%labels,\%attributes);
HTML3-COMPATIBLE BROWSERS ONLY:
- print $query->radio_group(-name=>'group_name',
+ print radio_group(-name=>'group_name',
-values=>['eenie','meenie','minie','moe'],
-rows=2,-columns=>2);
used in the display. If not provided, the values themselves are
displayed.
-=item 6.
-
-B<HTML3-compatible browsers> (such as Netscape) can take advantage
-of the optional
-parameters B<-rows>, and B<-columns>. These parameters cause
-radio_group() to return an HTML3 compatible table containing
-the radio group formatted with the specified number of rows
-and columns. You can provide just the -columns parameter if you
-wish; radio_group will calculate the correct number of rows
-for you.
+=back
-=item 6.
-The optional sixth parameter (-attributes) is provided to assign
-any of the common HTML attributes to an individual menu item. It's
-a pointer to an associative array relating menu values to another
-associative array with the attribute's name as the key and the
-attribute's value as the value.
+All modern browsers can take advantage of the optional parameters
+B<-rows>, and B<-columns>. These parameters cause radio_group() to
+return an HTML3 compatible table containing the radio group formatted
+with the specified number of rows and columns. You can provide just
+the -columns parameter if you wish; radio_group will calculate the
+correct number of rows for you.
To include row and column headings in the returned table, you
can use the B<-rowheader> and B<-colheader> parameters. Both
interpretation of the radio buttons -- they're still a single named
unit.
-=back
+The optional B<-tabindex> argument can be used to control the order in which
+radio buttons receive focus when the user presses the tab button. If
+passed a scalar numeric value, the first element in the group will
+receive this tab index and subsequent elements will be incremented by
+one. If given a reference to an array of radio button values, then
+the indexes will be jiggered so that the order specified in the array
+will correspond to the tab order. You can also pass a reference to a
+hash in which the hash keys are the radio button values and the values
+are the tab indexes of each button. Examples:
+
+ -tabindex => 100 # this group starts at index 100 and counts up
+ -tabindex => ['moe','minie','eenie','meenie'] # tab in this order
+ -tabindex => {meenie=>100,moe=>101,minie=>102,eenie=>200} # tab in this order
+
+
+The optional B<-attributes> argument is provided to assign any of the
+common HTML attributes to an individual menu item. It's a pointer to
+an associative array relating menu values to another associative array
+with the attribute's name as the key and the attribute's value as the
+value.
When the form is processed, the selected radio button can
be retrieved using:
- $which_radio_button = $query->param('group_name');
+ $which_radio_button = param('group_name');
The value returned by radio_group() is actually an array of button
elements. You can capture them and use them within tables, lists,
or in other creative ways:
- @h = $query->radio_group(-name=>'group_name',-values=>\@values);
+ @h = radio_group(-name=>'group_name',-values=>\@values);
&use_in_creative_way(@h);
=head2 CREATING A SUBMIT BUTTON
- print $query->submit(-name=>'button_name',
+ print submit(-name=>'button_name',
-value=>'value');
-or-
- print $query->submit('button_name','value');
+ print submit('button_name','value');
submit() will create the query submission button. Every form
should have one of these.
You can figure out which button was pressed by using different
values for each one:
- $which_one = $query->param('button_name');
-
-JAVASCRIPTING: radio_group() recognizes the B<-onClick>
-parameter. See checkbox_group() for further details.
+ $which_one = param('button_name');
=head2 CREATING A RESET BUTTON
- print $query->reset
+ print reset
reset() creates the "reset" button. Note that it restores the
form to its value from the last time the script was called,
=head2 CREATING A DEFAULT BUTTON
- print $query->defaults('button_label')
+ print defaults('button_label')
defaults() creates a button that, when invoked, will cause the
form to be completely reset to its defaults, wiping out all the
=head2 CREATING A HIDDEN FIELD
- print $query->hidden(-name=>'hidden_name',
+ print hidden(-name=>'hidden_name',
-default=>['value1','value2'...]);
-or-
- print $query->hidden('hidden_name','value1','value2'...);
+ print hidden('hidden_name','value1','value2'...);
hidden() produces a text field that can't be seen by the user. It
is useful for passing state variable information from one invocation
Fetch the value of a hidden field this way:
- $hidden_value = $query->param('hidden_name');
+ $hidden_value = param('hidden_name');
Note, that just like all the other form elements, the value of a
hidden field is "sticky". If you want to replace a hidden field with
some other values after the script has been called once you'll have to
do it manually:
- $query->param('hidden_name','new','values','here');
+ param('hidden_name','new','values','here');
=head2 CREATING A CLICKABLE IMAGE BUTTON
- print $query->image_button(-name=>'button_name',
+ print image_button(-name=>'button_name',
-src=>'/source/URL',
-align=>'MIDDLE');
-or-
- print $query->image_button('button_name','/source/URL','MIDDLE');
+ print image_button('button_name','/source/URL','MIDDLE');
image_button() produces a clickable image. When it's clicked on the
position of the click is returned to your script as "button_name.x"
and "button_name.y", where "button_name" is the name you've assigned
to it.
-JAVASCRIPTING: image_button() recognizes the B<-onClick>
-parameter. See checkbox_group() for further details.
-
=over 4
=item B<Parameters:>
=back
Fetch the value of the button this way:
- $x = $query->param('button_name.x');
- $y = $query->param('button_name.y');
+ $x = param('button_name.x');
+ $y = param('button_name.y');
=head2 CREATING A JAVASCRIPT ACTION BUTTON
- print $query->button(-name=>'button_name',
+ print button(-name=>'button_name',
-value=>'user visible label',
-onClick=>"do_something()");
-or-
- print $query->button('button_name',"do_something()");
+ print button('button_name',"do_something()");
button() produces a button that is compatible with Netscape 2.0's
JavaScript. When it's pressed the fragment of JavaScript code
The interface to HTTP cookies is the B<cookie()> method:
- $cookie = $query->cookie(-name=>'sessionID',
+ $cookie = cookie(-name=>'sessionID',
-value=>'xyzzy',
-expires=>'+1h',
-path=>'/cgi-bin/database',
-domain=>'.capricorn.org',
-secure=>1);
- print $query->header(-cookie=>$cookie);
+ print header(-cookie=>$cookie);
B<cookie()> creates a new cookie. Its parameters include:
array reference, or even associative array reference. For example,
you can store an entire associative array into a cookie this way:
- $cookie=$query->cookie(-name=>'family information',
+ $cookie=cookie(-name=>'family information',
-value=>\%childrens_ages);
=item B<-path>
The cookie created by cookie() must be incorporated into the HTTP
header within the string returned by the header() method:
- print $query->header(-cookie=>$my_cookie);
+ print header(-cookie=>$my_cookie);
To create multiple cookies, give header() an array reference:
- $cookie1 = $query->cookie(-name=>'riddle_name',
+ $cookie1 = cookie(-name=>'riddle_name',
-value=>"The Sphynx's Question");
- $cookie2 = $query->cookie(-name=>'answers',
+ $cookie2 = cookie(-name=>'answers',
-value=>\%answers);
- print $query->header(-cookie=>[$cookie1,$cookie2]);
+ print header(-cookie=>[$cookie1,$cookie2]);
To retrieve a cookie, request it by name by calling cookie() method
without the B<-value> parameter:
use CGI;
$query = new CGI;
- $riddle = $query->cookie('riddle_name');
- %answers = $query->cookie('answers');
+ $riddle = cookie('riddle_name');
+ %answers = cookie('answers');
Cookies created with a single scalar value, such as the "riddle_name"
cookie, will be returned in that form. Cookies with array and hash
simple to turn a CGI parameter into a cookie, and vice-versa:
# turn a CGI parameter into a cookie
- $c=$q->cookie(-name=>'answers',-value=>[$q->param('answers')]);
+ $c=cookie(-name=>'answers',-value=>[param('answers')]);
# vice-versa
- $q->param(-name=>'answers',-value=>[$q->cookie('answers')]);
+ param(-name=>'answers',-value=>[cookie('answers')]);
See the B<cookie.cgi> example script for some ideas on how to use
cookies effectively.
You may provide a B<-target> parameter to the header() method:
- print $q->header(-target=>'ResultsWindow');
+ print header(-target=>'ResultsWindow');
This will tell the browser to load the output of your script into the
frame named "ResultsWindow". If a frame of that name doesn't already
You can specify the frame to load in the FORM tag itself. With
CGI.pm it looks like this:
- print $q->start_form(-target=>'ResultsWindow');
+ print start_form(-target=>'ResultsWindow');
When your script is reinvoked by the form, its output will be loaded
into the frame named "ResultsWindow". If one doesn't already exist
create pages in which the fill-out form and the response live in
side-by-side frames.
+=head1 SUPPORT FOR JAVASCRIPT
+
+Netscape versions 2.0 and higher incorporate an interpreted language
+called JavaScript. Internet Explorer, 3.0 and higher, supports a
+closely-related dialect called JScript. JavaScript isn't the same as
+Java, and certainly isn't at all the same as Perl, which is a great
+pity. JavaScript allows you to programatically change the contents of
+fill-out forms, create new windows, and pop up dialog box from within
+Netscape itself. From the point of view of CGI scripting, JavaScript
+is quite useful for validating fill-out forms prior to submitting
+them.
+
+You'll need to know JavaScript in order to use it. There are many good
+sources in bookstores and on the web.
+
+The usual way to use JavaScript is to define a set of functions in a
+<SCRIPT> block inside the HTML header and then to register event
+handlers in the various elements of the page. Events include such
+things as the mouse passing over a form element, a button being
+clicked, the contents of a text field changing, or a form being
+submitted. When an event occurs that involves an element that has
+registered an event handler, its associated JavaScript code gets
+called.
+
+The elements that can register event handlers include the <BODY> of an
+HTML document, hypertext links, all the various elements of a fill-out
+form, and the form itself. There are a large number of events, and
+each applies only to the elements for which it is relevant. Here is a
+partial list:
+
+=over 4
+
+=item B<onLoad>
+
+The browser is loading the current document. Valid in:
+
+ + The HTML <BODY> section only.
+
+=item B<onUnload>
+
+The browser is closing the current page or frame. Valid for:
+
+ + The HTML <BODY> section only.
+
+=item B<onSubmit>
+
+The user has pressed the submit button of a form. This event happens
+just before the form is submitted, and your function can return a
+value of false in order to abort the submission. Valid for:
+
+ + Forms only.
+
+=item B<onClick>
+
+The mouse has clicked on an item in a fill-out form. Valid for:
+
+ + Buttons (including submit, reset, and image buttons)
+ + Checkboxes
+ + Radio buttons
+
+=item B<onChange>
+
+The user has changed the contents of a field. Valid for:
+
+ + Text fields
+ + Text areas
+ + Password fields
+ + File fields
+ + Popup Menus
+ + Scrolling lists
+
+=item B<onFocus>
+
+The user has selected a field to work with. Valid for:
+
+ + Text fields
+ + Text areas
+ + Password fields
+ + File fields
+ + Popup Menus
+ + Scrolling lists
+
+=item B<onBlur>
+
+The user has deselected a field (gone to work somewhere else). Valid
+for:
+
+ + Text fields
+ + Text areas
+ + Password fields
+ + File fields
+ + Popup Menus
+ + Scrolling lists
+
+=item B<onSelect>
+
+The user has changed the part of a text field that is selected. Valid
+for:
+
+ + Text fields
+ + Text areas
+ + Password fields
+ + File fields
+
+=item B<onMouseOver>
+
+The mouse has moved over an element.
+
+ + Text fields
+ + Text areas
+ + Password fields
+ + File fields
+ + Popup Menus
+ + Scrolling lists
+
+=item B<onMouseOut>
+
+The mouse has moved off an element.
+
+ + Text fields
+ + Text areas
+ + Password fields
+ + File fields
+ + Popup Menus
+ + Scrolling lists
+
+=back
+
+In order to register a JavaScript event handler with an HTML element,
+just use the event name as a parameter when you call the corresponding
+CGI method. For example, to have your validateAge() JavaScript code
+executed every time the textfield named "age" changes, generate the
+field like this:
+
+ print textfield(-name=>'age',-onChange=>"validateAge(this)");
+
+This example assumes that you've already declared the validateAge()
+function by incorporating it into a <SCRIPT> block. The CGI.pm
+start_html() method provides a convenient way to create this section.
+
+Similarly, you can create a form that checks itself over for
+consistency and alerts the user if some essential value is missing by
+creating it this way:
+ print startform(-onSubmit=>"validateMe(this)");
+
+See the javascript.cgi script for a demonstration of how this all
+works.
+
+
=head1 LIMITED SUPPORT FOR CASCADING STYLE SHEETS
CGI.pm has limited support for HTML3's cascading style sheets (css).
arbitrary formatting in the header, you may pass a -verbatim tag to
the -style hash, as follows:
-print $q->start_html (-STYLE => {-verbatim => '@import
+print start_html (-STYLE => {-verbatim => '@import
url("/server-common/css/'.$cssFile.'");',
-src => '/server-common/css/core.css'});
</blockquote></pre>
name/value pairs formatted nicely as a nested list. This is useful
for debugging purposes:
- print $query->Dump
+ print Dump
Produces something that looks like:
Return a list of MIME types that the remote browser accepts. If you
give this method a single argument corresponding to a MIME type, as in
-$query->Accept('text/html'), it will return a floating point value
+Accept('text/html'), it will return a floating point value
corresponding to the browser's preference for this type from 0.0
(don't want) to 1.0. Glob types (e.g. text/*) in the browser's accept
list are handled correctly.
Returns the HTTP_USER_AGENT variable. If you give
this method a single argument, it will attempt to
pattern match on it, allowing you to do something
-like $query->user_agent(netscape);
+like user_agent(netscape);
=item B<path_info()>
Returns additional path information from the script URL.
E.G. fetching /cgi-bin/your_script/additional/stuff will result in
-$query->path_info() returning "/additional/stuff".
+path_info() returning "/additional/stuff".
NOTE: The Microsoft Internet Information Server
is broken with respect to additional path information. If
For example, all three of these examples are equivalent:
- $requested_language = $q->http('Accept-language');
- $requested_language = $q->http('Accept_language');
- $requested_language = $q->http('HTTP_ACCEPT_LANGUAGE');
+ $requested_language = http('Accept-language');
+ $requested_language = http('Accept_language');
+ $requested_language = http('HTTP_ACCEPT_LANGUAGE');
=item B<https()>
in the B<header()> and B<redirect()> statements:
- print $q->header(-nph=>1);
+ print header(-nph=>1);
=back
this way:
$q = $in{CGI};
- print $q->textfield(-name=>'wow',
+ print textfield(-name=>'wow',
-value=>'does this really work?');
This allows you to start using the more interesting features
#!/usr/local/bin/perl
- use CGI;
+ use CGI ':standard';
- $query = new CGI;
-
- print $query->header;
- print $query->start_html("Example CGI.pm Form");
+ print header;
+ print start_html("Example CGI.pm Form");
print "<h1> Example CGI.pm Form</h1>\n";
- &print_prompt($query);
- &do_work($query);
- &print_tail;
- print $query->end_html;
+ print_prompt();
+ do_work();
+ print_tail();
+ print end_html;
sub print_prompt {
- my($query) = @_;
-
- print $query->start_form;
+ print start_form;
print "<em>What's your name?</em><br>";
- print $query->textfield('name');
- print $query->checkbox('Not my real name');
+ print textfield('name');
+ print checkbox('Not my real name');
print "<p><em>Where can you find English Sparrows?</em><br>";
- print $query->checkbox_group(
+ print checkbox_group(
-name=>'Sparrow locations',
-values=>[England,France,Spain,Asia,Hoboken],
-linebreak=>'yes',
-defaults=>[England,Asia]);
print "<p><em>How far can they fly?</em><br>",
- $query->radio_group(
+ radio_group(
-name=>'how far',
-values=>['10 ft','1 mile','10 miles','real far'],
-default=>'1 mile');
print "<p><em>What's your favorite color?</em> ";
- print $query->popup_menu(-name=>'Color',
+ print popup_menu(-name=>'Color',
-values=>['black','brown','red','yellow'],
-default=>'red');
- print $query->hidden('Reference','Monty Python and the Holy Grail');
+ print hidden('Reference','Monty Python and the Holy Grail');
print "<p><em>What have you got there?</em><br>";
- print $query->scrolling_list(
+ print scrolling_list(
-name=>'possessions',
-values=>['A Coconut','A Grail','An Icon',
'A Sword','A Ticket'],
-multiple=>'true');
print "<p><em>Any parting comments?</em><br>";
- print $query->textarea(-name=>'Comments',
+ print textarea(-name=>'Comments',
-rows=>10,
-columns=>50);
- print "<p>",$query->reset;
- print $query->submit('Action','Shout');
- print $query->submit('Action','Scream');
- print $query->endform;
+ print "<p>",reset;
+ print submit('Action','Shout');
+ print submit('Action','Scream');
+ print endform;
print "<hr>\n";
}
sub do_work {
- my($query) = @_;
my(@values,$key);
print "<h2>Here are the current settings in this form</h2>";
- foreach $key ($query->param) {
+ foreach $key (param) {
print "<strong>$key</strong> -> ";
- @values = $query->param($key);
+ @values = param($key);
print join(", ",@values),"<br>\n";
}
}
projects / p5sagit/p5-mst-13.2.git / commitdiff