From: Jarkko Hietaniemi Date: Thu, 16 Jan 2003 20:11:35 +0000 (+0000) Subject: Upgrade to CGI.pm 2.89. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=188ba75556c4451b4917a07bdebb8cb8e6f96a60;p=p5sagit%2Fp5-mst-13.2.git Upgrade to CGI.pm 2.89. p4raw-id: //depot/perl@18494 --- diff --git a/lib/CGI.pm b/lib/CGI.pm index a53fbb5..62c41ea 100644 --- a/lib/CGI.pm +++ b/lib/CGI.pm @@ -18,8 +18,8 @@ use Carp 'croak'; # The most recent version and complete docs are available at: # http://stein.cshl.org/WWW/software/CGI/ -$CGI::revision = '$Id: CGI.pm,v 1.62 2002/04/10 19:36:01 lstein Exp $'; -$CGI::VERSION='2.81'; +$CGI::revision = '$Id: CGI.pm,v 1.75 2002/10/16 17:48:37 lstein Exp $'; +$CGI::VERSION='2.89'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. @@ -32,6 +32,10 @@ use CGI::Util qw(rearrange make_attributes unescape escape expires); use constant XHTML_DTD => ['-//W3C//DTD XHTML 1.0 Transitional//EN', 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd']; +$TAINTED = substr("$0$^X",0,0); + +my @SAVED_SYMBOLS; + # >>>>> Here are some globals that you might want to adjust <<<<<< sub initialize_globals { # Set this to 1 to enable copious autoloader debugging messages @@ -127,12 +131,14 @@ if ($OS =~ /^MSWin/i) { $OS = 'OS2'; } elsif ($OS =~ /^epoc/i) { $OS = 'EPOC'; +} elsif ($OS =~ /^cygwin/i) { + $OS = 'CYGWIN'; } else { $OS = 'UNIX'; } # Some OS logic. Binary mode enabled on DOS, NT and VMS -$needs_binmode = $OS=~/^(WINDOWS|DOS|OS2|MSWin)/; +$needs_binmode = $OS=~/^(WINDOWS|DOS|OS2|MSWin|CYGWIN)/; # This is the default class for the CGI object to use when all else fails. $DefaultClass = 'CGI' unless defined $CGI::DefaultClass; @@ -153,13 +159,19 @@ $SL = { $IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/; # Turn on special checking for Doug MacEachern's modperl -if (exists $ENV{'GATEWAY_INTERFACE'} - && +if (exists $ENV{'GATEWAY_INTERFACE'} + && ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//)) -{ + { $| = 1; - require Apache; -} + require mod_perl; + if ($mod_perl::VERSION >= 1.99) { + require Apache::compat; + } else { + require Apache; + } + } + # Turn on special checking for ActiveState's PerlEx $PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; @@ -219,7 +231,7 @@ if ($needs_binmode) { sub import { my $self = shift; -# This causes modules to clash. + # This causes modules to clash. undef %EXPORT_OK; undef %EXPORT; @@ -381,6 +393,9 @@ sub init { # set charset to the safe ISO-8859-1 $self->charset('ISO-8859-1'); + # set autoescaping to on + $self->{'escape'} = 1; + METHOD: { # avoid unreasonably large postings @@ -714,6 +729,7 @@ sub _setup_symbols { } } _compile_all(keys %EXPORT) if $compile; + @SAVED_SYMBOLS = @_; } sub charset { @@ -766,11 +782,12 @@ END_OF_FUNC #### sub delete { my($self,@p) = self_or_default(@_); - my($name) = rearrange([NAME],@p); - CORE::delete $self->{$name}; - CORE::delete $self->{'.fieldnames'}->{$name}; - @{$self->{'.parameters'}}=grep($_ ne $name,$self->param()); - return wantarray ? () : undef; + my(@names) = rearrange([NAME],@p); + for my $name (@names) { + CORE::delete $self->{$name}; + CORE::delete $self->{'.fieldnames'}->{$name}; + @{$self->{'.parameters'}}=grep($_ ne $name,$self->param()); + } } END_OF_FUNC @@ -992,7 +1009,9 @@ EOF 'autoEscape' => <<'END_OF_FUNC', sub autoEscape { my($self,$escape) = self_or_default(@_); - $self->{'dontescape'}=!$escape; + my $d = $self->{'escape'}; + $self->{'escape'} = $escape; + $d; } END_OF_FUNC @@ -1363,7 +1382,7 @@ sub start_html { } else { push(@result,qq()); } - push(@result,$XHTML ? qq($title) + push(@result,$XHTML ? qq($title) : qq($title)); if (defined $author) { push(@result,$XHTML ? "" @@ -1504,14 +1523,14 @@ END_OF_FUNC # Parameters: # $action -> optional URL of script to run # Returns: -# A string containing a tag +# A string containing a tag 'isindex' => <<'END_OF_FUNC', sub isindex { my($self,@p) = self_or_default(@_); my($action,@other) = rearrange([ACTION],@p); - $action = qq/action="$action"/ if $action; + $action = qq/ action="$action"/ if $action; my($other) = @other ? " @other" : ''; - return $XHTML ? "" : ""; + return $XHTML ? "" : ""; } END_OF_FUNC @@ -1533,7 +1552,9 @@ sub startform { $enctype = $enctype || &URL_ENCODED; unless (defined $action) { $action = $self->url(-absolute=>1,-path=>1); - $action .= "?$ENV{QUERY_STRING}" if $ENV{QUERY_STRING}; + if (length($ENV{QUERY_STRING})>0) { + $action .= "?$ENV{QUERY_STRING}"; + } } $action = qq(action="$action"); my($other) = @other ? " @other" : ''; @@ -1629,7 +1650,7 @@ END_OF_FUNC # $size -> Optional width of field in characaters. # $maxlength -> Optional maximum number of characters. # Returns: -# A string containing a field +# A string containing a field # 'textfield' => <<'END_OF_FUNC', sub textfield { @@ -1645,7 +1666,7 @@ END_OF_FUNC # $size -> Optional width of field in characaters. # $maxlength -> Optional maximum number of characters. # Returns: -# A string containing a field +# A string containing a field # 'filefield' => <<'END_OF_FUNC', sub filefield { @@ -1664,7 +1685,7 @@ END_OF_FUNC # $size -> Optional width of field in characters. # $maxlength -> Optional maximum characters that can be entered. # Returns: -# A string containing a field +# A string containing a field # 'password_field' => <<'END_OF_FUNC', sub password_field { @@ -1711,7 +1732,7 @@ END_OF_FUNC # $onclick -> (optional) Text of the JavaScript to run when the button is # clicked. # Returns: -# A string containing a tag +# A string containing a tag #### 'button' => <<'END_OF_FUNC', sub button { @@ -1744,7 +1765,7 @@ END_OF_FUNC # $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: -# A string containing a tag +# A string containing a tag #### 'submit' => <<'END_OF_FUNC', sub submit { @@ -1772,7 +1793,7 @@ END_OF_FUNC # Parameters: # $name -> (optional) Name for the button. # Returns: -# A string containing a tag +# A string containing a tag #### 'reset' => <<'END_OF_FUNC', sub reset { @@ -1792,7 +1813,7 @@ END_OF_FUNC # Parameters: # $name -> (optional) Name for the button. # Returns: -# A string containing a tag +# A string containing a tag # # Note: this button has a special meaning to the initialization script, # and tells it to ERASE the current query string so that your defaults @@ -1834,7 +1855,7 @@ END_OF_FUNC # $label -> (optional) a user-readable label printed next to the box. # Otherwise the checkbox name is used. # Returns: -# A string containing a field +# A string containing a field #### 'checkbox' => <<'END_OF_FUNC', sub checkbox { @@ -1882,16 +1903,16 @@ END_OF_FUNC # in the form $label{'value'}="Long explanatory label". # Otherwise the provided values are used as the labels. # Returns: -# An ARRAY containing a series of fields +# An ARRAY containing a series of fields #### 'checkbox_group' => <<'END_OF_FUNC', sub checkbox_group { my($self,@p) = self_or_default(@_); - my($name,$values,$defaults,$linebreak,$labels,$rows,$columns, + my($name,$values,$defaults,$linebreak,$labels,$attributes,$rows,$columns, $rowheaders,$colheaders,$override,$nolabels,@other) = rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT], - LINEBREAK,LABELS,ROWS,[COLUMNS,COLS], + LINEBREAK,LABELS,ATTRIBUTES,ROWS,[COLUMNS,COLS], ROWHEADERS,COLHEADERS, [OVERRIDE,FORCE],NOLABELS],@p); @@ -1921,9 +1942,10 @@ sub checkbox_group { $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); $label = $self->escapeHTML($label); } + my $attribs = $self->_set_attributes($_, $attributes); $_ = $self->escapeHTML($_,1); - push(@elements,$XHTML ? qq(${label}${break}) - : qq/${label}${break}/); + push(@elements,$XHTML ? qq(${label}${break}) + : qq/${label}${break}/); } $self->register_parameter($name); return wantarray ? @elements : join(' ',@elements) @@ -1939,7 +1961,7 @@ sub escapeHTML { push @_,$_[0] if @_==1 && $_[0] eq 'CGI'; my ($self,$toencode,$newlinestoo) = CGI::self_or_default(@_); return undef unless defined($toencode); - return $toencode if ref($self) && $self->{'dontescape'}; + return $toencode if ref($self) && !$self->{'escape'}; $toencode =~ s{&}{&}gso; $toencode =~ s{<}{<}gso; $toencode =~ s{>}{>}gso; @@ -1948,8 +1970,8 @@ sub escapeHTML { uc $self->{'.charset'} eq 'WINDOWS-1252'; if ($latin) { # bug in some browsers $toencode =~ s{'}{'}gso; - $toencode =~ s{\x8b}{‹}gso; - $toencode =~ s{\x9b}{›}gso; + $toencode =~ s{\x8b}{‹}gso; + $toencode =~ s{\x9b}{›}gso; if (defined $newlinestoo && $newlinestoo) { $toencode =~ s{\012}{ }gso; $toencode =~ s{\015}{ }gso; @@ -2034,15 +2056,15 @@ END_OF_FUNC # in the form $label{'value'}="Long explanatory label". # Otherwise the provided values are used as the labels. # Returns: -# An ARRAY containing a series of fields +# An ARRAY containing a series of fields #### 'radio_group' => <<'END_OF_FUNC', sub radio_group { my($self,@p) = self_or_default(@_); - my($name,$values,$default,$linebreak,$labels, + my($name,$values,$default,$linebreak,$labels,$attributes, $rows,$columns,$rowheaders,$colheaders,$override,$nolabels,@other) = - rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS, + rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS,ATTRIBUTES, ROWS,[COLUMNS,COLS], ROWHEADERS,COLHEADERS, [OVERRIDE,FORCE],NOLABELS],@p); @@ -2076,9 +2098,10 @@ sub radio_group { $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); $label = $self->escapeHTML($label,1); } + my $attribs = $self->_set_attributes($_, $attributes); $_=$self->escapeHTML($_); - push(@elements,$XHTML ? qq(${label}${break}) - : qq/${label}${break}/); + push(@elements,$XHTML ? qq(${label}${break}) + : qq/${label}${break}/); } $self->register_parameter($name); return wantarray ? @elements : join(' ',@elements) @@ -2106,8 +2129,9 @@ END_OF_FUNC sub popup_menu { my($self,@p) = self_or_default(@_); - my($name,$values,$default,$labels,$override,@other) = - rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,[OVERRIDE,FORCE]],@p); + my($name,$values,$default,$labels,$attributes,$override,@other) = + rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS, + ATTRIBUTES,[OVERRIDE,FORCE]],@p); my($result,$selected); if (!$override && defined($self->param($name))) { @@ -2123,12 +2147,22 @@ sub popup_menu { $result = qq/"; @@ -2137,6 +2171,66 @@ sub popup_menu { END_OF_FUNC +#### Method: optgroup +# Create a optgroup. +# Parameters: +# $name -> Label for the group +# $values -> A pointer to a regular array containing the +# values for each option line in the group. +# $labels -> (optional) +# A pointer to an associative array of labels to print next to each item +# in the form $label{'value'}="Long explanatory label". +# Otherwise the provided values are used as the labels. +# $labeled -> (optional) +# A true value indicates the value should be used as the label attribute +# in the option elements. +# The label attribute specifies the option label presented to the user. +# This defaults to the content of the \n/; + foreach (@values) { + if (/_set_attributes($_, $attributes); + my($label) = $_; + $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); + $label=$self->escapeHTML($label); + my($value)=$self->escapeHTML($_,1); + $result .= $labeled ? $novals ? "$label\n" + : "$label\n" + : $novals ? "$label\n" + : "$label\n"; + } + } + $result .= ""; + return $result; +} +END_OF_FUNC + + #### Method: scrolling_list # Create a scrolling list. # Parameters: @@ -2160,9 +2254,9 @@ END_OF_FUNC 'scrolling_list' => <<'END_OF_FUNC', sub scrolling_list { my($self,@p) = self_or_default(@_); - my($name,$values,$defaults,$size,$multiple,$labels,$override,@other) + my($name,$values,$defaults,$size,$multiple,$labels,$attributes,$override,@other) = rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT], - SIZE,MULTIPLE,LABELS,[OVERRIDE,FORCE]],@p); + SIZE,MULTIPLE,LABELS,ATTRIBUTES,[OVERRIDE,FORCE]],@p); my($result,@values); @values = $self->_set_values_and_labels($values,\$labels,$name); @@ -2182,7 +2276,8 @@ sub scrolling_list { $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); $label=$self->escapeHTML($label); my($value)=$self->escapeHTML($_,1); - $result .= "$label\n"; + my $attribs = $self->_set_attributes($_, $attributes); + $result .= "$label\n"; } $result .= ""; $self->register_parameter($name); @@ -2198,7 +2293,7 @@ END_OF_FUNC # or # $default->[initial values of field] # Returns: -# A string containing a +# A string containing a #### 'hidden' => <<'END_OF_FUNC', sub hidden { @@ -2241,7 +2336,7 @@ END_OF_FUNC # $src -> URL of the image source # $align -> Alignment style (TOP, BOTTOM or MIDDLE) # Returns: -# A string containing a +# A string containing a #### 'image_button' => <<'END_OF_FUNC', sub image_button { @@ -2908,6 +3003,7 @@ sub read_multipart { } my($param)= $header{'Content-Disposition'}=~/ name="?([^\";]*)"?/; + $param .= $TAINTED; # Bug: Netscape doesn't escape quotation marks in file names!!! my($filename) = $header{'Content-Disposition'}=~/ filename="?([^\"]*)"?/; @@ -2919,6 +3015,7 @@ sub read_multipart { # to our parameter list. if ( !defined($filename) || $filename eq '' ) { my($value) = $buffer->readBody; + $value .= $TAINTED; push(@{$self->{$param}},$value); next; } @@ -3005,6 +3102,22 @@ sub _set_values_and_labels { } END_OF_FUNC +# internal routine, don't use +'_set_attributes' => <<'END_OF_FUNC', +sub _set_attributes { + my $self = shift; + my($element, $attributes) = @_; + return '' unless defined($attributes->{$element}); + $attribs = ' '; + foreach my $attrib (keys %{$attributes->{$element}}) { + $attrib =~ s/^-//; + $attribs .= "@{[lc($attrib)]}=\"$attributes->{$element}{$attrib}\" "; + } + $attribs =~ s/ $//; + return $attribs; +} +END_OF_FUNC + '_compile_all' => <<'END_OF_FUNC', sub _compile_all { foreach (@_) { @@ -3043,7 +3156,7 @@ sub asString { # get rid of package name (my $i = $$self) =~ s/^\*(\w+::fh\d{5})+//; $i =~ s/%(..)/ chr(hex($1)) /eg; - return $i; + return $i.$CGI::TAINTED; # BEGIN DEAD CODE # This was an extremely clever patch that allowed "use strict refs". # Unfortunately it relied on another bug that caused leaky file descriptors. @@ -3066,12 +3179,15 @@ END_OF_FUNC 'new' => <<'END_OF_FUNC', sub new { my($pack,$name,$file,$delete) = @_; + _setup_symbols(@SAVED_SYMBOLS) if @SAVED_SYMBOLS; require Fcntl unless defined &Fcntl::O_RDWR; (my $safename = $name) =~ s/([':%])/ sprintf '%%%02X', ord $1 /eg; my $fv = ++$FH . $safename; my $ref = \*{"Fh::$fv"}; - sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return; - unlink($file) if $delete; + $file =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$! || return; + my $safe = $1; + sysopen($ref,$safe,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return; + unlink($safe) if $delete; CORE::delete $Fh::{$fv}; return bless $ref,$pack; } @@ -3197,15 +3313,15 @@ sub readHeader { substr($self->{BUFFER},0,$end+4) = ''; my %return; - # See RFC 2045 Appendix A and RFC 822 sections 3.4.8 # (Folding Long Header Fields), 3.4.3 (Comments) # and 3.4.5 (Quoted-Strings). my $token = '[-\w!\#$%&\'*+.^_\`|{}~]'; $header=~s/$CRLF\s+/ /og; # merge continuation lines + while ($header=~/($token+):\s+([^$CRLF]*)/mgox) { - my ($field_name,$field_value) = ($1,$2); # avoid taintedness + my ($field_name,$field_value) = ($1,$2); $field_name =~ s/\b(\w)/uc($1)/eg; #canonicalize $return{$field_name}=$field_value; } @@ -3345,7 +3461,7 @@ unless ($TMPDIRECTORY) { "${vol}${SL}Temporary Items", "${SL}WWW_ROOT", "${SL}SYS\$SCRATCH", "C:${SL}system${SL}temp"); - unshift(@TEMP,$ENV{'TMPDIR'}) if exists $ENV{'TMPDIR'}; + unshift(@TEMP,$ENV{'TMPDIR'}) if defined $ENV{'TMPDIR'}; # this feature was supposed to provide per-user tmpfiles, but # it is problematic. @@ -3370,7 +3486,9 @@ $MAXTRIES = 5000; sub DESTROY { my($self) = @_; - unlink $$self; # get rid of the file + $$self =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$! || return; + my $safe = $1; # untaint operation + unlink $safe; # get rid of the file } ############################################################################### @@ -3387,9 +3505,10 @@ sub new { for (my $i = 0; $i < $MAXTRIES; $i++) { last if ! -f ($filename = sprintf("${TMPDIRECTORY}${SL}CGItemp%d",$sequence++)); } - # untaint the darn thing - return unless $filename =~ m!^([a-zA-Z0-9_ '":/.\$\\-]+)$!; - $filename = $1; + # check that it is a more-or-less valid filename + return unless $filename =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$!; + # this used to untaint, now it doesn't + # $filename = $1; return bless \$filename; } END_OF_FUNC @@ -3574,10 +3693,10 @@ this: ---- -------------- h1()

