r44839 - in /branches/upstream/libcgi-pm-perl/current: Changes META.yml lib/CGI.pm lib/CGI/Carp.pm lib/CGI/Cookie.pm lib/CGI/Util.pm t/autoescape.t t/carp.t t/popup_menu.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sat Sep 26 09:56:14 UTC 2009
Author: ansgar-guest
Date: Sat Sep 26 09:56:05 2009
New Revision: 44839
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=44839
Log:
[svn-upgrade] Integrating new upstream version, libcgi-pm-perl (3.48)
Modified:
branches/upstream/libcgi-pm-perl/current/Changes
branches/upstream/libcgi-pm-perl/current/META.yml
branches/upstream/libcgi-pm-perl/current/lib/CGI.pm
branches/upstream/libcgi-pm-perl/current/lib/CGI/Carp.pm
branches/upstream/libcgi-pm-perl/current/lib/CGI/Cookie.pm
branches/upstream/libcgi-pm-perl/current/lib/CGI/Util.pm
branches/upstream/libcgi-pm-perl/current/t/autoescape.t
branches/upstream/libcgi-pm-perl/current/t/carp.t
branches/upstream/libcgi-pm-perl/current/t/popup_menu.t
Modified: branches/upstream/libcgi-pm-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/Changes?rev=44839&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/Changes (original)
+++ branches/upstream/libcgi-pm-perl/current/Changes Sat Sep 26 09:56:05 2009
@@ -1,5 +1,26 @@
+Version 3.48
+
+ [BUG FIXES]
+ 1. <optgroup> default values are now properly escaped.
+ Thanks to #raleigh.pm and Mark Stosberg. (RT#49606)
+ 2. The change to exception handling in CGI::Carp introduced in 3.47 has been
+ reverted for now. It caused regressions reported in RT#49630.
+ Thanks to mkanat for the report.
+
+ [DOCUMENTATION]
+ 1. Documentation for upload() has been overhauled, thanks to Mark Stosberg.
+ 2. Documentation for tmpFileName has been added. Thanks to Mark Stosberg and Nathaniel K. Smith.
+ 3. URLS were updated, thanks to Leon Brocard and Yanick Champoux. (RT#49770)
+
+ [INTERNALS]
+ 1. More tests were added for autoescape, thanks to Bob Kuo. (RT#25485)
+
Version 3.47
- Re-release of 3.46, which did not contain a proper MANIFEST
+ Released September 9th, 2009.
+ No code changes.
+
+ [INTERNALS]
+ Re-release of 3.46, which did not contain a proper MANIFEST
Version 3.46
[BUG FIXES]
Modified: branches/upstream/libcgi-pm-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/META.yml?rev=44839&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/META.yml (original)
+++ branches/upstream/libcgi-pm-perl/current/META.yml Sat Sep 26 09:56:05 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: CGI.pm
-version: 3.47
+version: 3.48
abstract: ~
license: ~
author: ~
Modified: branches/upstream/libcgi-pm-perl/current/lib/CGI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/lib/CGI.pm?rev=44839&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/lib/CGI.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/lib/CGI.pm Sat Sep 26 09:56:05 2009
@@ -19,7 +19,7 @@
# http://stein.cshl.org/WWW/software/CGI/
$CGI::revision = '$Id: CGI.pm,v 1.266 2009/07/30 16:32:34 lstein Exp $';
-$CGI::VERSION='3.47';
+$CGI::VERSION='3.48';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -2572,7 +2572,7 @@
for my $v (split(/\n/)) {
my $selectit = $XHTML ? 'selected="selected"' : 'selected';
for my $selected (keys %selected) {
- $v =~ s/(value="$selected")/$selectit $1/;
+ $v =~ s/(value="\Q$selected\E")/$selectit $1/;
}
$result .= "$v\n";
}
@@ -6182,10 +6182,37 @@
=back
-When the form is processed, you can retrieve the entered filename
-by calling param():
-
- $filename = param('uploaded_file');
+JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
+B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
+recognized. See textfield() for details.
+
+=head2 PROCESSING A FILE UPLOAD FIELD
+
+=head3 Basics
+
+When the form is processed, you can retrieve an L<IO::Handle> compatibile
+handle for a file upload field like this:
+
+ $lightweight_fh = $q->upload('field_name');
+
+ # undef may be returned if it's not a valid file handle
+ if (defined $lightweight_fh) {
+ # Upgrade the handle to one compatible with IO::Handle:
+ my $io_handle = $lightweight_fh->handle;
+
+ open (OUTFILE,">>/usr/local/web/users/feedback");
+ while ($bytesread = $io_handle->read($buffer,1024)) {
+ print OUTFILE $buffer;
+ }
+ }
+
+In a list context, upload() will return an array of filehandles.
+This makes it possible to process forms that use the same name for
+multiple upload fields.
+
+If you want the entered file name for the file, you can just call param():
+
+ $filename = $q->param('field_name');
Different browsers will return slightly different things for the
name. Some browsers return the filename only. Others return the full
@@ -6194,69 +6221,40 @@
I<user's> machine, and is unrelated to the name of the temporary file
that CGI.pm creates during upload spooling (see below).
-The filename returned is also a file handle. You can read the contents
-of the file using standard Perl file reading calls:
-
- # Read a text file and print it out
- while (<$filename>) {
- print;
- }
-
- # Copy a binary file to somewhere safe
- open (OUTFILE,">>/usr/local/web/users/feedback");
- while ($bytesread=read($filename,$buffer,1024)) {
- print OUTFILE $buffer;
- }
-
-However, there are problems with the dual nature of the upload fields.
-If you C<use strict>, then Perl will complain when you try to use a
-string as a filehandle. You can get around this by placing the file
-reading code in a block containing the C<no strict> pragma. More
-seriously, it is possible for the remote user to type garbage into the
-upload field, in which case what you get from param() is not a
-filehandle at all, but a string.
-
-To be safe, use the I<upload()> function (new in version 2.47). When
-called with the name of an upload field, I<upload()> returns a
-filehandle-like object, or undef if the parameter is not a valid
-filehandle.
-
- $fh = upload('uploaded_file');
- while (<$fh>) {
- print;
- }
-
-In a list context, upload() will return an array of filehandles.
-This makes it possible to create forms that use the same name for
-multiple upload fields.
-
-This is the recommended idiom.
-
-The lightweight filehandle returned by CGI.pm is not compatible with
-IO::Handle; for example, it does not have read() or getline()
-functions, but instead must be manipulated using read($fh) or
-<$fh>. To get a compatible IO::Handle object, call the handle's
-handle() method:
-
- my $real_io_handle = upload('uploaded_file')->handle;
-
When a file is uploaded the browser usually sends along some
information along with it in the format of headers. The information
-usually includes the MIME content type. Future browsers may send
-other information as well (such as modification date and size). To
+usually includes the MIME content type. To
retrieve this information, call uploadInfo(). It returns a reference to
a hash containing all the document headers.
- $filename = param('uploaded_file');
- $type = uploadInfo($filename)->{'Content-Type'};
+ $filename = $q->param('uploaded_file');
+ $type = $q->uploadInfo($filename)->{'Content-Type'};
unless ($type eq 'text/html') {
- die "HTML FILES ONLY!";
+ die "HTML FILES ONLY!";
}
If you are using a machine that recognizes "text" and "binary" data
modes, be sure to understand when and how to use them (see the Camel book).
Otherwise you may find that binary files are corrupted during file
uploads.
+
+=head3 Accessing the temp files directly
+
+When processing an uploaded file, CGI.pm creates a temporary file on your hard
+disk and passes you a file handle to that file. After you are finished with the
+file handle, CGI.pm unlinks (deletes) the temporary file. If you need to you
+can access the temporary file directly. You can access the temp file for a file
+upload by passing the file name to the tmpFileName() method:
+
+ $filename = $query->param('uploaded_file');
+ $tmpfilename = $query->tmpFileName($filename);
+
+The temporary file will be deleted automatically when your program exits unless
+you manually rename it. On some operating systems (such as Windows NT), you
+will need to close the temporary file's filehandle before your program exits.
+Otherwise the attempt to delete the temporary file will fail.
+
+=head3 Handling interrupted file uploads
There are occasionally problems involving parsing the uploaded file.
This usually happens when the user presses "Stop" before the upload is
@@ -6266,35 +6264,39 @@
you can incorporate it into a status code to be sent to the browser.
Example:
- $file = upload('uploaded_file');
- if (!$file && cgi_error) {
- print header(-status=>cgi_error);
+ $file = $q->upload('uploaded_file');
+ if (!$file && $q->cgi_error) {
+ print $q->header(-status=>$q->cgi_error);
exit 0;
}
You are free to create a custom HTML page to complain about the error,
if you wish.
-You can set up a callback that will be called whenever a file upload
-is being read during the form processing. This is much like the
-UPLOAD_HOOK facility available in Apache::Request, with the exception
-that the first argument to the callback is an Apache::Upload object,
-here it's the remote filename.
+=head3 Progress bars for file uploads and avoiding temp files
+
+CGI.pm gives you low-level access to file upload management through
+a file upload hook. You can use this feature to completely turn off
+the temp file storage of file uploads, or potentially write your own
+file upload progess meter.
+
+This is much like the UPLOAD_HOOK facility available in L<Apache::Request>, with
+the exception that the first argument to the callback is an L<Apache::Upload>
+object, here it's the remote filename.
$q = CGI->new(\&hook [,$data [,$use_tempfile]]);
- sub hook
- {
+ sub hook {
my ($filename, $buffer, $bytes_read, $data) = @_;
- print "Read $bytes_read bytes of $filename\n";
+ print "Read $bytes_read bytes of $filename\n";
}
-The $data field is optional; it lets you pass configuration
+The C<< $data >> field is optional; it lets you pass configuration
information (e.g. a database handle) to your hook callback.
-The $use_tempfile field is a flag that lets you turn on and off
+The C<< $use_tempfile >> field is a flag that lets you turn on and off
CGI.pm's use of a temporary disk-based file during file upload. If you
-set this to a FALSE value (default true) then param('uploaded_file')
+set this to a FALSE value (default true) then $q->param('uploaded_file')
will no longer work, and the only way to get at the uploaded data is
via the hook you provide.
@@ -6305,6 +6307,8 @@
This method is not exported by default. You will have to import it
explicitly if you wish to use it without the CGI:: prefix.
+
+=head3 Troubleshooting file uploads on Windows
If you are using CGI.pm on a Windows platform and find that binary
files get slightly larger when uploaded but that text files remain the
@@ -6312,9 +6316,26 @@
filehandle. Be sure to call binmode() on any handle that you create
to write the uploaded file to disk.
-JAVASCRIPTING: The B<-onChange>, B<-onFocus>, B<-onBlur>,
-B<-onMouseOver>, B<-onMouseOut> and B<-onSelect> parameters are
-recognized. See textfield() for details.
+=head3 Older ways to process file uploads
+
+( This section is here for completeness. if you are building a new application with CGI.pm, you can skip it. )
+
+The original way to process file uploads with CGI.pm was to use param(). The
+value it returns has a dual nature as both a file name and a lightweight
+filehandle. This dual nature is problematic if you following the recommended
+practice of having C<use strict> in your code. Perl will complain when you try
+to use a string as a filehandle. More seriously, it is possible for the remote
+user to type garbage into the upload field, in which case what you get from
+param() is not a filehandle at all, but a string.
+
+To solve this problem the upload() method was added, which always returns a
+lightweight filehandle. This generally works well, but will have trouble
+interoperating with some other modules because the file handle is not derived
+from L<IO::Handle>. So that brings us to current recommedation given above,
+which is to call the handle() method on the file handle returned by upload().
+That upgrades the handle to an IO::Handle. It's a big win for compatibility for
+a small penalty of loading IO::Handle the first time you call it.
+
=head2 CREATING A POPUP MENU
@@ -7326,7 +7347,7 @@
Note that you must import the ":html3" definitions to have the
B<span()> method available. Here's a quick and dirty example of using
CSS's. See the CSS specification at
-http://www.w3.org/pub/WWW/TR/Wd-css-1.html for more information.
+http://www.w3.org/Style/CSS/ for more information.
use CGI qw/:standard :html3/;
@@ -7658,7 +7679,7 @@
functionality of NPH scripts, including the ability to redirect while
setting a cookie, B<do not work at all> on IIS without a special patch
from Microsoft. See
-http://support.microsoft.com/support/kb/articles/Q280/3/41.ASP:
+http://web.archive.org/web/20010812012030/http://support.microsoft.com/support/kb/articles/Q280/3/41.ASP
Non-Parsed Headers Stripped From CGI Applications That Have nph-
Prefix in Name.
@@ -8028,7 +8049,11 @@
=head1 SEE ALSO
-L<CGI::Carp>, L<CGI::Fast>, L<CGI::Pretty>
+L<CGI::Carp> - provides a L<Carp> implementation tailored to the CGI environment.
+
+L<CGI::Fast> - supports running CGI applications under FastCGI
+
+L<CGI::Pretty> - pretty prints HTML generated by CGI.pm (with a performance penalty)
=cut
Modified: branches/upstream/libcgi-pm-perl/current/lib/CGI/Carp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/lib/CGI/Carp.pm?rev=44839&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/lib/CGI/Carp.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/lib/CGI/Carp.pm Sat Sep 26 09:56:05 2009
@@ -423,32 +423,35 @@
sub die {
my ($arg, at rest) = @_;
- &$DIE_HANDLER($arg, at rest) if $DIE_HANDLER;
-
- # if $arg is a reference, give it a chance to
- # be stringified
- $arg = "$arg" if ref $arg;
-
- $arg = join '' => $arg, @rest ;
-
- my($file,$line,$id) = id(1);
+ if ($DIE_HANDLER) {
+ &$DIE_HANDLER($arg, at rest);
+ }
if ( ineval() ) {
-
- $arg ||= 'Died';
-
- $arg .= " at $file line $line.\n" unless $arg=~/\n$/;
-
- realdie($arg);
+ if (!ref($arg)) {
+ $arg = join("",($arg, at rest)) || "Died";
+ my($file,$line,$id) = id(1);
+ $arg .= " at $file line $line.\n" unless $arg=~/\n$/;
+ realdie($arg);
+ }
+ else {
+ realdie($arg, at rest);
+ }
}
- $arg .= " at $file line $line." unless $arg=~/\n$/;
- &fatalsToBrowser($arg) if $WRAP;
-
- $arg=~s/^/ stamp() /gme if $arg =~ /\n$/ or not exists $ENV{MOD_PERL};
-
- $arg .= "\n" unless $arg =~ /\n$/;
-
+ if (!ref($arg)) {
+ $arg = join("", ($arg, at rest));
+ my($file,$line,$id) = id(1);
+ $arg .= " at $file line $line." unless $arg=~/\n$/;
+ &fatalsToBrowser($arg) if $WRAP;
+ if (($arg =~ /\n$/) || !exists($ENV{MOD_PERL})) {
+ my $stamp = stamp;
+ $arg=~s/^/$stamp/gm;
+ }
+ if ($arg !~ /\n$/) {
+ $arg .= "\n";
+ }
+ }
realdie $arg;
}
Modified: branches/upstream/libcgi-pm-perl/current/lib/CGI/Cookie.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/lib/CGI/Cookie.pm?rev=44839&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/lib/CGI/Cookie.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/lib/CGI/Cookie.pm Sat Sep 26 09:56:05 2009
@@ -363,7 +363,7 @@
See this URL for more information:
-L<http://msdn.microsoft.com/workshop/author/dhtml/httponly_cookies.asp>
+L<http://msdn.microsoft.com/en-us/library/ms533046%28VS.85%29.aspx>
=back
Modified: branches/upstream/libcgi-pm-perl/current/lib/CGI/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/lib/CGI/Util.pm?rev=44839&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/lib/CGI/Util.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/lib/CGI/Util.pm Sat Sep 26 09:56:05 2009
@@ -7,7 +7,7 @@
@EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape
expires ebcdic2ascii ascii2ebcdic);
-$VERSION = '3.46';
+$VERSION = '3.48';
$EBCDIC = "\t" ne "\011";
# (ord('^') == 95) for codepage 1047 as on os390, vmesa
@@ -248,7 +248,7 @@
shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
my $toencode = shift;
return undef unless defined($toencode);
- utf8::encode($toencode) if ($] > 5.007 && utf8::is_utf8($toencode));
+ utf8::encode($toencode) if ($] > 5.008001 && utf8::is_utf8($toencode));
if ($EBCDIC) {
$toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
} else {
Modified: branches/upstream/libcgi-pm-perl/current/t/autoescape.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/t/autoescape.t?rev=44839&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/t/autoescape.t (original)
+++ branches/upstream/libcgi-pm-perl/current/t/autoescape.t Sat Sep 26 09:56:05 2009
@@ -3,9 +3,9 @@
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 18;
-use CGI qw/ autoEscape escapeHTML button/;
+use CGI qw/ autoEscape escapeHTML button textfield password_field textarea popup_menu scrolling_list checkbox_group optgroup checkbox radio_group submit image_button button /;
is (button(-name => 'test<'), '<input type="button" name="test<" value="test<" />', "autoEscape defaults to On");
@@ -25,3 +25,175 @@
$after = escapeHTML("test<");
is ($before, $after, "passing 0 to autoEscape doesn't break escapeHTML");
+
+# RT #25485: Needs Tests: autoEscape() bypassed for Javascript handlers, except in button()
+autoEscape(undef);
+
+is(textfield(
+{
+default => 'text field',
+onclick => 'alert("===> text field")',
+},
+),
+qq{<input type="text" name="" value="text field" onclick="alert("===> text field")" />},
+'autoescape javascript turns off for textfield'
+);
+
+is(password_field(
+{
+default => 'password field',
+onclick => 'alert("===> password
+field")',
+},
+),
+qq{<input type="password" name="" value="password field" onclick="alert("===> password
+field")" />},
+'autoescape javascript turns off for password field'
+);
+
+is(textarea(
+{
+name => 'foo',
+default => 'text area',
+rows => 10,
+columns => 50,
+onclick => 'alert("===> text area")',
+},
+),
+qq{<textarea name="foo" rows="10" cols="50" onclick="alert("===> text area")">text area</textarea>},
+'autoescape javascript turns off for textarea'
+);
+
+is(popup_menu(
+{
+name => 'menu_name',
+values => ['eenie','meenie','minie'],
+default => 'meenie',
+onclick => 'alert("===> popup menu")',
+}
+),
+qq{<select name="menu_name" onclick="alert("===> popup menu")">
+<option value="eenie">eenie</option>
+<option selected="selected" value="meenie">meenie</option>
+<option value="minie">minie</option>
+</select>},
+'autoescape javascript turns off for popup_menu'
+);
+
+is(popup_menu(
+-name=>'menu_name',
+onclick => 'alert("===> menu group")',
+-values=>[
+qw/eenie meenie minie/,
+optgroup(
+-name=>'optgroup_name',
+onclick =>
+'alert("===> menu group option")',
+-values => ['moe','catch'],
+-attributes=>{'catch'=>{'class'=>'red'}}
+)
+],
+-labels=>{
+'eenie'=>'one',
+'meenie'=>'two',
+'minie'=>'three'
+},
+-default=>'meenie'
+),
+qq{<select name="menu_name" onclick="alert("===> menu group")">
+<option value="eenie">one</option>
+<option selected="selected" value="meenie">two</option>
+<option value="minie">three</option>
+<optgroup label="optgroup_name" onclick="alert("===> menu group option")">
+<option value="moe">moe</option>
+<option class="red" value="catch">catch</option>
+</optgroup>
+</select>},
+'autoescape javascript turns off for popup_menu #2'
+);
+
+is(scrolling_list(
+-name=>'list_name',
+onclick => 'alert("===> scrolling
+list")',
+-values=>['eenie','meenie','minie','moe'],
+-default=>['eenie','moe'],
+-size=>5,
+-multiple=>'true',
+),
+qq{<select name="list_name" size="5" multiple="multiple" onclick="alert("===> scrolling
+list")">
+<option selected="selected" value="eenie">eenie</option>
+<option value="meenie">meenie</option>
+<option value="minie">minie</option>
+<option selected="selected" value="moe">moe</option>
+</select>},
+'autoescape javascript turns off for scrolling list'
+);
+
+is(checkbox_group(
+-name=>'group_name',
+onclick => 'alert("===> checkbox group")',
+-values=>['eenie','meenie','minie','moe'],
+-default=>['eenie','moe'],
+-linebreak=>'true',
+),
+qq{<label><input type="checkbox" name="group_name" value="eenie" checked="checked" onclick="alert("===> checkbox group")" />eenie</label><br /> <label><input type="checkbox" name="group_name" value="meenie" onclick="alert("===> checkbox group")" />meenie</label><br /> <label><input type="checkbox" name="group_name" value="minie" onclick="alert("===> checkbox group")" />minie</label><br /> <label><input type="checkbox" name="group_name" value="moe" checked="checked" onclick="alert("===> checkbox group")" />moe</label><br />},
+'autoescape javascript turns off for checkbox group'
+);
+
+is(checkbox(
+-name=>'checkbox_name',
+onclick => 'alert("===> single checkbox")',
+onchange => 'alert("===> single checkbox
+changed")',
+-checked=>1,
+-value=>'ON',
+-label=>'CLICK ME'
+),
+qq{<label><input type="checkbox" name="checkbox_name" value="ON" checked="checked" onchange="alert("===> single checkbox
+changed")" onclick="alert("===> single checkbox")" />CLICK ME</label>},
+'autoescape javascript turns off for checkbox'
+);
+
+is(radio_group(
+{
+name=>'group_name',
+onclick => 'alert("===> radio group")',
+values=>['eenie','meenie','minie','moe'],
+rows=>2,
+columns=>2,
+}
+),
+qq{<table><tr><td><label><input type="radio" name="group_name" value="eenie" checked="checked" onclick="alert("===> radio group")" />eenie</label></td><td><label><input type="radio" name="group_name" value="minie" onclick="alert("===> radio group")" />minie</label></td></tr><tr><td><label><input type="radio" name="group_name" value="meenie" onclick="alert("===> radio group")" />meenie</label></td><td><label><input type="radio" name="group_name" value="moe" onclick="alert("===> radio group")" />moe</label></td></tr></table>},
+'autoescape javascript turns off for radio group'
+);
+
+is(submit(
+-name=>'button_name',
+onclick => 'alert("===> submit button")',
+-value=>'value'
+),
+qq{<input type="submit" name="button_name" value="value" onclick="alert("===> submit button")" />},
+'autoescape javascript turns off for submit'
+);
+
+is(image_button(
+-name=>'button_name',
+onclick => 'alert("===> image button")',
+-src=>'/source/URL',
+-align=>'MIDDLE'
+),
+qq{<input type="image" name="button_name" src="/source/URL" align="middle" onclick="alert("===> image button")" />},
+'autoescape javascript turns off for image_button'
+);
+
+is(button(
+{
+onclick => 'alert("===> Button")',
+title => 'Button',
+},
+),
+qq{<input type="button" onclick="alert("===> Button")" title="Button" />},
+'autoescape javascript turns off for button'
+);
Modified: branches/upstream/libcgi-pm-perl/current/t/carp.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/t/carp.t?rev=44839&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/t/carp.t (original)
+++ branches/upstream/libcgi-pm-perl/current/t/carp.t Sat Sep 26 09:56:05 2009
@@ -3,7 +3,7 @@
use strict;
-use Test::More tests => 47;
+use Test::More tests => 41;
use IO::Handle;
BEGIN { use_ok('CGI::Carp') };
@@ -273,58 +273,3 @@
ok( defined buffer('::STDOUT'), 'STDIN returns proper filehandle');
ok( defined buffer(*main::STDOUT), 'STDIN returns proper filehandle');
ok(!defined buffer("WIBBLE"), '"WIBBLE" doesn\'t returns proper filehandle');
-
-# Calling die with code refs
-{
- local $CGI::Carp::WRAP = 1;
-
- tie *STDOUT, 'StoreStuff';
-
- my %result; # store results because stdout is kidnapped
-
- CGI::Carp::die( 'regular string' );
- $result{string} .= $_ while <STDOUT>;
-
- CGI::Carp::die( [ 1..10 ] );
- $result{array_ref} .= $_ while <STDOUT>;
-
- CGI::Carp::die( { a => 1 } );
- $result{hash_ref} .= $_ while <STDOUT>;
-
- CGI::Carp::die( sub { 'Farewell' } );
- $result{code_ref} .= $_ while <STDOUT>;
-
- CGI::Carp::die( My::Plain::Object->new );
- $result{plain_object} .= $_ while <STDOUT>;
-
- CGI::Carp::die( My::Stringified::Object->new );
- $result{string_object} .= $_ while <STDOUT>;
-
- untie *STDOUT;
-
- like $result{string} => qr/regular string/, 'regular string';
- like $result{array_ref} => qr/ARRAY\(\w+?\)/, 'array ref';
- like $result{hash_ref} => qr/HASH\(\w+?\)/, 'hash ref';
- like $result{code_ref} => qr/CODE\(\w+?\)/, 'code ref';
- like $result{plain_object} => qr/My::Plain::Object/, 'plain object';
- like $result{string_object} => qr/stringified/, 'stringified object';
-
-}
-
-{
- package My::Plain::Object;
-
- sub new {
- return bless {}, shift;
- }
-}
-
-{
- package My::Stringified::Object;
-
- use overload '""' => sub { 'stringified' };
-
- sub new {
- return bless {}, shift;
- }
-}
Modified: branches/upstream/libcgi-pm-perl/current/t/popup_menu.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/t/popup_menu.t?rev=44839&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/t/popup_menu.t (original)
+++ branches/upstream/libcgi-pm-perl/current/t/popup_menu.t Sat Sep 26 09:56:05 2009
@@ -10,5 +10,13 @@
<option selected="selected" value="0">0</option>
<option value="1">1</option>
</select>'
-, 'popup_menu(): basic test, including 0 as a default value');
+, 'popup_menu(): basic test, including 0 as a default value');
+is(
+ CGI::popup_menu(-values=>[CGI::optgroup(-values=>["b+"])],-default=>"b+"),
+ '<select name="" >
+<optgroup label="">
+<option selected="selected" value="b+">b+</option>
+</optgroup>
+</select>'
+ , "<optgroup> selections work when the default values contain regex characters (RT#49606)");
More information about the Pkg-perl-cvs-commits
mailing list