1package Rose::HTML::Form::Field::Group; 2 3use strict; 4 5use Carp(); 6 7# XXX: Can't use Scalar::Defer 0.11 (or possibly later) until some things 8# XXX: are sorted out. See: http://rt.cpan.org/Ticket/Display.html?id=31039 9# XXX: Scalar::Defer 0.18 seems to work again. Yay! 10# XXX: ...but this whole approach is a bt too clever. 11#use Scalar::Defer(); 12 13use Scalar::Util(); 14use Rose::HTML::Util(); 15 16use base 'Rose::HTML::Form::Field'; 17 18our $VERSION = '0.606'; 19 20our $Debug = undef; 21 22use Rose::Object::MakeMethods::Generic 23( 24 scalar => [ qw(rows columns) ], 25 26 'scalar --get_set_init' => 27 [ 28 qw(html_linebreak xhtml_linebreak) 29 ], 30 31 boolean => [ 'linebreak' => { default => 1 } ], 32); 33 34sub init 35{ 36 my($self) = shift; 37 38 $self->{'items'} = []; 39 $self->{'values'} = {}; 40 $self->{'labels'} = {}; 41 $self->{'defaults'} = {}; 42 43 $self->SUPER::init(@_); 44} 45 46use constant HTML_LINEBREAK => "<br>\n"; 47use constant XHTML_LINEBREAK => "<br />\n"; 48 49sub init_html_linebreak { HTML_LINEBREAK } 50sub init_xhtml_linebreak { XHTML_LINEBREAK } 51 52sub _item_class { '' } 53sub _item_group_class { '' } 54sub _item_name { 'item' } 55sub _item_name_plural { 'items' } 56 57sub children 58{ 59 Carp::croak "Cannot set children() for a pseudo-group ($_[0])" if(@_ > 1); 60 return wantarray ? () : []; 61} 62 63sub is_flat_group { 1 } 64 65sub items 66{ 67 my($self) = shift; 68 69 if(@_) 70 { 71 $self->{'items'} = $self->_args_to_items({ localized => 0 }, @_); 72 $self->label_items; 73 $self->init_items; 74 } 75 76 return (wantarray) ? @{$self->{'items'} || []} : $self->{'items'}; 77} 78 79sub visible_items 80{ 81 my $items = shift->items or return; 82 return wantarray ? (grep { !$_->hidden } @$items) : [ grep { !$_->hidden } @$items ]; 83} 84 85sub show_all_items 86{ 87 my($self) = shift; 88 89 foreach my $item ($self->items) 90 { 91 $item->hidden(0); 92 } 93} 94 95sub hide_all_items 96{ 97 my($self) = shift; 98 99 foreach my $item ($self->items) 100 { 101 $item->hidden(1); 102 } 103} 104 105sub delete_item 106{ 107 my($self, $value) = @_; 108 109 my $delete_item = $self->item($value) or return; 110 my $group_class = $self->_item_group_class; 111 112 my $items = $self->items || []; 113 114 my $i = 0; 115 116 foreach my $item (@$items) 117 { 118 if($item->isa($group_class)) 119 { 120 if(my $deleted = $item->delete_item($value)) 121 { 122 return $deleted; 123 } 124 } 125 126 last if($item eq $delete_item); 127 $i++; 128 } 129 130 return splice(@$items, $i, 1); 131} 132 133sub push_items { shift->add_items(@_) } 134sub push_item { shift->add_item(@_) } 135 136sub pop_items 137{ 138 my($self) = shift; 139 140 my $items = $self->items || []; 141 142 if(@_) 143 { 144 my $offset = $#$items - $_[0]; 145 return splice(@$items, $offset < 0 ? 0 : $offset) 146 } 147 148 my @items = pop(@$items); 149 $self->init_items if(@items); 150 return @items; 151} 152 153sub pop_item { shift->pop_items(@_) } 154 155sub shift_items 156{ 157 my($self) = shift; 158 159 my $items = $self->items || []; 160 161 my @items = @_ ? splice(@$items, 0, $_[0]) : shift(@$items); 162 $self->init_items if(@items); 163 return @items; 164} 165 166sub shift_item { shift->shift_items(@_) } 167 168sub unshift_items 169{ 170 my($self) = shift; 171 172 unshift(@{$self->{'items'}}, $self->_args_to_items({ localized => 0 }, @_)); 173 174 $self->init_items; 175} 176 177sub unshift_item { shift->unshift_items(@_) } 178 179sub delete_items 180{ 181 my($self) = shift; 182 183 foreach my $arg (@_) 184 { 185 $self->delete_item($arg); 186 } 187} 188 189sub delete_item_group 190{ 191 my($self, $value) = @_; 192 193 my $group_class = $self->_item_group_class; 194 my $delete_item = UNIVERSAL::isa($value, $group_class) ? $value : ($self->item_group($value) or return); 195 196 my $items = $self->items || []; 197 198 my $i = 0; 199 200 foreach my $item (@$items) 201 { 202 last if($item eq $delete_item); 203 204 if($item->isa($group_class)) 205 { 206 if(my $deleted = $item->delete_item($value)) 207 { 208 return $deleted; 209 } 210 } 211 212 $i++; 213 } 214 215 return splice(@$items, $i, 1); 216} 217 218sub delete_item_groups 219{ 220 my($self) = shift; 221 222 foreach my $arg (@_) 223 { 224 $self->delete_item_group($arg); 225 } 226} 227 228sub items_localized 229{ 230 my($self) = shift; 231 232 if(@_) 233 { 234 $self->{'items'} = $self->_args_to_items({ localized => 1 }, @_); 235 $self->init_items; 236 } 237 238 return (wantarray) ? @{$self->{'items'}} : $self->{'items'}; 239} 240 241sub items_html_attr 242{ 243 my($self, $name) = (shift, shift); 244 245 if(@_) 246 { 247 foreach my $item ($self->items) 248 { 249 $item->html_attr($name, @_); 250 } 251 252 return @_; 253 } 254 255 foreach my $item (@{[ $self->items ]}) 256 { 257 return $item->html_attr($name); 258 } 259 260 return undef; 261} 262 263sub delete_items_html_attr 264{ 265 my($self) = shift; 266 267 foreach my $item ($self->items) 268 { 269 $item->delete_html_attr(@_); 270 } 271} 272 273*fields = \&items; 274*fields_localized = \&items_localized; 275 276sub _html_item { $_[1]->html_field } 277sub _xhtml_item { $_[1]->xhtml_field } 278 279sub _args_to_items 280{ 281 my($self, $options) = (shift, shift); 282 283 my(%labels, @choices, $items); 284 285 my $class = $self->_item_class; 286 my $group_class = $self->_item_group_class; 287 my $label_method = $options->{'localized'} ? 'label_id' : 'label'; 288 289 if(@_ == 1 && ref $_[0] eq 'HASH') 290 { 291 %labels = %{$_[0]}; 292 @choices = sort keys %labels; 293 } 294 else 295 { 296 my $args; 297 298 # XXX: Hack to allow a reference to an array of plain scalars 299 # XXX: to be taken as a list of values. 300 if(@_ == 1 && ref $_[0] eq 'ARRAY') 301 { 302 $args = $_[0]; 303 304 unless(grep { ref $_ } @$args) 305 { 306 $args = [ map { $_ => $_ } @$args ]; 307 } 308 } 309 else { $args = \@_ } 310 311 while(@$args) 312 { 313 my $arg = shift(@$args); 314 315 if(UNIVERSAL::isa($arg, $class) || UNIVERSAL::isa($arg, $group_class)) 316 { 317 push(@$items, $arg); 318 } 319 elsif(!ref $arg) 320 { 321 my $item = $class->new(value => $arg); 322 323 if(!ref $args->[0]) 324 { 325 $item->$label_method(shift(@$args)); 326 push(@$items, $item); 327 } 328 elsif(ref $args->[0] eq 'HASH') 329 { 330 my $pairs = shift(@$args); 331 332 while(my($method, $value) = each(%$pairs)) 333 { 334 $item->$method($value); 335 } 336 337 push(@$items, $item); 338 } 339 elsif(ref $args->[0] eq 'ARRAY') 340 { 341 my $group = $group_class->new(label => $arg, 342 items => shift @$args); 343 push(@$items, $group); 344 } 345 else 346 { 347 Carp::croak "Illegal or incorrectly positioned ", $self->_item_name_plural, 348 " argument: $args->[0]"; 349 } 350 351 } 352 else 353 { 354 Carp::croak "Illegal or incorrectly positioned ", $self->_item_name_plural, 355 " argument: $args->[0]"; 356 } 357 } 358 } 359 360 if(keys %labels) 361 { 362 my @items; 363 364 my $class = $self->_item_class; 365 366 foreach my $value (@choices) 367 { 368 push(@$items, $class->new(value => $value, 369 $label_method => $labels{$value})); 370 } 371 } 372 373 foreach my $item (@$items) 374 { 375 # Connect item to group 376 $item->parent_group($self) if($item->can('parent_group')); 377 378 # XXX: This whole approach is a bit too clever and leak-prone. 379 380 # # Speculatively hook up localizer and locale 381 # # XXX: Scalar::Defer 0.11 breaks this (http://rt.cpan.org/Ticket/Display.html?id=31039) 382 # # XXX: Scalar::Defer 0.18 seems to work again. Yay! 383 # Scalar::Util::weaken(my $welf = $self); 384 # $item->localizer(Scalar::Defer::defer { $welf->localizer }); 385 # #$item->localizer(sub { $welf->localizer }); 386 # 387 # # XXX: Use lame workaround instead. 388 # #Scalar::Util::weaken(my $welf = $self); 389 # #$item->localizer(sub { $welf->localizer }); 390 # 391 # if(my $parent = $self->parent_form) 392 # { 393 # # XXX: Scalar::Defer 0.11 breaks this (http://rt.cpan.org/Ticket/Display.html?id=31039) 394 # # XXX: Scalar::Defer 0.18 seems to work again. Yay! 395 # Scalar::Util::weaken(my $warent = $parent); 396 # $item->locale(Scalar::Defer::defer { $warent->locale }); 397 # # XXX: Use lame workaround instead. 398 # #$item->locale(sub { $parent->locale }); 399 # } 400 } 401 402 return (wantarray) ? @$items : $items; 403} 404 405sub parent_field 406{ 407 my($self) = shift; 408 409 if(@_) 410 { 411 if(my $parent = $self->SUPER::parent_field(@_)) 412 { 413 foreach my $item ($self->items) 414 { 415 $item->parent_field($parent) unless($item->parent_field); 416 } 417 } 418 } 419 420 return $self->SUPER::parent_field; 421} 422 423# XXX: This whole approach is a bit too clever and leak-prone. 424# sub parent_form 425# { 426# my($self) = shift; 427# 428# if(@_) 429# { 430# if(my $parent = $self->SUPER::parent_form(@_)) 431# { 432# foreach my $item ($self->items) 433# { 434# # XXX: Scalar::Defer 0.11 breaks this (http://rt.cpan.org/Ticket/Display.html?id=31039) 435# # XXX: Scalar::Defer 0.18 seems to work again. Yay! 436# Scalar::Util::weaken(my $warent = $parent); 437# $item->locale(Scalar::Defer::defer { $warent->locale }); 438# # XXX: Use lame workaround instead. 439# #$item->locale(sub { $parent->locale }); 440# } 441# } 442# } 443# 444# return $self->SUPER::parent_form; 445# } 446 447sub add_items 448{ 449 my($self) = shift; 450 451 push(@{$self->{'items'}}, $self->_args_to_items({ localized => 0 }, @_)); 452 453 $self->init_items; 454} 455 456*add_item = \&add_items; 457 458sub add_items_localized 459{ 460 my($self) = shift; 461 462 push(@{$self->{'items'}}, $self->_args_to_items({ localized => 1 }, @_)); 463 464 $self->init_items; 465} 466 467*add_item_localized = \&add_items_localized; 468 469sub label_items 470{ 471 my($self) = shift; 472 473 my $labels = $self->{'labels'} || {}; 474 my $label_ids = $self->{'label_ids'} || {}; 475 476 return unless(%$labels || %$label_ids); 477 478 foreach my $item ($self->items) 479 { 480 my $value = $item->html_attr('value'); 481 482 next unless(defined $value); 483 484 if(exists $label_ids->{$value}) 485 { 486 $item->label_id($label_ids->{$value}); 487 } 488 elsif(exists $labels->{$value}) 489 { 490 $item->label($labels->{$value}); 491 } 492 } 493} 494 495sub clear 496{ 497 my($self) = shift; 498 499 $self->{'values'} = undef; 500 501 foreach my $item ($self->items) 502 { 503 local $item->{'auto_invalidate_parent'} = $self->auto_invalidate_parent; 504 $item->clear; 505 } 506 507 $self->error(undef); 508 $self->has_partial_value(0); 509 $self->is_cleared(1); 510 511 $self->init_items; 512} 513 514sub clear_labels 515{ 516 my($self) = shift; 517 518 delete $self->{'labels'}; 519 delete $self->{'label_ids'}; 520 521 foreach my $item ($self->items) 522 { 523 $item->label_id(undef); 524 $item->label(''); 525 } 526 527 return; 528} 529 530sub reset_labels 531{ 532 my($self) = shift; 533 534 delete $self->{'labels'}; 535 delete $self->{'label_ids'}; 536 537 foreach my $item ($self->items) 538 { 539 $item->label_id(undef); 540 $item->label($item->value); 541 } 542 543 return; 544} 545 546sub reset 547{ 548 my($self) = shift; 549 550 $self->input_value(undef); 551 552 foreach my $item ($self->items) 553 { 554 $item->reset; 555 } 556 557 $self->error(undef); 558 $self->has_partial_value(0); 559 $self->is_cleared(0); 560 561 $self->init_items; 562} 563 564sub labels { shift->_labels(0, @_) } 565sub label_ids { shift->_labels(1, @_) } 566 567sub _labels 568{ 569 my($self, $localized) = (shift, shift); 570 571 my $key = $localized ? 'label_ids' : 'labels'; 572 573 if(@_) 574 { 575 my %labels; 576 577 if(@_ == 1 && ref $_[0] eq 'HASH') 578 { 579 $self->{$key} = $_[0]; 580 } 581 else 582 { 583 Carp::croak "Odd number of items found in $key() hash argument" 584 unless(@_ % 2 == 0); 585 586 $self->{$key} = { @_ }; 587 } 588 589 $self->label_items; 590 } 591 592 my $want = wantarray; 593 594 return unless(defined $want); 595 596 my $group_class = $self->_item_group_class; 597 598 my %labels; 599 600 # Dumb linear search for now 601 foreach my $item ($self->items) 602 { 603 if($item->isa($group_class)) 604 { 605 foreach my $subitem ($item->items) 606 { 607 $labels{$subitem->html_attr('value')} = $subitem->label; 608 } 609 } 610 else 611 { 612 $labels{$item->html_attr('value')} = $item->label; 613 } 614 } 615 616 return $want ? %labels : \%labels; 617} 618 619# sub labels 620# { 621# my($self) = shift; 622# 623# if(@_) 624# { 625# my %labels; 626# 627# if(@_ == 1 && ref $_[0] eq 'HASH') 628# { 629# $self->{'labels'} = $_[0]; 630# } 631# else 632# { 633# Carp::croak "Odd number of items found in labels() hash argument" 634# unless(@_ % 2 == 0); 635# 636# $self->{'labels'} = { @_ }; 637# } 638# 639# $self->label_items; 640# } 641# 642# my $want = wantarray; 643# 644# return unless(defined $want); 645# 646# my $group_class = $self->_item_group_class; 647# 648# my %labels; 649# 650# # Dumb linear search for now 651# foreach my $item ($self->items) 652# { 653# if($item->isa($group_class)) 654# { 655# foreach my $subitem ($item->items) 656# { 657# $labels{$subitem->html_attr('value')} = $subitem->label; 658# } 659# } 660# else 661# { 662# $labels{$item->html_attr('value')} = $item->label; 663# } 664# } 665# 666# return $want ? %labels : \%labels; 667# } 668 669sub html_field 670{ 671 my($self) = shift; 672 my $sep = ($self->linebreak) ? $self->html_linebreak : ' '; 673 return join($sep, map { $_->html_field } $self->visible_items); 674} 675 676*html_fields = \&html_field; 677 678sub xhtml_field 679{ 680 my($self) = shift; 681 my $sep = ($self->linebreak) ? $self->xhtml_linebreak : ' '; 682 return join($sep, map { $_->xhtml_field } $self->visible_items); 683} 684 685*xhtml_fields = \&xhtml_field; 686 687sub escape_html 688{ 689 my($self) = shift; 690 691 if(@_) 692 { 693 my $val = $self->SUPER::escape_html(@_); 694 695 foreach my $item ($self->items) 696 { 697 $item->escape_html($val); 698 } 699 700 return $val; 701 } 702 703 return $self->SUPER::escape_html(@_); 704} 705 706sub hidden_fields 707{ 708 my($self) = shift; 709 710 my @hidden; 711 712 foreach my $item ($self->items) 713 { 714 push(@hidden, $item->hidden_field) if(defined $item->internal_value); 715 } 716 717 return (wantarray) ? @hidden : \@hidden; 718} 719 720# XXX: Could someday use Rose::HTML::Table::* 721 722sub html_table 723{ 724 my($self, %args) = @_; 725 726 my $items = $args{'items'}; 727 728 return unless(ref $items && @$items); 729 730 my $xhtml = delete $args{'_xhtml'} || 0; 731 my $format_item = $args{'format_item'} || ($xhtml ? \&_xhtml_item : \&_html_item); 732 733 my $total = @$items; 734 my $rows = $args{'rows'} || $self->rows || 1; 735 my $cols = $args{'columns'} || $self->columns || 1; 736 737 my $per_cell = $total / ($rows * $cols); 738 739 if($total % ($rows * $cols)) 740 { 741 $per_cell = int($per_cell + 1); 742 } 743 744 my @table; 745 746 my $i = 0; 747 748 for(my $x = 0; $x < $cols; $x++) 749 { 750 for(my $y = 0; $y < $rows; $y++) 751 { 752 my $end = $i + $per_cell - 1; 753 $end = $#$items if($end > $#$items); 754 $table[$y][$x] = [ @$items[$i .. $end] ]; 755 $i += $per_cell; 756 } 757 } 758 759 my $sep = ($self->linebreak) ? $xhtml ? $self->xhtml_linebreak : $self->html_linebreak : ' '; 760 761 my $html = '<table' . Rose::HTML::Util::html_attrs_string($args{'table'}) . ">\n"; 762 763 my @tr_attrs = (ref $args{'tr'} eq 'ARRAY') ? @{$args{'tr'}} : ($args{'tr'}); 764 my @td_attrs = (ref $args{'td'} eq 'ARRAY') ? @{$args{'td'}} : ($args{'td'}); 765 766 my $tr = 0; 767 768 foreach my $col (@table) 769 { 770 my $tr_attrs = $tr_attrs[$tr] || $tr_attrs[-1]; 771 772 $html .= '<tr' . Rose::HTML::Util::html_attrs_string($tr_attrs) . ">\n"; 773 774 my $td = 0; 775 776 foreach my $row (@$col) 777 { 778 my $td_attrs = $td_attrs[$td] || $td_attrs[-1]; 779 780 $html .= '<td' . Rose::HTML::Util::html_attrs_string($td_attrs) . '>' . 781 join($sep, map { $self->$format_item($_) } @$row) . 782 "</td>\n"; 783 784 $td++; 785 } 786 787 $html .= "</tr>\n"; 788 $tr++; 789 } 790 791 $html .= "</table>\n"; 792 793 return $html; 794} 795 796*xhtml_table = \&html_table; 797 7981; 799