1N/A#!perl -w
1N/A
1N/A# Form-related tests for CGI.pm
1N/A# If you are adding or updated tests, please put tests for each methods in
1N/A# their own file, rather than growing this file any larger.
1N/A
1N/Ause Test::More 'no_plan';
1N/Ause CGI (':standard','-no_debug','-tabindex');
1N/A
1N/Amy $CRLF = "\015\012";
1N/Aif ($^O eq 'VMS') {
1N/A $CRLF = "\n"; # via web server carriage is inserted automatically
1N/A}
1N/Aif (ord("\t") != 9) { # EBCDIC?
1N/A $CRLF = "\r\n";
1N/A}
1N/A
1N/A
1N/A# Set up a CGI environment
1N/A$ENV{REQUEST_METHOD} = 'GET';
1N/A$ENV{QUERY_STRING} = 'game=chess&game=checkers&weather=dull';
1N/A$ENV{PATH_INFO} = '/somewhere/else';
1N/A$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
1N/A$ENV{SCRIPT_NAME} ='/cgi-bin/foo.cgi';
1N/A$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
1N/A$ENV{SERVER_PORT} = 8080;
1N/A$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
1N/A
1N/Ais(start_form(-action=>'foobar',-method=>'get'),
1N/A qq(<form method="get" action="foobar" enctype="multipart/form-data">\n),
1N/A "start_form()");
1N/A
1N/Ais(submit(),
1N/A qq(<input type="submit" tabindex="1" name=".submit" />),
1N/A "submit()");
1N/A
1N/Ais(submit(-name => 'foo',
1N/A -value => 'bar'),
1N/A qq(<input type="submit" tabindex="2" name="foo" value="bar" />),
1N/A "submit(-name,-value)");
1N/A
1N/Ais(submit({-name => 'foo',
1N/A -value => 'bar'}),
1N/A qq(<input type="submit" tabindex="3" name="foo" value="bar" />),
1N/A "submit({-name,-value})");
1N/A
1N/Ais(textfield(-name => 'weather'),
1N/A qq(<input type="text" name="weather" tabindex="4" value="dull" />),
1N/A "textfield({-name})");
1N/A
1N/Ais(textfield(-name => 'weather',
1N/A -value => 'nice'),
1N/A qq(<input type="text" name="weather" tabindex="5" value="dull" />),
1N/A "textfield({-name,-value})");
1N/A
1N/Ais(textfield(-name => 'weather',
1N/A -value => 'nice',
1N/A -override => 1),
1N/A qq(<input type="text" name="weather" tabindex="6" value="nice" />),
1N/A "textfield({-name,-value,-override})");
1N/A
1N/Ais(checkbox(-name => 'weather',
1N/A -value => 'nice'),
1N/A qq(<label><input type="checkbox" name="weather" value="nice" tabindex="7" />weather</label>),
1N/A "checkbox()");
1N/A
1N/Ais(checkbox(-name => 'weather',
1N/A -value => 'nice',
1N/A -label => 'forecast'),
1N/A qq(<label><input type="checkbox" name="weather" value="nice" tabindex="8" />forecast</label>),
1N/A "checkbox()");
1N/A
1N/Ais(checkbox(-name => 'weather',
1N/A -value => 'nice',
1N/A -label => 'forecast',
1N/A -checked => 1,
1N/A -override => 1),
1N/A qq(<label><input type="checkbox" name="weather" value="nice" tabindex="9" checked="checked" />forecast</label>),
1N/A "checkbox()");
1N/A
1N/Ais(checkbox(-name => 'weather',
1N/A -value => 'dull',
1N/A -label => 'forecast'),
1N/A qq(<label><input type="checkbox" name="weather" value="dull" tabindex="10" checked="checked" />forecast</label>),
1N/A "checkbox()");
1N/A
1N/Ais(radio_group(-name => 'game'),
1N/A qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="11" />chess</label> <label><input type="radio" name="game" value="checkers" tabindex="12" />checkers</label>),
1N/A 'radio_group()');
1N/A
1N/Ais(radio_group(-name => 'game',
1N/A -labels => {'chess' => 'ping pong'}),
1N/A qq(<label><input type="radio" name="game" value="chess" checked="checked" tabindex="13" />ping pong</label> <label><input type="radio" name="game" value="checkers" tabindex="14" />checkers</label>),
1N/A 'radio_group()');
1N/A
1N/Ais(checkbox_group(-name => 'game',
1N/A -Values => [qw/checkers chess cribbage/]),
1N/A qq(<label><input type="checkbox" name="game" value="checkers" checked="checked" tabindex="15" />checkers</label> <label><input type="checkbox" name="game" value="chess" checked="checked" tabindex="16" />chess</label> <label><input type="checkbox" name="game" value="cribbage" tabindex="17" />cribbage</label>),
1N/A 'checkbox_group()');
1N/A
1N/Ais(checkbox_group(-name => 'game',
1N/A '-values' => [qw/checkers chess cribbage/],
1N/A '-defaults' => ['cribbage'],
1N/A -override=>1),
1N/A qq(<label><input type="checkbox" name="game" value="checkers" tabindex="18" />checkers</label> <label><input type="checkbox" name="game" value="chess" tabindex="19" />chess</label> <label><input type="checkbox" name="game" value="cribbage" checked="checked" tabindex="20" />cribbage</label>),
1N/A 'checkbox_group()');
1N/A
1N/Ais(popup_menu(-name => 'game',
1N/A '-values' => [qw/checkers chess cribbage/],
1N/A -default => 'cribbage',
1N/A -override => 1),
1N/A '<select name="game" tabindex="21" >
1N/A<option value="checkers">checkers</option>
1N/A<option value="chess">chess</option>
1N/A<option selected="selected" value="cribbage">cribbage</option>
1N/A</select>',
1N/A 'popup_menu()');
1N/Ais(scrolling_list(-name => 'game',
1N/A '-values' => [qw/checkers chess cribbage/],
1N/A -default => 'cribbage',
1N/A -override=>1),
1N/A '<select name="game" tabindex="22" size="3">
1N/A<option value="checkers">checkers</option>
1N/A<option value="chess">chess</option>
1N/A<option selected="selected" value="cribbage">cribbage</option>
1N/A</select>',
1N/A 'scrolling_list()');
1N/A
1N/Ais(checkbox_group(-name => 'game',
1N/A -Values => [qw/checkers chess cribbage/],
1N/A -disabled => ['checkers']),
1N/A qq(<label><input type="checkbox" name="game" value="checkers" checked="checked" tabindex="23" disabled='1'/><span style="color:gray">checkers</span></label> <label><input type="checkbox" name="game" value="chess" checked="checked" tabindex="24" />chess</label> <label><input type="checkbox" name="game" value="cribbage" tabindex="25" />cribbage</label>),
1N/A 'checkbox_group()');
1N/A
1N/Amy $optgroup = optgroup(-name=>'optgroup_name',
1N/A -Values => ['moe','catch'],
1N/A -attributes=>{'catch'=>{'class'=>'red'}});
1N/A
1N/Ais($optgroup,
1N/A qq(<optgroup label="optgroup_name">
1N/A<option value="moe">moe</option>
1N/A<option class="red" value="catch">catch</option>
1N/A</optgroup>),
1N/A 'optgroup()');
1N/A
1N/Ais(popup_menu(-name=>'menu_name',
1N/A -Values=>[qw/eenie meenie minie/, $optgroup],
1N/A -labels=>{'eenie'=>'one',
1N/A 'meenie'=>'two',
1N/A 'minie'=>'three'},
1N/A -default=>'meenie'),
1N/A qq(<select name="menu_name" tabindex="26" >
1N/A<option value="eenie">one</option>
1N/A<option selected="selected" value="meenie">two</option>
1N/A<option value="minie">three</option>
1N/A<optgroup label="optgroup_name">
1N/A<option value="moe">moe</option>
1N/A<option class="red" value="catch">catch</option>
1N/A</optgroup>
1N/A</select>),
1N/A 'popup_menu() + optgroup()');
1N/A
1N/Ais(scrolling_list(-name=>'menu_name',
1N/A -Values=>[qw/eenie meenie minie/, $optgroup],
1N/A -labels=>{'eenie'=>'one',
1N/A 'meenie'=>'two',
1N/A 'minie'=>'three'},
1N/A -default=>'meenie'),
1N/A qq(<select name="menu_name" tabindex="27" size="4">
1N/A<option value="eenie">one</option>
1N/A<option selected="selected" value="meenie">two</option>
1N/A<option value="minie">three</option>
1N/A<optgroup label="optgroup_name">
1N/A<option value="moe">moe</option>
1N/A<option class="red" value="catch">catch</option>
1N/A</optgroup>
1N/A</select>),
1N/A 'scrolling_list() + optgroup()');
1N/A
1N/A# ---------- START 22046 ----------
1N/A# The following tests were added for
1N/A# https://rt.cpan.org/Public/Bug/Display.html?id=22046
1N/A# SHCOREY at cpan.org
1N/A# Saved whether working with XHTML because need to test both
1N/A# with it and without.
1N/Amy $saved_XHTML = $CGI::XHTML;
1N/A
1N/A# set XHTML
1N/A$CGI::XHTML = 1;
1N/A
1N/Ais(start_form("GET","/foobar"),
1N/A qq{<form method="get" action="/foobar" enctype="multipart/form-data">
1N/A},
1N/A 'start_form() + XHTML');
1N/A
1N/Ais(start_form("GET", "/foobar",&CGI::URL_ENCODED),
1N/A qq{<form method="get" action="/foobar" enctype="application/x-www-form-urlencoded">
1N/A},
1N/A 'start_form() + XHTML + URL_ENCODED');
1N/A
1N/Ais(start_form("GET", "/foobar",&CGI::MULTIPART),
1N/A qq{<form method="get" action="/foobar" enctype="multipart/form-data">
1N/A},
1N/A 'start_form() + XHTML + MULTIPART');
1N/A
1N/Ais(start_multipart_form("GET", "/foobar"),
1N/A qq{<form method="get" action="/foobar" enctype="multipart/form-data">
1N/A},
1N/A 'start_multipart_form() + XHTML');
1N/A
1N/Ais(start_multipart_form("GET", "/foobar","name=\"foobar\""),
1N/A qq{<form method="get" action="/foobar" enctype="multipart/form-data" name="foobar">
1N/A},
1N/A 'start_multipart_form() + XHTML + additional args');
1N/A
1N/A# set no XHTML
1N/A$CGI::XHTML = 0;
1N/A
1N/Ais(start_form("GET","/foobar"),
1N/A qq{<form method="get" action="/foobar" enctype="application/x-www-form-urlencoded">
1N/A},
1N/A 'start_form() + NO_XHTML');
1N/A
1N/Ais(start_form("GET", "/foobar",&CGI::URL_ENCODED),
1N/A qq{<form method="get" action="/foobar" enctype="application/x-www-form-urlencoded">
1N/A},
1N/A 'start_form() + NO_XHTML + URL_ENCODED');
1N/A
1N/Ais(start_form("GET", "/foobar",&CGI::MULTIPART),
1N/A qq{<form method="get" action="/foobar" enctype="multipart/form-data">
1N/A},
1N/A 'start_form() + NO_XHTML + MULTIPART');
1N/A
1N/Ais(start_multipart_form("GET", "/foobar"),
1N/A qq{<form method="get" action="/foobar" enctype="multipart/form-data">
1N/A},
1N/A 'start_multipart_form() + NO_XHTML');
1N/A
1N/Ais(start_multipart_form("GET", "/foobar","name=\"foobar\""),
1N/A qq{<form method="get" action="/foobar" enctype="multipart/form-data" name="foobar">
1N/A},
1N/A 'start_multipart_form() + NO_XHTML + additional args');
1N/A
1N/A# restoring value
1N/A$CGI::XHTML = $saved_XHTML;