Bug #30057 for CGI: Depends on RT#35376: CGI.pm popup_menu multiple selects

Ok, patches rolled in. RFC please :)

1698c1698 < if ($DTD_PUBLIC_IDENTIFIER =~ /[^X]HTML (2\.0|3\.2|4\.01?)/i) { --- > if ($DTD_PUBLIC_IDENTIFIER =~ /[^X]HTML (2\.0|3\.2)/i) { 2538a2539 > $selectit = ' selected="selected" ' if $_ ~~ @{$self->{param}->{$name}} // ''; 4962,4963c4963 < If start_html()'s -dtd parameter specifies an HTML 2.0, < 3.2, 4.0 or 4.01 DTD, --- > If start_html()'s -dtd parameter specifies an HTML 2.0 or 3.2 DTD,

1c1 < #!perl --- > #!/usr/bin/perl 3c3,5 < use lib 't/lib'; --- > use lib './lib'; > use lib './t/lib'; > use CGI qw/:debug/; 5c7,8 < use CGI; --- > use feature 'say'; > use Data::Dumper; 7c10,12 < my $q = CGI->new; --- > push @ARGV,"selection=bbb;selection=ccc"; > > my $q = CGI->new(); 10c15 < '<select name="foo" > --- > '<select name="foo" > 14c19,46 < , 'popup_menu(): basic test, including 0 as a default value'); --- > , 'popup_menu(): basic test, including 0 as a default value'); > > > # test for popup_menu multiple selection that would have to last after submit button is > # pressed > my $q = CGI->new(); > > my $menu = $q->popup_menu( > -name=>'selection', > -default=>'' , > -multiple=>'true', > -values=>['aaa','bbb','ccc'], > -labels=>{ > 'aaa'=>'aaa', > 'bbb'=>'bbb', > 'ccc'=>'ccc', > } > ); > is($menu, > '<select name="selection" multiple="true"> > <option value="aaa">aaa</option> > <option selected="selected" value="bbb">bbb</option> > <option selected="selected" value="ccc">ccc</option> > </select>', > 'popup_menu(): test related to having multiple items selected and after select they should still be selected' > ); > >

ok - replaced the ~~ with grep. - added some description of popup_menu to the POD. - added check for "-multiple" in order to not break other tests in ( if I don't check for "-multiple" some tests form.t:106 and no_tabindex.t:108)

2505a2506,2511 > # { > # sub deb { > # open my $debug_fh,">/tmp/debug_cgi.txt"; > # print $debug_fh $_[0] > # }; > # }; 2524a2531,2532 > # use Data::Dumper; > # deb Dumper \@_; 2538a2547,2556 > # Mark Stosberg suggestions -> using something that would be compatible for perl 5.6 > # for counting occurences inside an array ( instead of ~~ which was used before ) > # grep is a possibility > if( (grep /^-multiple$/, @_) > 0 && defined $self->{param}->{$name} && @{$self->{param}->{$name}} > 1) { > #this code will be run only if we have multiple selections > my $val = $_; # current > # we count in occ_val occurences of the current value attribute which is selected > my $occ_val = () = grep /^$val$/,@{ $self->{param}->{$name} }; > $selectit = ' selected="selected" ' if $occ_val > 0; > } 4962,4963c4980 < If start_html()'s -dtd parameter specifies an HTML 2.0, < 3.2, 4.0 or 4.01 DTD, --- > If start_html()'s -dtd parameter specifies an HTML 2.0 or 3.2 DTD, 6278a6296,6313 > -or- ( > multiple selection allows to have multiple items selected, > they will continue to be selected after you submit the form > ) > > print popup_menu( > -name=>'selection', > -default=>'' , > -multiple=>'true', > -values=>['aaa','bbb','ccc'], > -override=>1, > -labels=>{ > 'aaa'=>'aaa', > 'bbb'=>'bbb', > 'ccc'=>'ccc', > } > ) >

1c1 < #!perl --- > #!/usr/bin/perl 3c3,5 < use lib 't/lib'; --- > use lib './lib'; > use lib './t/lib'; > use CGI qw/:debug/; 5c7,8 < use CGI; --- > use feature 'say'; > use Data::Dumper; 7c10,12 < my $q = CGI->new; --- > push @ARGV,"selection=bbb;selection=ccc"; > > my $q = CGI->new(); 10c15 < '<select name="foo" > --- > '<select name="foo" > 14c19,47 < , 'popup_menu(): basic test, including 0 as a default value'); --- > , 'popup_menu(): basic test, including 0 as a default value'); > > > # test for popup_menu multiple selection that would have to last after submit button is > # pressed > $q = CGI->new(); > > my $menu = $q->popup_menu( > -name=>'selection', > -default=>'' , > -multiple=>'true', > -values=>['aaa','bbb','ccc'], > -override=>1, > -labels=>{ > 'aaa'=>'aaa', > 'bbb'=>'bbb', > 'ccc'=>'ccc', > } > ); > is($menu, > '<select name="selection" multiple="true"> > <option value="aaa">aaa</option> > <option selected="selected" value="bbb">bbb</option> > <option selected="selected" value="ccc">ccc</option> > </select>', > 'popup_menu(): test related to having multiple items selected and after select they should still be selected' > ); > >

On Mon Aug 17 21:23:54 2009, MARKSTOS wrote: Show quoted text
Hi Mark, I've used git diff > popup_menu.patch I'm sending it now.

diff --git a/lib/CGI.pm b/lib/CGI.pm index 65fff24..855bb9e 100644 --- a/lib/CGI.pm +++ b/lib/CGI.pm @@ -2542,6 +2542,15 @@ sub popup_menu { else { my $attribs = $self->_set_attributes($_, $attributes); my($selectit) = $self->_selected($selected{$_}); + + if( (grep /^-multiple$/, @_) > 0 && defined $self->{param}->{$name} && @{$self->{param}->{$name}} > 1) { + #this code will be run only if we have multiple selections + my $val = $_; # current + # we count in occ_val occurences of the current value attribute which is selected + my $occ_val = grep /^$val$/,@{ $self->{param}->{$name} }; + $selectit = ' selected="selected" ' if $occ_val > 0; + } + my($label) = $_; $label = $labels->{$_} if defined($labels) && defined($labels->{$_}); my($value) = $self->escapeHTML($_); @@ -6284,6 +6293,24 @@ recognized. See textfield() for details. -default=>['meenie','minie'], -labels=>\%labels, -attributes=>\%attributes); + -or- ( + multiple selection allows to have multiple items selected, + they will continue to be selected after you submit the form + ) + + print popup_menu( + -name=>'selection', + -default=>'' , + -multiple=>'true', + -values=>['aaa','bbb','ccc'], + -override=>1, + -labels=>{ + 'aaa'=>'aaa', + 'bbb'=>'bbb', + 'ccc'=>'ccc', + } + ) + popup_menu() creates a menu. diff --git a/t/popup_menu.t b/t/popup_menu.t index 90c52a9..4c7a360 100644 --- a/t/popup_menu.t +++ b/t/popup_menu.t @@ -6,9 +6,34 @@ use CGI; my $q = CGI->new; is ( $q->popup_menu(-name=>"foo", - values=>[0,1], -default=>0), -'<select name="foo" > + '<select name="foo" > <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'); + + +push @ARGV,"selection=bbb;selection=ccc"; +$q = CGI->new(); + +my $menu = $q->popup_menu( + -name=>'selection', + -default=>'' , + -multiple=>'true', + -values=>['aaa','bbb','ccc'], + -override=>1, + -labels=>{ + 'aaa'=>'aaa', + 'bbb'=>'bbb', + 'ccc'=>'ccc', + } +); +is($menu, + '<select name="selection" multiple="true"> +<option value="aaa">aaa</option> +<option selected="selected" value="bbb">bbb</option> +<option selected="selected" value="ccc">ccc</option> +</select>', + 'popup_menu(): test related to having multiple items selected and after select they should still be selected' +);