# -*- perl -*- ######################################################################## # Copyright (c) 2003-2008 University of Chicago and Fellowship # for Interpretations of Genomes. All Rights Reserved. # # This file is part of the SEED Toolkit. # # The SEED Toolkit is free software. You can redistribute # it and/or modify it under the terms of the SEED Toolkit # Public License. # # You should have received a copy of the SEED Toolkit Public License # along with this program; if not write to the University of Chicago # at info@ci.uchicago.edu or the Fellowship for Interpretation of # Genomes at veronika@thefig.info or download a copy from # http://www.theseed.org/LICENSE.TXT. ######################################################################## package ButtonArray; use strict; #------------------------------------------------------------------------------- # Item ordering tool -- GJO: # # $html = buttonArrayScript(); # # $html = buttonArrayForm( \%formData, \%hiddenData, \%submitData, # \@paramNames, \@colHeads, \@itemNames, \@itemIDs # ); # # The first function returns an HTML JavaScript to support an array of # buttons for selecting the order in which items will be displayed, analyzed, # or whatever. # # The second function returns an HTML FORM with a TABLE of radio buttons # for supporting user ordering of items. Only one copy of the script is # required to support any number of button arrays (their state data are # in the FORM object, not global JavaScript variables). # # The parameters configure the display and the submitted data. # # my $formData = { Method => 'post', # or 'get' # Action => 'process_it.cgi', # target script # EncType => 'multipart/form-data' # control packaging? # }; # # my $hiddenData = { info1 => 'My important info', # Whatever needs to send # info2 => 'Other data', # info3 => [ qw( multiple values for parameter ) ] # }; # # my $submitData = { Name => 'SubmitName', # Submit parameter name # Value => 'SubmitValue' # Label of submit button # }; # # my $paramNames = [ 'first_id', 'second_id', ... ]; # # URL parameter names for the 1st, 2nd, 3rd, etc. # # selected items. They must be unique. # # my $colHeads = [ '1', '2', ... ]; # # The table column headings for the selection grid # # my $itemNames = [ 'Item 1 name', 'Item 2 name', ... ] # # The displayed names of the items to be ordered, and # # the returned values if itemIDs is not supplied. # # my $itemIDs = [ 'id1', 'id2', ... ] # # Value returned for selected item. Default = itemNames # #------------------------------------------------------------------------------- sub buttonArrayScript { <<"End_of_Script" End_of_Script } { # Bare block to cound forms with button arrays my $nForms = 0; sub buttonArrayForm { my ( $formData, $hiddenData, $submitData, $paramNames, $colHeads, $itemNames, $itemIDs ) = @_; ref $formData eq 'HASH' && ref $paramNames eq 'ARRAY' && ref $itemNames eq 'ARRAY' && @$paramNames == @$itemNames or return ''; ref $itemIDs eq 'ARRAY' && @$itemIDs == @$itemNames or $itemIDs = $itemNames; ref $colHeads eq 'ARRAY' && @$colHeads == @$paramNames or $colHeads = [ 1 .. scalar @$paramNames ]; $nForms++; my ( $name_key ) = grep { lc $_ eq "name" } keys %$formData; $name_key ||= "Name"; my $formName = $formData->{ $name_key }; # Although some things work with "invalid" name, others do not. So ... if ( $formName !~ /^\w+$/ ) { $formName = "Form$nForms"; $formData->{ $name_key } = $formName; } my $nItem = @$itemIDs; my $nItem1 = $nItem + 1; my $formextras = join( ' ', map { "$_=\"$formData->{$_}\"" } keys %$formData ); my $html .= <<"End_of_Intro1";
End_of_Intro1 $html .= join( '', map { " \n" } @$colHeads ); $html .= <<"End_of_Intro2"; End_of_Intro2 my ( $i1, $label, $value, $j1, $state, $id, $name ); for ( $i1 = 1; $i1 <= $nItem; $i1++ ) { $label = html_escape( $itemNames->[$i1-1] ); $value = value_qq( $itemIDs->[$i1-1] ); $html .= " \n" . " \n"; for ( $j1 = 1; $j1 <= $nItem; $j1++ ) { $state = ( $j1 == 1 ) ? 'inline' : 'none'; $id = "${formName}_${i1}_$j1"; $name = html_escape( $paramNames->[$j1-1] ); $html .= " \n"; } $html .= " \n"; } $html .= <<"End_of_Table";
  Desired order
 
Items to order$_

$label

End_of_Table # Add the hidden data. Adding it earlier renumbers the radio buttons. my ( $data, $datum, $qq_datum ); foreach ( keys %$hiddenData ) { $data = $hiddenData->{ $_ }; foreach $datum ( ( ref $data eq 'ARRAY' ) ? @$data : ( $data ) ) { $qq_datum = value_qq( $datum ); # Wrap in double quotes $html .= "\n"; } } # Add the action buttons and end the form my $submit = join( ' ', map { "$_=\"$submitData->{$_}\"" } keys %$submitData ); $html .= <<"End_of_Form";
End_of_Form $html } } # End of bare block allowing us to count forms sub html_escape { local $_ = shift; s/\&/&/g; s/