h1('some','contents');

some contents

- h1({-align=>left});

- h1({-align=>left},'contents');

contents

+ h1({-align=>left});

+ h1({-align=>left},'contents');

contents

-HTML tags are described in more detail later. +HTML tags are described in more detail later. Many newcomers to CGI.pm are puzzled by the difference between the calling conventions for the HTML shortcuts, which require curly braces @@ -3785,11 +3904,11 @@ Perl module B operator. =head2 DELETING A PARAMETER COMPLETELY: - $query->delete('foo'); + $query->delete('foo','bar','baz'); -This completely clears a parameter. It sometimes useful for -resetting parameters that you don't want passed down between -script invocations. +This completely clears a list of parameters. It sometimes useful for +resetting parameters that you don't want passed down between script +invocations. If you are using the function call interface, use "Delete()" instead to avoid conflicts with Perl's built-in delete operator. @@ -4090,7 +4209,14 @@ or even Note that using the -compile pragma in this way will always have the effect of importing the compiled functions into the current namespace. If you want to compile without importing use the -compile() method instead (see below). +compile() method instead: + + use CGI(); + CGI->compile(); + +This is particularly useful in a mod_perl environment, in which you +might want to precompile all CGI routines in a startup script, and +then import the functions individually in each mod_perl script. =item -nosticky @@ -4590,9 +4716,9 @@ 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; - print "See table 1"; - print "See table 2"; - print "See for yourself"; + print "See table 1"; + print "See table 2"; + print "See for yourself"; If you want more control over what's returned, using the B method instead. @@ -4863,9 +4989,9 @@ Provided that you have specified a character set of ISO-8859-1 (the default), the standard HTML escaping rules will be used. The "<" character becomes "<", ">" becomes ">", "&" becomes "&", and the quote character becomes """. In addition, the hexadecimal -0x8b and 0x9b characters, which many windows-based browsers interpret +0x8b and 0x9b characters, which some browsers incorrectly interpret as the left and right angle-bracket characters, are replaced by their -numeric HTML entities ("‹" and "›"). If you manually change +numeric character entities ("‹" and "›"). If you manually change the charset, either by calling the charset() method explicitly or by passing a -charset argument to header(), then B characters will be replaced by their numeric entities, since CGI.pm has no lookup @@ -4875,7 +5001,7 @@ The automatic escaping does not apply to other shortcuts, such as h1(). You should call escapeHTML() yourself on untrusted data in order to protect your pages against nasty tricks that people may enter into guestbooks, etc.. To change the character set, use charset(). -To turn autoescaping off completely, use autoescape(): +To turn autoescaping off completely, use autoEscape(0): =over 4 @@ -5278,16 +5404,18 @@ recognized. See textfield() for details. %labels = ('eenie'=>'your first choice', 'meenie'=>'your second choice', 'minie'=>'your third choice'); + %attributes = ('eenie'=>{'class'=>'class of first choice'}); print $query->popup_menu('menu_name', ['eenie','meenie','minie'], - 'meenie',\%labels); + 'meenie',\%labels,\%attributes); -or (named parameter style)- print $query->popup_menu(-name=>'menu_name', -values=>['eenie','meenie','minie'], -default=>'meenie', - -labels=>\%labels); + -labels=>\%labels, + -attributes=>\%attributes); popup_menu() creates a menu. @@ -5314,11 +5442,19 @@ The values of the previous choice will be maintained across queries. The optional fourth parameter (-labels) is provided for people who want to use different values for the user-visible label inside the -popup menu nd the value returned to your script. It's a pointer to an +popup menu and the value returned to your script. It's a pointer to an associative array relating menu values to user-visible labels. If you leave this parameter blank, the menu values will be displayed by default. (You can also leave a label undefined if you want to). +=item 5. + +The optional fifth 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. + =back When the form is processed, the selected value of the popup menu can @@ -5331,17 +5467,90 @@ B<-onChange>, B<-onFocus>, B<-onMouseOver>, B<-onMouseOut>, and B<-onBlur>. See the textfield() section for details on when these handlers are called. +=head2 CREATING AN OPTION GROUP + +Named parameter style + + print $query->popup_menu(-name=>'menu_name', + -values=>[qw/eenie meenie minie/, + $q->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', + ['eenie','meenie','minie', + $q->optgroup('optgroup_name', ['moe', 'catch'], + {'catch'=>{'class'=>'red'}})],'meenie', + {'eenie'=>'one','meenie'=>'two','minie'=>'three'}); + +optgroup creates an option group within a popup menu. + +=over 4 + +=item 1. + +The required first argument (B<-name>) is the label attribute of the +optgroup and is B inserted in the parameter list of the query. + +=item 2. + +The required second argument (B<-values>) is an array reference +containing the list of menu items in the menu. You can pass the +method an anonymous array, as shown in the example, or a reference +to a named array, such as \@foo. If you pass a HASH reference, +the keys will be used for the menu values, and the values will be +used for the menu labels (see -labels below). + +=item 3. + +The optional third parameter (B<-labels>) allows you to pass a reference +to an associative array containing user-visible labels for one or more +of the menu items. You can use this when you want the user to see one +menu string, but have the browser return your program a different one. +If you don't specify this, the value string will be used instead +("eenie", "meenie" and "minie" in this example). This is equivalent +to using a hash reference for the -values parameter. + +=item 4. + +An optional fourth parameter (B<-labeled>) can be set to a true value +and indicates that the values should be used as the label attribute +for each option element within the optgroup. + +=item 5. + +An optional fifth parameter (-novals) can be set to a true value and +indicates to suppress the val attribut in each option element within +the optgroup. + +See the discussion on optgroup at W3C +(http://www.w3.org/TR/REC-html40/interact/forms.html#edef-OPTGROUP) +for details. + +=item 6. + +An 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. + =head2 CREATING A SCROLLING LIST print $query->scrolling_list('list_name', ['eenie','meenie','minie','moe'], - ['eenie','moe'],5,'true'); + ['eenie','moe'],5,'true',{'moe'=>{'class'=>'red'}}); -or- print $query->scrolling_list('list_name', ['eenie','meenie','minie','moe'], ['eenie','moe'],5,'true', - \%labels); + \%labels,%attributes); -or- @@ -5350,7 +5559,8 @@ handlers are called. -default=>['eenie','moe'], -size=>5, -multiple=>'true', - -labels=>\%labels); + -labels=>\%labels, + -attributes=>\%attributes); scrolling_list() creates a scrolling list. @@ -5389,6 +5599,14 @@ The optional sixth argument is a pointer to an associative array containing long user-visible labels for the list items (-labels). If not provided, the values will be displayed. +=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. + When this form is processed, all selected list items will be returned as a list under the parameter name 'list_name'. The values of the selected items can be retrieved with: @@ -5408,11 +5626,13 @@ handlers are called. -values=>['eenie','meenie','minie','moe'], -default=>['eenie','moe'], -linebreak=>'true', - -labels=>\%labels); + -labels=>\%labels, + -attributes=>\%attributes); print $query->checkbox_group('group_name', ['eenie','meenie','minie','moe'], - ['eenie','moe'],'true',\%labels); + ['eenie','moe'],'true',\%labels, + {'moe'=>{'class'=>'red'}}); HTML3-COMPATIBLE BROWSERS ONLY: @@ -5465,6 +5685,14 @@ 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. + +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. @@ -5549,12 +5777,13 @@ parameter. See checkbox_group() for further details. -values=>['eenie','meenie','minie'], -default=>'meenie', -linebreak=>'true', - -labels=>\%labels); + -labels=>\%labels, + -attributes=>\%attributes); -or- print $query->radio_group('group_name',['eenie','meenie','minie'], - 'meenie','true',\%labels); + 'meenie','true',\%labels,\%attributes); HTML3-COMPATIBLE BROWSERS ONLY: @@ -5612,6 +5841,14 @@ and columns. You can provide just the -columns parameter if you wish; radio_group will calculate the correct number of rows for you. +=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. + To include row and column headings in the returned table, you can use the B<-rowheader> and B<-colheader> parameters. Both of these accept a pointer to an array of headings to use. @@ -6679,13 +6916,7 @@ for suggestions and bug fixes. =head1 BUGS -This module has grown large and monolithic. Furthermore it's doing many -things, such as handling URLs, parsing CGI input, writing HTML, etc., that -are also done in the LWP modules. It should be discarded in favor of -the CGI::* modules, but somehow I continue to work on it. - -Note that the code is truly contorted in order to avoid spurious -warnings when programs are run with the B<-w> switch. +Please report them. =head1 SEE ALSO diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm index bc3d1c3..ce9b407 100644 --- a/lib/CGI/Carp.pm +++ b/lib/CGI/Carp.pm @@ -169,6 +169,39 @@ content where HTML comments are not allowed: Note: In this respect warningsToBrowser() differs fundamentally from fatalsToBrowser(), which you should never call yourself! +=head1 OVERRIDING THE NAME OF THE PROGRAM + +CGI::Carp includes the name of the program that generated the error or +warning in the messages written to the log and the browser window. +Sometimes, Perl can get confused about what the actual name of the +executed program was. In these cases, you can override the program +name that CGI::Carp will use for all messages. + +The quick way to do that is to tell CGI::Carp the name of the program +in its use statement. You can do that by adding +"name=cgi_carp_log_name" to your "use" statement. For example: + + use CGI::Carp qw(name=cgi_carp_log_name); + +. If you want to change the program name partway through the program, +you can use the C function instead. It is not +exported by default, you must import it explicitly by saying + + use CGI::Carp qw(set_progname); + +Once you've done that, you can change the logged name of the program +at any time by calling + + set_progname(new_program_name); + +You can set the program back to the default by calling + + set_progname(undef); + +Note that this override doesn't happen until after the program has +compiled, so any compile-time errors will still show up with the +non-overridden program name + =head1 CHANGE LOG 1.05 carpout() added and minor corrections by Marc Hedlund @@ -203,6 +236,9 @@ fatalsToBrowser(), which you should never call yourself! (hack alert!) in order to accomodate various combinations of Perl and mod_perl. +1.24 Patch from Scott Gifford (sgifford@suspectclass.com): Add support + for overriding program name. + =head1 AUTHORS Copyright 1995-2002, Lincoln D. Stein. All rights reserved. @@ -216,6 +252,10 @@ Address bug reports and comments to: lstein@cshl.org Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form, CGI::Response + if (defined($CGI::Carp::PROGNAME)) + { + $file = $CGI::Carp::PROGNAME; + } =cut @@ -227,17 +267,26 @@ use File::Spec; @ISA = qw(Exporter); @EXPORT = qw(confess croak carp); -@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message cluck); +@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message set_progname cluck ^name=); $main::SIG{__WARN__}=\&CGI::Carp::warn; -$main::SIG{__DIE__}=\&CGI::Carp::die; -$CGI::Carp::VERSION = '1.23'; +*CORE::GLOBAL::die = \&CGI::Carp::die; +$CGI::Carp::VERSION = '1.24'; $CGI::Carp::CUSTOM_MSG = undef; # fancy import routine detects and handles 'errorWrap' specially. sub import { my $pkg = shift; my(%routines); + my(@name); + + if (@name=grep(/^name=/,@_)) + { + my($n) = (split(/=/,$name[0]))[1]; + set_progname($n); + @_=grep(!/^name=/,@_); + } + grep($routines{$_}++,@_,@EXPORT); $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'}; $WARN++ if $routines{'warningsToBrowser'}; @@ -262,14 +311,24 @@ sub stamp { my $time = scalar(localtime); my $frame = 0; my ($id,$pack,$file,$dev,$dirs); - do { - $id = $file; - ($pack,$file) = caller($frame++); - } until !$file; + if (defined($CGI::Carp::PROGNAME)) { + $id = $CGI::Carp::PROGNAME; + } else { + do { + $id = $file; + ($pack,$file) = caller($frame++); + } until !$file; + } ($dev,$dirs,$id) = File::Spec->splitpath($id); return "[$time] $id: "; } +sub set_progname { + $CGI::Carp::PROGNAME = shift; + return $CGI::Carp::PROGNAME; +} + + sub warn { my $message = shift; my($file,$line,$id) = id(1); @@ -294,7 +353,10 @@ sub _warn { } } -sub ineval { $^S || _longmess() =~ /eval [\{\']/m } +sub ineval { + (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m +} + # The mod_perl package Apache::Registry loads CGI programs by calling # eval. These evals don't count when looking at the stack backtrace. diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm index 1e1cfde..7c7434c 100644 --- a/lib/CGI/Cookie.pm +++ b/lib/CGI/Cookie.pm @@ -13,7 +13,7 @@ package CGI::Cookie; # wish, but if you redistribute a modified version, please attach a note # listing the modifications you have made. -$CGI::Cookie::VERSION='1.20'; +$CGI::Cookie::VERSION='1.21'; use CGI::Util qw(rearrange unescape escape); use overload '""' => \&as_string, @@ -117,6 +117,7 @@ sub new { $self->domain($domain) if defined $domain; $self->secure($secure) if defined $secure; $self->expires($expires) if defined $expires; +# $self->max_age($expires) if defined $expires; return $self; } @@ -124,11 +125,12 @@ sub as_string { my $self = shift; return "" unless $self->name; - my(@constant_values,$domain,$path,$expires,$secure); + my(@constant_values,$domain,$path,$expires,$max_age,$secure); - push(@constant_values,"domain=$domain") if $domain = $self->domain; - push(@constant_values,"path=$path") if $path = $self->path; + push(@constant_values,"domain=$domain") if $domain = $self->domain; + push(@constant_values,"path=$path") if $path = $self->path; push(@constant_values,"expires=$expires") if $expires = $self->expires; + push(@constant_values,"max-age=$max_age") if $max_age = $self->max_age; push(@constant_values,"secure") if $secure = $self->secure; my($key) = escape($self->name); @@ -190,6 +192,13 @@ sub expires { return $self->{'expires'}; } +sub max_age { + my $self = shift; + my $expires = shift; + $self->{'max-age'} = CGI::Util::expire_calc($expires)-time if defined $expires; + return $self->{'max-age'}; +} + sub path { my $self = shift; my $path = shift; diff --git a/lib/CGI/Pretty.pm b/lib/CGI/Pretty.pm index ef606e9..c498db5 100644 --- a/lib/CGI/Pretty.pm +++ b/lib/CGI/Pretty.pm @@ -10,7 +10,7 @@ package CGI::Pretty; use strict; use CGI (); -$CGI::Pretty::VERSION = '1.05_00'; +$CGI::Pretty::VERSION = '1.07_00'; $CGI::DefaultClass = __PACKAGE__; $CGI::Pretty::AutoloadClass = 'CGI'; @CGI::Pretty::ISA = qw( CGI ); @@ -19,18 +19,27 @@ initialize_globals(); sub _prettyPrint { my $input = shift; + return if !$$input; + return if !$CGI::Pretty::LINEBREAK || !$CGI::Pretty::INDENT; + +# print STDERR "'", $$input, "'\n"; foreach my $i ( @CGI::Pretty::AS_IS ) { - if ( $$input =~ /<\/$i>/si ) { - my ( $a, $b, $c, $d, $e ) = $$input =~ /(.*)<$i(\s?)(.*?)>(.*?)<\/$i>(.*)/si; - _prettyPrint( \$a ); - _prettyPrint( \$e ); + if ( $$input =~ m{}si ) { + my ( $a, $b, $c ) = $$input =~ m{(.*)(<$i[\s/>].*?)(.*)}si; + next if !$b; + $a ||= ""; + $c ||= ""; + + _prettyPrint( \$a ) if $a; + _prettyPrint( \$c ) if $c; - $$input = "$a<$i$b$c>$d$e"; + $b ||= ""; + $$input = "$a$b$c"; return; } } - $$input =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK; + $$input =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g; } sub comment { @@ -44,7 +53,6 @@ sub comment { sub _make_tag_func { my ($self,$tagname) = @_; - return $self->SUPER::_make_tag_func($tagname) if $tagname=~/^(start|end)_/; # As Lincoln as noted, the last else clause is VERY hairy, and it # took me a while to figure out what I was trying to do. @@ -57,60 +65,74 @@ sub _make_tag_func { # guru, so if anybody wants to contribute something that would # be quicker, easier to read, etc, I would be more than # willing to put it in - Brian - - return qq{ - sub $tagname { - # handle various cases in which we're called - # most of this bizarre stuff is to avoid -w errors - shift if \$_[0] && - (ref(\$_[0]) && - (substr(ref(\$_[0]),0,3) eq 'CGI' || - UNIVERSAL::isa(\$_[0],'CGI'))); - - my(\$attr) = ''; - if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') { - my(\@attr) = make_attributes(shift); - \$attr = " \@attr" if \@attr; - } - my(\$tag,\$untag) = ("\L<$tagname\E\$attr>","\L\E"); - return \$tag unless \@_; - - my \@result; - my \$NON_PRETTIFY_ENDTAGS = join "", map { "" } \@CGI::Pretty::AS_IS; - - if ( \$NON_PRETTIFY_ENDTAGS =~ /\$untag/ ) { + my $func = qq" + sub $tagname {"; + + $func .= q' + shift if $_[0] && + (ref($_[0]) && + (substr(ref($_[0]),0,3) eq "CGI" || + UNIVERSAL::isa($_[0],"CGI"))); + my($attr) = ""; + if (ref($_[0]) && ref($_[0]) eq "HASH") { + my(@attr) = make_attributes(shift()||undef,1); + $attr = " @attr" if @attr; + }'; + + if ($tagname=~/start_(\w+)/i) { + $func .= qq! + return "<\L$1\E\$attr>\$CGI::Pretty::LINEBREAK";} !; + } elsif ($tagname=~/end_(\w+)/i) { + $func .= qq! + return "<\L/$1\E>\$CGI::Pretty::LINEBREAK"; } !; + } else { + $func .= qq# + return ( \$CGI::XHTML ? "<\L$tagname\E\$attr />" : "<\L$tagname\E\$attr>" ) . + \$CGI::Pretty::LINEBREAK unless \@_; + my(\$tag,\$untag) = ("<\L$tagname\E\$attr>","\E"); + + my \%ASIS = map { lc("\$_") => 1 } \@CGI::Pretty::AS_IS; + my \@args; + if ( \$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT ) { + if(ref(\$_[0]) eq 'ARRAY') { + \@args = \@{\$_[0]} + } else { + foreach (\@_) { + \$args[0] .= \$_; + \$args[0] .= \$CGI::Pretty::LINEBREAK if \$args[0] !~ /\$CGI::Pretty::LINEBREAK\$/ && 0; + chomp \$args[0] if exists \$ASIS{ "\L$tagname\E" }; + + \$args[0] .= \$" if \$args[0] !~ /\$CGI::Pretty::LINEBREAK\$/ && 1; + } + chop \$args[0]; + } + } + else { + \@args = ref(\$_[0]) eq 'ARRAY' ? \@{\$_[0]} : "\@_"; + } + + my \@result; + if ( exists \$ASIS{ "\L$tagname\E" } ) { \@result = map { "\$tag\$_\$untag\$CGI::Pretty::LINEBREAK" } - (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_"; + \@args; } else { - my \@args; - if(ref(\$_[0]) eq 'ARRAY') { - \@args = \@{\$_[0]} - } else { - foreach (\@_) { - \$args[0] .= \$_; - \$args[0] .= " " unless \$args[0] =~ /\\s\$/; - } - chop \$args[0]; - } \@result = map { chomp; - if ( \$_ !~ /<\\// ) { - s/\$CGI::Pretty::LINEBREAK/\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT/g if \$CGI::Pretty::LINEBREAK; - } - else { - my \$tmp = \$_; - CGI::Pretty::_prettyPrint( \\\$tmp ); - \$_ = \$tmp; - } - "\$tag\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT\$_\$CGI::Pretty::LINEBREAK\$untag\$CGI::Pretty::LINEBREAK" + my \$tmp = \$_; + CGI::Pretty::_prettyPrint( \\\$tmp ); + \$tag . \$CGI::Pretty::LINEBREAK . + \$CGI::Pretty::INDENT . \$tmp . \$CGI::Pretty::LINEBREAK . + \$untag . \$CGI::Pretty::LINEBREAK } \@args; } - local \$" = ""; + local \$" = "" if \$CGI::Pretty::LINEBREAK || \$CGI::Pretty::INDENT; return "\@result"; - } - }; + }#; + } + + return $func; } sub start_html { @@ -136,10 +158,10 @@ sub initialize_globals { $CGI::Pretty::INDENT = "\t"; # This is the string used for seperation between tags - $CGI::Pretty::LINEBREAK = "\n"; + $CGI::Pretty::LINEBREAK = $/; # These tags are not prettify'd. - @CGI::Pretty::AS_IS = qw( a pre code script textarea ); + @CGI::Pretty::AS_IS = qw( a pre code script textarea td ); 1; } diff --git a/lib/CGI/t/carp.t b/lib/CGI/t/carp.t index b17f014..0de6a10 100644 --- a/lib/CGI/t/carp.t +++ b/lib/CGI/t/carp.t @@ -14,7 +14,7 @@ BEGIN { use strict; -use Test::More tests => 42; +use Test::More tests => 47; use IO::Handle; BEGIN { use_ok('CGI::Carp') }; @@ -159,6 +159,28 @@ is($CGI::Carp::CUSTOM_MSG, CGI::Carp::set_message(''), #----------------------------------------------------------------------------- +# Test set_progname +#----------------------------------------------------------------------------- + +import CGI::Carp qw(name=new_progname); +is($CGI::Carp::PROGNAME, + 'new_progname', + 'CGI::Carp::import set program name correctly'); + +is(CGI::Carp::set_progname('newer_progname'), + 'newer_progname', + 'CGI::Carp::set_progname returns new program name'); + +is($CGI::Carp::PROGNAME, + 'newer_progname', + 'CGI::Carp::set_progname program name set correctly'); + +# set the message back to the empty string so that the tests later +# work properly. +is (CGI::Carp::set_progname(undef),undef,"CGI::Carp::set_progname returns unset name correctly"); +is ($CGI::Carp::PROGNAME,undef,"CGI::Carp::set_progname program name unset correctly"); + +#----------------------------------------------------------------------------- # Test warnings_to_browser #----------------------------------------------------------------------------- diff --git a/lib/CGI/t/html.t b/lib/CGI/t/html.t index b101e4d..1af6754 100755 --- a/lib/CGI/t/html.t +++ b/lib/CGI/t/html.t @@ -67,14 +67,14 @@ test(13,start_html() ."\n" eq < -Untitled Document +Untitled Document END ; test(14,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR",-lang=>'fr') ."\n" eq < -Untitled Document +Untitled Document END ; @@ -83,7 +83,7 @@ test(15,start_html(-Title=>'The world of foo') ."\n" eq < -The world of foo +The world of foo END ; @@ -94,7 +94,7 @@ test(17,$h =~ m!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Date:.*${CRLF}Co test(18,start_h3 eq '

'); test(19,end_h3 eq '

'); test(20,start_table({-border=>undef}) eq ''); -test(21,h1(escapeHTML("this is \x8bright\x9b")) eq '

this is <not> ‹right›

'); +test(21,h1(escapeHTML("this is \x8bright\x9b")) eq '

this is <not> ‹right›

'); charset('utf-8'); if (ord("\t") == 9) { test(22,h1(escapeHTML("this is \x8bright\x9b")) eq '

this is <not> ‹right›

'); diff --git a/lib/CGI/t/pretty.t b/lib/CGI/t/pretty.t index 033bcbf..d3c19c0 100755 --- a/lib/CGI/t/pretty.t +++ b/lib/CGI/t/pretty.t @@ -1,23 +1,16 @@ -#!/usr/local/bin/perl -w - -BEGIN { - chdir 't' if -d 't'; - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } else { - unshift @INC, qw( ../blib/lib ../blib/arch lib ); - } -} +#!/bin/perl -w use strict; -use Test::More tests => 5; +use lib '.', 't/lib','../blib/lib','./blib/lib'; +use Test::More tests => 18; BEGIN { use_ok('CGI::Pretty') }; # This is silly use_ok should take arguments use CGI::Pretty (':all'); -is(h1(), '

',"single tag"); +is(h1(), '

+',"single tag"); is(ol(li('fred'),li('ethel')), < @@ -38,6 +31,26 @@ is(p('hi',pre('there'),'frog'), < tags");

HTML +is(h1({-align=>'CENTER'},'fred'), < + fred +

+HTML + +is(h1({-align=>undef},'fred'), < + fred + +HTML + +is(h1({-align=>'CENTER'},['fred','agnes']), < + fred + +

+ agnes +

+HTML is(p('hi',a({-href=>'frog'},'there'),'frog'), < @@ -46,3 +59,63 @@ is(p('hi',a({-href=>'frog'},'there'),'frog'), < HTML +is(p([ qw( hi there frog ) ] ), < + hi +

+

+ there +

+

+ frog +

+HTML + +is(p(p(p('hi'), 'there' ), 'frog'), < +

+

+ hi +

+ there +

+ frog +

+HTML + +is(table(TR(td(table(TR(td('hi', 'there', 'frog')))))), < + + + +
+ + + +
hi there frog
+HTML + +is(table(TR(td(table(TR(td( [ qw( hi there frog ) ])))))), < + + + + + + + +
hitherefrog
+ + +HTML + +$CGI::Pretty::INDENT = $CGI::Pretty::LINEBREAK = ""; + +is(h1(), '

',"single tag (pretty turned off)"); +is(h1('fred'), '

fred

',"open/close tag (pretty turned off)"); +is(h1('fred','agnes','maura'), '

fred agnes maura

',"open/close tag multiple (pretty turned off)"); +is(h1({-align=>'CENTER'},'fred'), '

fred

',"open/close tag with attribute (pretty turned off)"); +is(h1({-align=>undef},'fred'), '

fred

',"open/close tag with orphan attribute (pretty turned off)"); +is(h1({-align=>'CENTER'},['fred','agnes']), '

fred

agnes

', + "distributive tag with attribute (pretty turned off)"); +