CGI

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN


  [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)

Changes  view on Meta::CPAN

   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.

Changes  view on Meta::CPAN


  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.

Changes  view on Meta::CPAN


    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">

lib/CGI.pm  view on Meta::CPAN


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

lib/CGI.pm  view on Meta::CPAN

$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;

lib/CGI.pm  view on Meta::CPAN

		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;

lib/CGI.pm  view on Meta::CPAN


    # 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 {

lib/CGI.pm  view on Meta::CPAN

    }

    # 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 {

lib/CGI.pm  view on Meta::CPAN

# 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);

lib/CGI.pm  view on Meta::CPAN

# 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);

lib/CGI.pm  view on Meta::CPAN


    $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.

lib/CGI.pm  view on Meta::CPAN

    $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:

lib/CGI.pm  view on Meta::CPAN

    $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
####

lib/CGI.pm  view on Meta::CPAN

    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
#

lib/CGI.pm  view on Meta::CPAN

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 -->";
}

lib/CGI.pm  view on Meta::CPAN

    } 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(@_);

lib/CGI.pm  view on Meta::CPAN

    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{$_};

lib/CGI.pm  view on Meta::CPAN

    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)    = $_;

lib/CGI.pm  view on Meta::CPAN


    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);

lib/CGI.pm  view on Meta::CPAN

    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)    = $_;

lib/CGI.pm  view on Meta::CPAN

        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)

lib/CGI.pm  view on Meta::CPAN

####
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()');

t/form.t  view on Meta::CPAN

<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;

t/html.t  view on Meta::CPAN

 
# 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.396 second using v1.01-cache-2.11-cpan-49f99fa48dc )