CGI
view release on metacpan or search on metacpan
[BUG FIXES]
1. In CGI::Pretty, we no longer add line breaks after tags we claim not to format. Thanks to rrt, Bob Kuo and
and Mark Stosberg. (RT#42114).
2. unescapeHTML() no longer falsely recognizes certain text as entities. Thanks to Pete Gamanche, Mark Stosberg
and Bob Kuo. (RT#39122)
3. checkbox_group() now correctly includes a space before the "checked" attribute.
Thanks to Andrew Speer and Bob Kuo. (RT#36583)
4. Fix case-sensitivity in http() and https() according to docs. Make https()
return list of keys in list context. Thanks to riQyRoe and Rhesa Rozendaal. (RT#12909)
5. XHTML is now automatically disabled for HTML 4, as well as HTML 2 and HTML 3. Thanks to
Dan Harkless and Yanick Champoux. (RT#27907)
6. Pre-compiling 'end_form' with ':form' switch now works. Thanks to ryochin and Yanick Champoux. (RT#41530)
7. Empty name/values pairs are now properly saved and restored from filehandles. Thanks to rlucas and
Rhesa Rozendaal (RT#13158)
8. Some differences between startform() and start_form() have been fixed. Thanks to Slaven Rezic and
Shawn Corey. (RT#22046)
9. url_param() has been updated to be more consistent with the documentation and param().
Thanks to Britton Kerin and Yanick Campoux. (RT#43587)
10.hidden() now correctly supports multiple default values.
Thanks to david@dierauer.net and Russell Jenkins. (RT#20436)
reporting of compile-time errors.
Fixed potential deadlock between web server and CGI.pm when aborting
a read due to POST_MAX (reported by Antti Lankila).
Fixed issue with tag-generating function not incorporating content
when first variable undef.
Fixed cross-site scripting bug reported by obscure.
Fixed Dump() function to return correctly formed XHTML - bug
reported by Ralph Siemsen.
Version 2.93
1. Fixed embarassing bug in mp1 support.
Version 2.92
1. Fix to be P3P compliant submitted from MPREWITT.
2. Added CGI->r() API for mod_perl1/mod_perl2.
Version 2.84
1. Fix for failed file uploads on Cygwin platforms.
2. HTML escaping code now replaced 0x8b and 0x9b with unicode
references < and *#8250;
Version 2.83
1. Fixed autoEscape() documentation inconsistencies.
2. Patch from Ville Skytt� to fix a number of XHTML inconsistencies.
3. Added Max-Age to list of CGI::Cookie headers.
Version 2.82
1. Patch from Rudolf Troller to add attribute setting and option
groups to form fields.
2. Patch from Simon Perreault for silent crashes when using CGI::Carp
under mod_perl.
3. Patch from Scott Gifford allows you to set the program name for
CGI::Carp.
Version 2.81
1. Removed extraneous slash from end of stylesheet tags generated by
start_html in non-XHTML mode.
2. Changed behavior of CGI::Carp with respect to eval{} contexts so
that output behaves properly in mod_perl environments.
3. Fixed default DTD so that it validates with W3C validator.
Version 2.80
1. Fixed broken messages in CGI::Carp.
2. Changed checked="1" to checked="checked" for real XHTML
compatibility.
3. Resurrected REQUEST_URI code so that url() works correctly with
multiviews.
Version 2.79
1. Changes to CGI::Carp to avoid "subroutine redefined" error
messages.
2. Default DTD is now XHTML 1.0 Transitional
3. Patches to support all HTML4 tags.
Version 2.78
1. Added ability to change encoding in <?xml> assertion.
2. Fixed the old escapeHTML('CGI') ne "CGI" bug
3. In accordance with XHTML requirements, there are no longer any
minimized attributes, such as "checked".
4. Patched bug which caused file uploads of exactly 4096 bytes to be
truncated to 4094 (thanks to Kevin Mahony)
5. New tests and fixes to CGI::Pretty (thanks to Michael Schwern).
Version 2.77
1. No new features, but released in order to fix an apparent CPAN
bug.
1. Tiny tweak to filename regular expression function on line 3355.
Version 2.75
1. Fixed bug in server push boundary strings (CGI.pm and CGI::Push).
2. Fixed bug that occurs when uploading files with funny characters
in the name
3. Fixed non-XHTML-compliant attributes produced by textfield()
4. Added EPOC support, courtesy Olaf Flebbe
5. Fixed minor XHTML bugs.
6. Made escape() and unescape() symmetric with respect to EBCDIC,
courtesy Roca, Ignasi <ignasi.roca@fujitsu.siemens.es>
7. Removed uninitialized variable warning from CGI::Cookie, provided
by Atipat Rojnuckarin <rojnuca@yahoo.com>
8. Fixed bug in CGI::Pretty that causes it to print partial end tags
when the $INDENT global is changed.
9. Single quotes are changed to character entity ' for compatibility
with URLs.
Version 2.74
September 13, 2000
1. Quashed one-character bug that caused CGI.pm to fail on file
uploads.
Version 2.73
September 12, 2000
1. Added -base to the list of arguments accepted by url().
2. Fixes to XHTML support.
3. POST parameters no longer show up in the Location box.
Version 2.72
August 19, 2000
1. Fixed the defaults button so that it works again
2. Charset is now correctly saved and restored when saving to files
3. url() now works correctly when given scripts with %20 and other
escapes in the additional path info. This undoes a patch
introduced in version 2.47 that I no longer understand the
rationale for.
Version 2.71
August 13, 2000
1. Newlines in the value attributes of hidden fields and other form
elements are now escaped when using ISO-Latin.
2. Inline script and style sections are now protected as CDATA
sections when XHTML mode is on (the default).
Version 2.70
August 4, 2000
1. Fixed bug in scrolling_list() which omitted a space in front of
the "multiple" attribute.
2. Squashed the "useless use of string in void context" message from
redirects.
Version 2.69
1. startform() now creates default ACTION for POSTs as well as GETs.
This may break some browsers, but it no longer violates the HTML
spec.
2. CGI.pm now emits XHTML by default. Disable with -no_xhtml.
3. We no longer interpret &#ddd sequences in non-latin character
sets.
Version 2.68
1. No longer attempts to escape characters when dealing with non
ISO-8861 character sets.
2. checkbox() function now defaults to using -value as its label,
rather than -name. The current behavior is what has been
documented from the beginning.
3. -style accepts array reference to incorporate multiple stylesheets
into document.
1. Fixed two bugs that caused the -compile pragma to fail with a
syntax error.
Version 2.67
1. Added XHTML support (incomplete; tags need to be lowercased).
2. Fixed CGI/Carp when running under mod_perl. Probably broke in
other contexts.
3. Fixed problems when passing multiple cookies.
4. Suppress warnings from _tableize() that were appearing when using
-w switch with radio_group() and checkbox_group().
5. Support for the header() -attachment argument, which can give
pages a default file name when saving to disk.
Version 2.66
examples/wikipedia_example.cgi view on Meta::CPAN
use warnings;
use CGI;
my $cgi = CGI->new;
print $cgi->header('text/html');
print << "EndOfHTML";
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"
>
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
<head>
<title>A Simple CGI Page</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
</head>
<body>
<h1>A Simple CGI Page</h1>
<form method="post" enctype="multipart/form-data">
my $appease_cpants_kwalitee = q/
use strict;
use warnings;
#/;
$CGI::VERSION='4.68';
use CGI::Util qw(rearrange rearrange_header make_attributes unescape escape expires ebcdic2ascii ascii2ebcdic check_hash_param);
$_XHTML_DTD = ['-//W3C//DTD XHTML 1.0 Transitional//EN',
'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd'];
{
local $^W = 0;
$TAINTED = substr("$0$^X",0,0);
}
$MOD_PERL = 0; # no mod_perl by default
#global settings
$LIST_CONTEXT_WARN = 1;
$ENCODE_ENTITIES = q{&<>"'};
$ALLOW_DELETE_CONTENT = 0;
$COOKIE_CACHE = 0; # backcompat: cache was broken for years
@SAVED_SYMBOLS = ();
# >>>>> Here are some globals that you might want to adjust <<<<<<
sub initialize_globals {
# Set this to 1 to generate XTML-compatible output
$XHTML = 1;
# Change this to the preferred DTD to print in start_html()
# or use default_dtd('text of DTD to use');
$DEFAULT_DTD = [ '-//W3C//DTD HTML 4.01 Transitional//EN',
'http://www.w3.org/TR/html4/loose.dtd' ] ;
# Set this to 1 to enable NOSTICKY scripts
# or:
# 1) use CGI '-nosticky';
# 2) $CGI::NOSTICKY = 1;
unshift @rest,$a if defined $a;
}
$tagname = lc( $tagname );
if ($tagname=~/start_(\w+)/i) {
return "<$1$attr>";
} elsif ($tagname=~/end_(\w+)/i) {
return "</$1>";
} else {
return $XHTML ? "<$tagname$attr />" : "<$tagname$attr>" unless @rest;
my($tag,$untag) = ("<$tagname$attr>","</$tagname>");
my @result = map { "$tag$_$untag" }
(ref($rest[0]) eq 'ARRAY') ? @{$rest[0]} : "@rest";
return "@result";
}
}
sub _selected {
my $self = shift;
my $value = shift;
return '' unless $value;
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 );
}
sub _reset_globals { initialize_globals(); }
sub _setup_symbols {
my $self = shift;
# to avoid reexporting unwanted variables
undef %EXPORT;
# Need to sort out the DTD before it's okay to call escapeHTML().
my(@result,$xml_dtd);
if ($dtd) {
if (defined(ref($dtd)) and (ref($dtd) eq 'ARRAY')) {
$dtd = $DEFAULT_DTD unless $dtd->[0] =~ m|^-//|;
} else {
$dtd = $DEFAULT_DTD unless $dtd =~ m|^-//|;
}
} else {
$dtd = $XHTML ? $_XHTML_DTD : $DEFAULT_DTD;
}
$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 && $declare_xml;
if (ref($dtd) && ref($dtd) eq 'ARRAY') {
push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd->[0]"\n\t "$dtd->[1]">));
$DTD_PUBLIC_IDENTIFIER = $dtd->[0];
} else {
}
# Now that we know whether we're using the HTML 3.2 DTD or not, it's okay to
# call escapeHTML(). Strangely enough, the title needs to be escaped as
# HTML while the author needs to be escaped as a URL.
$title = $self->_maybe_escapeHTML($title || 'Untitled Document');
$author = $self->escape($author);
if ($DTD_PUBLIC_IDENTIFIER =~ /[^X]HTML (2\.0|3\.2|4\.01?)/i) {
$lang = "" unless defined $lang;
$XHTML = 0;
}
else {
$lang = 'en-US' unless defined $lang;
}
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\">");
}
if ($base || $xbase || $target) {
my $href = $xbase || $self->url('-path'=>1);
my $t = $target ? qq/ target="$target"/ : '';
push(@result,$XHTML ? qq(<base href="$href"$t />) : qq(<base href="$href"$t>));
}
if ($meta && ref($meta) && (ref($meta) eq 'HASH')) {
for (sort keys %$meta) { push(@result,$XHTML ? qq(<meta name="$_" content="$meta->{$_}" />)
: qq(<meta name="$_" content="$meta->{$_}">)); }
}
my $meta_bits_set = 0;
if( $head ) {
if( ref $head ) {
push @result, @$head;
$meta_bits_set = 1 if grep { /http-equiv=["']Content-Type/i }@$head;
}
else {
# internal method for generating a CSS style section
####
sub _style {
my ($self,$style) = @_;
my (@result);
my $type = 'text/css';
my $rel = 'stylesheet';
my $cdata_start = $XHTML ? "\n<!--/* <![CDATA[ */" : "\n<!-- ";
my $cdata_end = $XHTML ? "\n/* ]]> */-->\n" : " -->\n";
my @s = ref($style) eq 'ARRAY' ? @$style : $style;
my $other = '';
for my $s (@s) {
if (ref($s)) {
my($src,$code,$verbatim,$stype,$alternate,$foo,@other) =
rearrange([qw(SRC CODE VERBATIM TYPE ALTERNATE FOO)],
('-foo'=>'bar',
ref($s) eq 'ARRAY' ? @$s : %$s));
my $type = defined $stype ? $stype : 'text/css';
my $rel = $alternate ? 'alternate stylesheet' : 'stylesheet';
$other = "@other" if @other;
if (ref($src) eq "ARRAY") # Check to see if the $src variable is an array reference
{ # If it is, push a LINK tag for each one
for $src (@$src)
{
push(@result,$XHTML ? qq(<link rel="$rel" type="$type" href="$src" $other/>)
: qq(<link rel="$rel" type="$type" href="$src"$other>)) if $src;
}
}
else
{ # Otherwise, push the single -src, if it exists.
push(@result,$XHTML ? qq(<link rel="$rel" type="$type" href="$src" $other/>)
: qq(<link rel="$rel" type="$type" href="$src"$other>)
) if $src;
}
if ($verbatim) {
my @v = ref($verbatim) eq 'ARRAY' ? @$verbatim : $verbatim;
push(@result, "<style type=\"text/css\">\n$_\n</style>") for @v;
}
if ($code) {
my @c = ref($code) eq 'ARRAY' ? @$code : $code;
push(@result,style({'type'=>$type},"$cdata_start\n$_\n$cdata_end")) for @c;
}
} else {
my $src = $s;
push(@result,$XHTML ? qq(<link rel="$rel" type="$type" href="$src" $other/>)
: qq(<link rel="$rel" type="$type" href="$src"$other>));
}
}
@result;
}
sub _script {
my ($self,$script) = @_;
my (@result);
# Just prints out the isindex tag.
# Parameters:
# $action -> optional URL of script to run
# Returns:
# A string containing a <isindex> tag
sub isindex {
my($self,@p) = self_or_default(@_);
my($action,@other) = rearrange([ACTION],@p);
$action = qq/ action="$action"/ if $action;
my($other) = @other ? " @other" : '';
return $XHTML ? "<isindex$action$other />" : "<isindex$action$other>";
}
#### Method: start_form
# Start a form
# Parameters:
# $method -> optional submission method to use (GET or POST)
# $action -> optional URL of script to run
# $enctype ->encoding to use (URL_ENCODED or MULTIPART)
sub start_form {
my($self,@p) = self_or_default(@_);
my($method,$action,$enctype,@other) =
rearrange([METHOD,ACTION,ENCTYPE],@p);
$method = $self->_maybe_escapeHTML(lc($method || 'post'));
if( $XHTML ){
$enctype = $self->_maybe_escapeHTML($enctype || &MULTIPART);
}else{
$enctype = $self->_maybe_escapeHTML($enctype || &URL_ENCODED);
}
if (defined $action) {
$action = $self->_maybe_escapeHTML($action);
}
else {
$action = $self->_maybe_escapeHTML($self->request_uri || $self->self_url);
$current = defined($current) ? $self->_maybe_escapeHTML($current,1) : '';
$name = defined($name) ? $self->_maybe_escapeHTML($name) : '';
my($s) = defined($size) ? qq/ size="$size"/ : '';
my($m) = defined($maxlength) ? qq/ maxlength="$maxlength"/ : '';
my($other) = @other ? " @other" : '';
# 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") : '';
$tabindex = $self->element_tab($tabindex);
return $XHTML ? qq(<input type="$tag" name="$name" $tabindex$value$s$m$other />)
: qq(<input type="$tag" name="$name" $value$s$m$other>);
}
#### Method: textfield
# Parameters:
# $name -> Name of the text field
# $default -> Optional default value of the field if not
# already defined.
# $size -> Optional width of field in characaters.
# $maxlength -> Optional maximum number of characters.
$script ||= '';
my($name) = '';
$name = qq/ name="$label"/ if $label;
$value = $value || $label;
my($val) = '';
$val = qq/ value="$value"/ if $value;
$script = qq/ onclick="$script"/ if $script;
my($other) = @other ? " @other" : '';
$tabindex = $self->element_tab($tabindex);
return $XHTML ? qq(<input type="button" $tabindex$name$val$script$other />)
: qq(<input type="button"$name$val$script$other>);
}
#### Method: submit
# Create a "submit query" button.
# Parameters:
# $name -> (optional) Name for the button.
# $value -> (optional) Value of the button when selected (also doubles as label).
# $label -> (optional) Label printed on the button(also doubles as the value).
# Returns:
$label=$self->_maybe_escapeHTML($label);
$value=$self->_maybe_escapeHTML($value,1);
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);
$tabindex = $self->element_tab($tabindex);
my($other) = @other ? "@other " : '';
return $XHTML ? qq(<input type="submit" $tabindex$name$val$other/>)
: qq(<input type="submit" $name$val$other>);
}
#### Method: reset
# Create a "reset" button.
# Parameters:
# $name -> (optional) Name for the button.
# Returns:
# A string containing a <input type="reset"> tag
####
my($label,$value,$tabindex,@other) = rearrange(['NAME',['VALUE','LABEL'],TABINDEX],@p);
$label=$self->_maybe_escapeHTML($label);
$value=$self->_maybe_escapeHTML($value,1);
my ($name) = ' name=".reset"';
$name = qq/ name="$label"/ if defined($label);
$value = defined($value) ? $value : $label;
my($val) = '';
$val = qq/ value="$value"/ if defined($value);
my($other) = @other ? " @other" : '';
$tabindex = $self->element_tab($tabindex);
return $XHTML ? qq(<input type="reset" $tabindex$name$val$other />)
: qq(<input type="reset"$name$val$other>);
}
#### Method: defaults
# Create a "defaults" button.
# Parameters:
# $name -> (optional) Name for the button.
# Returns:
# A string containing a <input type="submit" name=".defaults"> tag
#
sub defaults {
my($self,@p) = self_or_default(@_);
my($label,$tabindex,@other) = rearrange([[NAME,VALUE],TABINDEX],@p);
$label=$self->_maybe_escapeHTML($label,1);
$label = $label || "Defaults";
my($value) = qq/ value="$label"/;
my($other) = @other ? " @other" : '';
$tabindex = $self->element_tab($tabindex);
return $XHTML ? qq(<input type="submit" name=".defaults" $tabindex$value$other />)
: qq/<input type="submit" NAME=".defaults"$value$other>/;
}
#### Method: comment
# Create an HTML <!-- comment -->
# Parameters: a string
sub comment {
my($self,@p) = self_or_CGI(@_);
return "<!-- @p -->";
}
} else {
$checked = $self->_checked($checked);
}
my($the_label) = defined $label ? $label : $name;
$name = $self->_maybe_escapeHTML($name);
$value = $self->_maybe_escapeHTML($value,1);
$the_label = $self->_maybe_escapeHTML($the_label);
my($other) = @other ? "@other " : '';
$tabindex = $self->element_tab($tabindex);
$self->register_parameter($name);
return $XHTML ? CGI::label($labelattributes,
qq{<input type="checkbox" name="$name" value="$value" $tabindex$checked$other/>$the_label})
: qq{<input type="checkbox" name="$name" value="$value"$checked$other>$the_label};
}
# Escape HTML
sub escapeHTML {
require HTML::Entities;
# hack to work around earlier hacks
push @_,$_[0] if @_==1 && $_[0] eq 'CGI';
my ($self,$toencode,$newlinestoo) = CGI::self_or_default(@_);
for (@values) {
my $disable="";
if ($disabled{$_}) {
$disable="disabled='1'";
}
my $checkit = $self->_checked($box_type eq 'radio' ? ($checked{$_} && !$radio_checked++)
: $checked{$_});
my($break);
if ($linebreak) {
$break = $XHTML ? "<br />" : "<br>";
}
else {
$break = '';
}
my($label)='';
unless (defined($nolabels) && $nolabels) {
$label = $_;
$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
$label = $self->_maybe_escapeHTML($label,1);
$label = "<span style=\"color:gray\">$label</span>" if $disabled{$_};
my($other) = @other ? " @other" : '';
my(@values);
@values = $self->_set_values_and_labels($values,\$labels,$name);
$tabindex = $self->element_tab($tabindex);
$name = q{} if ! defined $name;
$result = qq/<select name="$name" $tabindex$other>\n/;
for (@values) {
if (/<optgroup/) {
for my $v (split(/\n/)) {
my $selectit = $XHTML ? 'selected="selected"' : 'selected';
for my $selected (sort keys %selected) {
$v =~ s/(value="\Q$selected\E")/$selectit $1/;
}
$result .= "$v\n";
}
}
else {
my $attribs = $self->_set_attributes($_, $attributes);
my($selectit) = $self->_selected($selected{$_});
my($label) = $_;
my($result,@values);
@values = $self->_set_values_and_labels($values,\$labels,$name,$labeled,$novals);
my($other) = @other ? " @other" : '';
$name = $self->_maybe_escapeHTML($name) || q{};
$result = qq/<optgroup label="$name"$other>\n/;
for (@values) {
if (/<optgroup/) {
for (split(/\n/)) {
my $selectit = $XHTML ? 'selected="selected"' : 'selected';
s/(value="$selected")/$selectit $1/ if defined $selected;
$result .= "$_\n";
}
}
else {
my $attribs = $self->_set_attributes($_, $attributes);
my($label) = $_;
$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
$label=$self->_maybe_escapeHTML($label);
my($value)=$self->_maybe_escapeHTML($_,1);
my($is_multiple) = $multiple ? qq/ multiple="multiple"/ : '';
my($has_size) = $size ? qq/ size="$size"/: '';
my($other) = @other ? " @other" : '';
$name=$self->_maybe_escapeHTML($name);
$tabindex = $self->element_tab($tabindex);
$result = qq/<select name="$name" $tabindex$has_size$is_multiple$other>\n/;
for (@values) {
if (/<optgroup/) {
for my $v (split(/\n/)) {
my $selectit = $XHTML ? 'selected="selected"' : 'selected';
for my $selected (sort keys %selected) {
$v =~ s/(value="$selected")/$selectit $1/;
}
$result .= "$v\n";
}
}
else {
my $attribs = $self->_set_attributes($_, $attributes);
my($selectit) = $self->_selected($selected{$_});
my($label) = $_;
undef @other;
}
# use previous values if override is not set
my @prev = $self->param($name);
@value = @prev if !$do_override && @prev;
$name=$self->_maybe_escapeHTML($name);
for (@value) {
$_ = defined($_) ? $self->_maybe_escapeHTML($_,1) : '';
push @result,$XHTML ? qq(<input type="hidden" name="$name" value="$_" @other />)
: qq(<input type="hidden" name="$name" value="$_" @other>);
}
return wantarray ? @result : join('',@result);
}
#### Method: image_button
# Parameters:
# $name -> Name of the button
# $src -> URL of the image source
# $align -> Alignment style (TOP, BOTTOM or MIDDLE)
####
sub image_button {
my($self,@p) = self_or_default(@_);
my($name,$src,$alignment,@other) =
rearrange([NAME,SRC,ALIGN],@p);
my($align) = $alignment ? " align=\L\"$alignment\"" : '';
my($other) = @other ? " @other" : '';
$name=$self->_maybe_escapeHTML($name);
return $XHTML ? qq(<input type="image" name="$name" src="$src"$align$other />)
: qq/<input type="image" name="$name" src="$src"$align$other>/;
}
#### Method: self_url
# Returns a URL containing the current script and all its
# param/value pairs arranged as a query. You can use this
# to create a link that, when selected, will reinvoke the
# script with all its state information preserved.
####
sub self_url {
lib/CGI/HTML/Functions.pod view on Meta::CPAN
turned off, you can still add tab indexes manually by passing a -tabindex
option to each field-generating method.
=item -no_xhtml
By default, CGI.pm versions 2.69 and higher emit XHTML
(http://www.w3.org/TR/xhtml1/). The -no_xhtml pragma disables this feature.
Thanks to Michalis Kabrianis <kabrianis@hellug.gr> for this feature.
If start_html()'s -dtd parameter specifies an HTML 2.0, 3.2, 4.0 or 4.01 DTD,
XHTML will automatically be disabled without needing to use this pragma.
=back
=head2 Special forms for importing HTML-tag functions
Many of the methods generate HTML tags. As described below, tag functions
automatically generate both the opening and closing tags. For example:
print h1('Level 1 Header');
lib/CGI/HTML/Functions.pod view on Meta::CPAN
It is suitable for forms that contain very large fields or that
are intended for transferring binary data. Most importantly,
it enables the "file upload" feature. For
your convenience, CGI.pm stores the name of this encoding type
in B<&CGI::MULTIPART>
Forms that use this type of encoding are not easily interpreted
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
The start_form() method uses the older form of encoding by
default unless XHTML is requested. If you want to use the
newer form of encoding by default, you can call
B<start_multipart_form()> instead of B<start_form()>. The
method B<end_multipart_form()> is an alias to B<end_form()>.
JAVASCRIPTING: The B<-name> and B<-onSubmit> parameters are provided
for use with JavaScript. The -name parameter gives the
form a name so that it can be identified and manipulated by
JavaScript functions. -onSubmit should point to a JavaScript
function that will be executed just before the form is submitted to your
server. You can use this opportunity to check the contents of the form
t/checkbox_group.t view on Meta::CPAN
use CGI (':standard','-no_debug','-no_xhtml');
# no_xhtml test on checkbox_group()
is(checkbox_group(-name => 'game',
'-values' => [qw/checkers chess cribbage/],
'-defaults' => ['cribbage']),
qq(<input type="checkbox" name="game" value="checkers" >checkers <input type="checkbox" name="game" value="chess" >chess <input type="checkbox" name="game" value="cribbage" checked >cribbage),
'checkbox_group()');
# xhtml test on checkbox_group()
$CGI::XHTML = 1;
is(checkbox_group(-name => 'game',
'-values' => [qw/checkers chess cribbage/],
'-defaults' => ['cribbage']),
qq(<label><input type="checkbox" name="game" value="checkers" />checkers</label> <label><input type="checkbox" name="game" value="chess" />chess</label> <label><input type="checkbox" name="game" value="cribbage" checked="checked" />cribbage</label...
'checkbox_group()');
<option value="moe">moe</option>
<option class="red" value="catch">catch</option>
</optgroup>
</select>),
'scrolling_list() + optgroup()');
# ---------- START 22046 ----------
# The following tests were added for
# https://rt.cpan.org/Public/Bug/Display.html?id=22046
# SHCOREY at cpan.org
# Saved whether working with XHTML because need to test both
# with it and without.
my $saved_XHTML = $CGI::XHTML;
# set XHTML
$CGI::XHTML = 1;
is(start_form("GET","/foobar"),
qq{<form method="get" action="/foobar" enctype="multipart/form-data">},
'start_form() + XHTML');
is(start_form("GET", "/foobar",&CGI::URL_ENCODED),
qq{<form method="get" action="/foobar" enctype="application/x-www-form-urlencoded">},
'start_form() + XHTML + URL_ENCODED');
is(start_form("GET", "/foobar",&CGI::MULTIPART),
qq{<form method="get" action="/foobar" enctype="multipart/form-data">},
'start_form() + XHTML + MULTIPART');
is(start_multipart_form("GET", "/foobar"),
qq{<form method="get" action="/foobar" enctype="multipart/form-data">},
'start_multipart_form() + XHTML');
is(start_multipart_form("GET", "/foobar","name=\"foobar\""),
qq{<form method="get" action="/foobar" enctype="multipart/form-data" name="foobar">},
'start_multipart_form() + XHTML + additional args');
# set no XHTML
$CGI::XHTML = 0;
is(start_form("GET","/foobar"),
qq{<form method="get" action="/foobar" enctype="application/x-www-form-urlencoded">},
'start_form() + NO_XHTML');
is(start_form("GET", "/foobar",&CGI::URL_ENCODED),
qq{<form method="get" action="/foobar" enctype="application/x-www-form-urlencoded">},
'start_form() + NO_XHTML + URL_ENCODED');
is(start_form("GET", "/foobar",&CGI::MULTIPART),
qq{<form method="get" action="/foobar" enctype="multipart/form-data">},
'start_form() + NO_XHTML + MULTIPART');
is(start_multipart_form("GET", "/foobar"),
qq{<form method="get" action="/foobar" enctype="multipart/form-data">},
'start_multipart_form() + NO_XHTML');
is(start_multipart_form("GET", "/foobar","name=\"foobar\""),
qq{<form method="get" action="/foobar" enctype="multipart/form-data" name="foobar">},
'start_multipart_form() + NO_XHTML + additional args');
# restoring value
$CGI::XHTML = $saved_XHTML;
# return to normal
charset( 'ISO-8859-1' );
like header( -nph => 1 ),
qr!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,
"header()";
is start_html(), <<END, "start_html()";
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
<head>
<title>Untitled Document</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
</head>
<body>
END
is start_html(
-Title => 'The world of foo' ,
-Script => [ {-src=> 'foo.js', -charset=>'utf-8'} ],
), <<END, "start_html()";
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
<head>
<title>The world of foo</title>
<script charset="utf-8" src="foo.js" type="text/javascript"></script>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
</head>
<body>
END
for my $v (qw/ 2.0 3.2 4.0 4.01 /) {
local $CGI::XHTML = 1;
is
start_html( -dtd => "-//IETF//DTD HTML $v//FR", -lang => 'fr' ),
<<"END", 'start_html()';
<!DOCTYPE html
PUBLIC "-//IETF//DTD HTML $v//FR">
<html lang="fr"><head><title>Untitled Document</title>
</head>
<body>
END
}
( run in 1.050 second using v1.01-cache-2.11-cpan-49f99fa48dc )