<%doc> Usage: <& /elements/select-tiered.html, tiers => [ { table => 'table1', ... }, # most select-table options are supported { table => 'table2', ..., link_col = 't2num' }, # foreign key in table1 ], prefix => '', # to avoid name conflicts curr_value => 42, # in the last table field => 'fieldname', # NAME attribute of the last element &> This creates a group of SELECT elements (similar to select-table.html) for drill-down navigation of data with one-to-many relationships. 'tiers' is required, and must be an arrayref of hashes, each describing one tier of selection (from most general to most specific). Each tier can contain the following: - table, select, addl_from, hashref, extra_sql: as in FS::Record::qsearch. - records, an arrayref of exact records. Either this or "table" must be provided. - field: the NAME attribute of the select element. Optional. - name_col: the column/method name to obtain the record's text label in the select element. - value_col: the column/method name to obtain the record's value, which is sent on form submission. Defaults to the primary key. - link_col: the column/method name to associate the record to the value_col of a record in the previous table's value_col. (That is, the foreign key.) - empty_label: the label to use for an option with the logical meaning of "all of these" and a value of ''. - curr_value: the currently selected value. This will constrain the current values of preceding tiers. - multiple: set to true for a multiple-style selector. This should work but isn't fully tested. - after: an HTML string to be inserted after the select element, before the next one. By default there's nothing between them. - onchange: an additional javascript function to be called on change. For convenience, "curr_value" and "field" can be passed as part of the main argument list, and will be applied to the last tier. % $i = 0; % foreach my $tier (@$tiers) { % my $onchange; % $onchange="${pre}select_change(this, $i)" % if $i < scalar(@$tiers) - 1; % % $onchange .= ';'.$tier->{onchange}."(this, $i);" % if $tier->{onchange}; % % $onchange = "onchange='$onchange'" if $onchange; <% $tier->{after} %> % } #foreach $tier <%init> my %opt = @_; my $pre = $opt{prefix} || ''; my $tiers = $opt{tiers} or die "no tiers defined"; my $json = Cpanel::JSON::XS->new(); $json->canonical; my $i; for( $i = 0; $i < @$tiers; $i++ ) { my $tier = $tiers->[$i]; my $key = $tier->{value_col}; my $name_col = $tier->{name_col}; if ( !exists($tier->{records}) ) { # minor false laziness w/ select-table my $dbdef_table = dbdef->table($tier->{table}) or die "can't find dbdef for ".$tier->{table}." table\n"; $key ||= $dbdef_table->primary_key; my $hashref = $tier->{hashref} || {}; my $select = $tier->{select} || '*'; # we don't yet support agent_virt $tier->{records} = [ qsearch({ 'select' => $select, # the real magic 'table' => $tier->{table}, 'addl_from' => $tier->{addl_from}, 'hashref' => $hashref, 'extra_sql' => $tier->{extra_sql}, }) ]; } # set up options my %children_of; if ( $i == 0 ) { $children_of{''} = { map { $_->$key => $_->$name_col } @{ $tier->{records} } }; } else { my $link_col = $tier->{link_col} or die "no link_col in '".$tier->{table}."' tier\n"; # %children_of maps the option values in the previous tier # to hashes of their linked options in this tier. foreach my $rec (@{ $tier->{records} }) { $children_of{ $rec->$link_col } ||= {}; $children_of{ $rec->$link_col }->{ $rec->$key } = $rec->$name_col; } } if ( defined $tier->{empty_label} ) { foreach my $key (keys %children_of) { # only create "all" options if there are multiple choices if ( scalar(keys %{ $children_of{$key} }) > 1 ) { $children_of{$key}->{''} = $tier->{empty_label}; } } # ensure that there's always at least one empty label $children_of{''}->{''} = $tier->{empty_label}; } $tier->{by_key} = \%children_of; } $i = scalar(@$tiers) - 1; $tiers->[$i]->{curr_value} ||= $opt{curr_value}; $tiers->[$i]->{field} ||= $opt{field}; # We expect the usual case to be $opt{curr_value}, i.e. # current value in the last tier. So trace it backward. while($i >= 1) { my $curr_value = $tiers->[$i]->{curr_value}; last if !defined($curr_value); my $tier = $tiers->[$i]; foreach my $key ( %{ $tier->{by_key} } ) { my $options = $tier->{by_key}->{$key}; if ( exists( $options->{$curr_value} ) ) { $tiers->[$i-1]->{curr_value} = $key; last; } } $i--; } my $tiers_by_key = [ map { $_->{by_key} } @$tiers ]; my $curr_values = [ map { $_->{curr_value} || '' } @$tiers ];