SelectLayers.pm

   1 package HTML::Widgets::SelectLayers;
   2
   3 use strict;
   4 use vars qw($VERSION);
   5
   6 $VERSION = '0.05';
   7
   8 =head1 NAME
   9
  10 HTML::Widgets::SelectLayers - Perl extension for selectable HTML layers
  11
  12 =head1 SYNOPSIS
  13
  14   use HTML::Widgets::SelectLayers;
  15
  16   use Tie::IxHash;
  17   tie my %options, 'Tie::IxHash',
  18     'value'  => 'Select One',
  19     'value2' => 'Select Two',
  20   ;
  21
  22   $widget = new HTML::Widgets::SelectLayers(
  23     'options'       => \%options,
  24     'form_name'     => 'dummy',
  25     'form_action'   => 'process.cgi',
  26     'form_text'     => [ qw( textfield1 textfield2 ) ],
  27     'form_checkbox' => [ qw( checkbox1 ) ],
  28     'form_radio'    => [ qw( radio1 ) ],
  29     'form_select'   => [ qw( select1 ) ],
  30     'layer_callback' => sub {
  31       my $layer = shift;
  32       my $html = qq!<INPUT TYPE="hidden" NAME="layer" VALUE="$layer">!;
  33       $html .= $other_stuff;
  34       $html;
  35     },
  36   );
  37
  38   print '<FORM NAME=dummy STYLE="margin-top: 0; margin-bottom: 0">'.
  39         '<INPUT TYPE="text" NAME="textfield1">'.
  40         '<INPUT TYPE="text" NAME="textfield2">'.
  41         '<INPUT TYPE="checkbox" NAME="checkbox1" VALUE="Y">'.
  42         $widget->html;
  43
  44 =head1 DESCRIPTION
  45
  46 This module implements an HTML widget with multiple layers.  Only one layer
  47 is visible at any given time, controlled by a E<lt>SELECTE<gt> box.  For an
  48 example see http://www.420.am/selectlayers/
  49
  50 This HTML generated by this module uses JavaScript, but nevertheless attempts
  51 to be as cross-browser as possible.  The 0.05 release drops Navigator 4
  52 compatibility and has been tested under Mozilla Firefox 1.0.6, MSIE 6.0,
  53 Konqueror 3.3.2, and Opera 8.0.2.
  54
  55 =head1 FORMS
  56
  57 My understanding is that forms cannot span E<lt>DIVE<gt>s elements.  The
  58 generated HTML will have a E<lt>/FORME<gt> tag before the layers and will
  59 generate E<lt>FORME<gt> and E<lt>/FORME<gt> tags for each layer.  To facilitate
  60 E<lt>SUBMITE<gt> buttons located within the layers, you can pass a form name
  61 and element names, and the relevant values will be copied to the layer's form.
  62 See the B<form_> options below.
  63
  64 =head1 METHODS
  65
  66 =over 4
  67
  68 =item new KEY, VALUE, KEY, VALUE...
  69
  70 Options are passed as name/value pairs:
  71
  72 options - Hash reference of layers and labels for the E<lt>SELECTE<gt>.  See
  73           L<Tie::IxHash> to control ordering.
  74           In HTML: E<lt>OPTION VALUE="$layer"E<gt>$labelE<lt>/OPTIONE<gt>
  75
  76 layer_callback - subroutine reference to create each layer.  The layer name
  77                  is passed as an option in I<@_>
  78
  79 selected_layer - (optional) initially selected layer
  80
  81 form_name - (optional) Form name to copy values from.  If not supplied, no
  82             values will be copied.
  83
  84 form_action - Form action
  85
  86 form_text - (optional) Array reference of text (or hidden) form fields to copy
  87             from the B<form_name> form.
  88
  89 form_checkbox - (optional) Array reference of checkbox form fields to copy from
  90                 the B<form_name> form.
  91
  92 form_radio - (optional) Array reference of radio form fields to copy from the
  93              B<form_name> form.
  94
  95 form_select - (optional) Array reference of select (not select multiple) form
  96               fields to copy from the B<form_name> form.
  97
  98 fixup_callback - (optional) subroutine reference, returns supplimentary
  99                  JavaScript for the function described above under FORMS.
 100
 101 size - (optional) size of the E<lt>SELECTE<gt>, default 1.
 102
 103 unique_key - (optional) prepended to all JavaScript function/variable/object
 104              names to avoid namespace collisions.
 105
 106 html_beween - (optional) HTML between the E<lt>SELECTE<gt> and the layers.
 107
 108 under_position - (optional) specifies the positioning of any HTML appearing after the widget.  I<static>, the default, positions subsequent HTML underneath the current layer (or immediately under the select box if no layer has yet been selected), reflowing when layers are changed.  I<absolute> calculates the size of the largest layer and keeps the subsequent HTML in a single position underneath it.  Note that I<absolute> works by positioning subsequent HTML in a E<lt>DIVE<gt>, so you should probably close it yourself with a E<lt>/DIVE<gt> before your E<lt>/HTMLE<gt> end tag.  I<absolute> is a bit experimental and might have some quirks with truncating the end of the page under IE; you might have better results by just making all your layers the exact same size at the moment.
 109
 110 =cut
 111
 112 sub new {
 113   my($proto, %options) = @_;
 114   my $class = ref($proto) || $proto;
 115   my $self = \%options;
 116   bless($self, $class);
 117 }
 118
 119 =cut
 120
 121 =item html
 122
 123 Returns HTML for the widget.
 124
 125 =cut
 126
 127 sub html {
 128   my $self = shift;
 129   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 130   my $between = exists($self->{html_between}) ? $self->{html_between} : '';
 131   my $options = $self->{options};
 132   my $form_action = exists($self->{form_action}) ? $self->{form_action} : '';
 133   my $form_text =
 134     exists($self->{form_text}) ? $self->{form_text} : [];
 135   my $form_checkbox =
 136     exists($self->{form_checkbox}) ? $self->{form_checkbox} : [];
 137   my $form_radio =
 138     exists($self->{form_radio}) ? $self->{form_radio} : [];
 139   my $form_select =
 140     exists($self->{form_select}) ? $self->{form_select} : [];
 141
 142   my $under_position =
 143     exists($self->{under_position}) ? $self->{under_position} : 'static';
 144   my $hidden = lc($under_position) eq 'absolute'
 145                  ? 'visibility: hidden; position: absolute; z-index: 0'
 146                  : 'display: none; z-index: 0';
 147   #my $show = lc($under_position) eq 'absolute'
 148   #             ? 'visibility: visible'
 149   #             : 'display: "" ';
 150
 151   my $html = $self->_safeonload.
 152              $self->_visualize.
 153              "<SCRIPT>SafeAddOnLoad(${key}visualize)</SCRIPT>".
 154              $self->_changed.
 155              $self->_fixup.
 156              $self->_select. $between. '</FORM>'.
 157              "<SCRIPT>var ${key}maxHeight = 0;</SCRIPT>";
 158
 159   #foreach my $layer ( 'konq_kludge', keys %$options ) {
 160   foreach my $layer ( keys %$options ) {
 161
 162     #start layer
 163
 164     $html .= <<END;
 165       <DIV ID="${key}d$layer" STYLE="$hidden">
 166 END
 167
 168     #form fields
 169     $html .= <<END;
 170       <FORM NAME="${key}$layer" ACTION="$form_action" METHOD=POST onSubmit="${key}fixup(this)" STYLE="margin-top: 0; margin-bottom: 0">
 171 END
 172     foreach my $f ( @$form_text, @$form_checkbox, @$form_radio, @$form_select )
 173     {
 174       $html .= <<END;
 175         <INPUT TYPE="hidden" NAME="$f" VALUE="">
 176 END
 177     }
 178
 179     #layer
 180     $html .= &{$self->{layer_callback}}($layer);
 181
 182     #end form & layer
 183     $html .= <<END
 184       </FORM>
 185       </DIV>
 186       <SCRIPT>
 187         if ( document.getElementById('${key}d$layer').offsetHeight > ${key}maxHeight )
 188           ${key}maxHeight = document.getElementById('${key}d$layer').offsetHeight;
 189       </SCRIPT>
 190 END
 191
 192   }
 193
 194   if ( $under_position eq 'absolute' ) {
 195     $html .= <<END;
 196       <SCRIPT>
 197         //var max = ${key}maxHeight;
 198         document.write("<DIV STYLE=\\\"position:relative; top: " + ${key}maxHeight + "px\\\">");
 199       </SCRIPT>
 200 END
 201   }
 202
 203   $html;
 204 }
 205
 206 sub _fixup {
 207   my $self = shift;
 208   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 209   my $form_name = $self->{form_name} or return '';
 210   my $form_text =
 211     exists($self->{form_text}) ? $self->{form_text} : [];
 212   my $form_checkbox =
 213     exists($self->{form_checkbox}) ? $self->{form_checkbox} : [];
 214   my $form_radio =
 215     exists($self->{form_radio}) ? $self->{form_radio} : [];
 216   my $form_select =
 217     exists($self->{form_select}) ? $self->{form_select} : [];
 218   my $html = "
 219     <SCRIPT>
 220     function ${key}fchanged(what) {
 221       ${key}fixup(what.form);
 222     }
 223     function ${key}fixup(what) {\n";
 224
 225   foreach my $f ( @$form_text ) {
 226     $html .= "what.$f.value = document.$form_name.$f.value;\n";
 227   }
 228
 229   foreach my $f ( @$form_checkbox ) {
 230     $html .= "if (document.$form_name.$f.checked)
 231                 what.$f.value = document.$form_name.$f.value;
 232               else
 233                 what.$f.value = '';\n"
 234   }
 235
 236   foreach my $f ( @$form_radio ) {
 237     $html .= "what.$f.value = '';
 238               for ( i=0; i< document.$form_name.$f.length; i++ )
 239                 if ( document.$form_name.$f\[i].checked )
 240                   what.$f.value = document.$form_name.$f\[i].value;\n";
 241   }
 242
 243   foreach my $f ( @$form_select ) {
 244     $html .= "what.$f.value = document.$form_name.$f.options[document.$form_name.$f.selectedIndex].value;\n";
 245   }
 246
 247   $html .= &{$self->{fixup_callback}}() if exists($self->{fixup_callback});
 248
 249   $html .= "}\n</SCRIPT>";
 250
 251   $html;
 252
 253 }
 254
 255 sub _select {
 256   my $self = shift;
 257   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 258   my $options = $self->{options};
 259   my $selected = exists($self->{selected_layer}) ? $self->{selected_layer} : '';
 260   my $size =  exists($self->{size}) ? $self->{size} : 1;
 261   my $html = "
 262     <SELECT NAME=\"${key}select\" SIZE=$size onChange=\"${key}changed(this);\">
 263   ";
 264   foreach my $option ( keys %$options ) {
 265     $html .= qq(<OPTION VALUE="$option");
 266     $html .= ' SELECTED' if $option eq $selected;
 267     $html .= '>'. $options->{$option}. '</OPTION>';
 268   }
 269   $html .= '</SELECT>';
 270 }
 271
 272 sub _changed {
 273   my $self = shift;
 274   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 275   my $options = $self->{options};
 276   my $under_position =
 277     exists($self->{under_position}) ? $self->{under_position} : 'static';
 278
 279   my $html = "
 280     <SCRIPT>
 281     var ${key}layer = null;
 282     function ${key}changed(what) {
 283       ${key}layer = what.options[what.selectedIndex].value;\n";
 284   foreach my $layer ( keys %$options ) {
 285     $html .= qq(  if (${key}layer == "$layer" ) {\n);
 286     foreach my $not ( grep { $_ ne $layer } keys %$options ) {
 287       my $element_style = "document.getElementById('${key}d$not').style";
 288       if ( $under_position eq 'absolute' ) {
 289         $html .= qq(  $element_style.visibility = "hidden";\n);
 290       } else {
 291         $html .= qq(  $element_style.display = "none";\n);
 292       }
 293       $html .= qq(  $element_style.zIndex = 0;\n);
 294     }
 295     my $element_style = "document.getElementById('${key}d$layer').style";
 296     if ( $under_position eq 'absolute' ) {
 297       $html .= qq(  $element_style.visibility = "visible";\n);
 298     } else {
 299       $html .= qq(  $element_style.display = "";\n);
 300     }
 301     $html .= qq(  $element_style.zIndex = 1;\n);
 302     $html .= "  }\n";
 303   }
 304   $html .= "}\n</SCRIPT>";
 305   $html;
 306 }
 307
 308 sub _visualize {
 309   my $self = shift;
 310   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 311   return '' unless exists($self->{selected_layer});
 312   my $selected = $self->{selected_layer};
 313   my $under_position =
 314     exists($self->{under_position}) ? $self->{under_position} : 'static';
 315   my $display = ( $under_position eq 'absolute' )
 316                   ? 'visibility = "visible"'
 317                   : 'display = ""';
 318   <<END;
 319 <SCRIPT>
 320 function ${key}visualize() {
 321   document.getElementById('${key}d$selected').style.$display;
 322   document.getElementById('${key}d$selected').style.zIndex = 1;
 323 }
 324 </SCRIPT>
 325 END
 326 }
 327
 328 sub _safeonload {
 329   <<END;
 330 <SCRIPT>
 331 var gSafeOnload = new Array();
 332 function SafeAddOnLoad(f) {
 333   if (window.onload) {
 334     if (window.onload != SafeOnload) {
 335       gSafeOnload[0] = window.onload;
 336       window.onload = SafeOnload;
 337     }
 338     gSafeOnload[gSafeOnload.length] = f;
 339   } else {
 340     window.onload = f;
 341   }
 342 }
 343 function SafeOnload()
 344 {
 345   for (var i=0;i<gSafeOnload.length;i++)
 346     gSafeOnload[i]();
 347 }
 348 </SCRIPT>
 349 END
 350 }
 351
 352 =back
 353
 354 =head1 AUTHOR
 355
 356 Ivan Kohler E<lt>ivan-selectlayers@420.amE<gt>
 357
 358 =head1 COPYRIGHT
 359
 360 Copyright (c) 2002-2005 Ivan Kohler
 361 All rights reserved.
 362 This program is free software; you can redistribute it and/or modify it under
 363 the same terms as Perl itself.
 364
 365 =head1 BUGS
 366
 367 JavaScript
 368
 369 All the different form_* options are unnecessary, could use .type to auto-sense
 370
 371 Could give you a function or something for copying variables out of the
 372 layered forms.
 373
 374 =head1 SEE ALSO
 375
 376 L<perl>.  L<Tie::IxHash>, http://www.xs4all.nl/~ppk/js/dom.html,
 377 http://javascript.about.com/library/scripts/blsafeonload.htm
 378
 379 =cut