SelectLayers.pm

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