SelectLayers.pm

   1 package HTML::Widgets::SelectLayers;
   2
   3 use strict;
   4 use vars qw($VERSION);
   5
   6 $VERSION = '0.06';
   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 (single) fiels are
  97                 supported.  Select (multiple) and radio fields are not yet
  98                 supported.
  99
 100 form_text - (optional) Array reference of text (or hidden) form fields to copy
 101             from the B<form_name> form.
 102
 103 form_checkbox - (optional) Array reference of checkbox form fields to copy from
 104                 the B<form_name> form.
 105
 106 form_radio - (optional) Array reference of radio form fields to copy from the
 107              B<form_name> form.
 108
 109 form_select - (optional) Array reference of select (not select multiple) form
 110               fields to copy from the B<form_name> form.
 111
 112 fixup_callback - (optional) subroutine reference, returns supplimentary
 113                  JavaScript for the function described above under FORMS.
 114
 115 size - (optional) size of the E<lt>SELECTE<gt>, default 1.
 116
 117 unique_key - (optional) prepended to all JavaScript function/variable/object
 118              names to avoid namespace collisions.
 119
 120 html_beween - (optional) HTML between the E<lt>SELECTE<gt> and the layers.
 121
 122 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.
 123
 124 =cut
 125
 126 sub new {
 127   my($proto, %options) = @_;
 128   my $class = ref($proto) || $proto;
 129   my $self = \%options;
 130   bless($self, $class);
 131 }
 132
 133 =cut
 134
 135 =item html
 136
 137 Returns HTML for the widget.
 138
 139 =cut
 140
 141 sub html {
 142   my $self = shift;
 143   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 144   my $between = exists($self->{html_between}) ? $self->{html_between} : '';
 145   my $options = $self->{options};
 146   my $form_action = exists($self->{form_action}) ? $self->{form_action} : '';
 147
 148   my $form_elements =
 149     exists($self->{form_elements}) ? $self->{form_elements} : [];
 150   my $form_text =
 151     exists($self->{form_text}) ? $self->{form_text} : [];
 152   my $form_checkbox =
 153     exists($self->{form_checkbox}) ? $self->{form_checkbox} : [];
 154   my $form_radio =
 155     exists($self->{form_radio}) ? $self->{form_radio} : [];
 156   my $form_select =
 157     exists($self->{form_select}) ? $self->{form_select} : [];
 158
 159   my $under_position =
 160     exists($self->{under_position}) ? $self->{under_position} : 'static';
 161   my $hidden = lc($under_position) eq 'absolute'
 162                  ? 'visibility: hidden; position: absolute; z-index: 0'
 163                  : 'display: none; z-index: 0';
 164   #my $show = lc($under_position) eq 'absolute'
 165   #             ? 'visibility: visible'
 166   #             : 'display: "" ';
 167
 168   my $html = $self->_safeonload.
 169              $self->_visualize.
 170              "<SCRIPT>SafeAddOnLoad(${key}visualize)</SCRIPT>".
 171              $self->_changed.
 172              $self->_fixup.
 173              $self->_select. $between. '</FORM>'.
 174              "<SCRIPT>var ${key}maxHeight = 0;</SCRIPT>";
 175
 176   #foreach my $layer ( 'konq_kludge', keys %$options ) {
 177   foreach my $layer ( keys %$options ) {
 178
 179     #start layer
 180
 181     $html .= <<END;
 182       <DIV ID="${key}d$layer" STYLE="$hidden">
 183 END
 184
 185     #form fields
 186     $html .= <<END;
 187       <FORM NAME="${key}$layer" ACTION="$form_action" METHOD=POST onSubmit="${key}fixup(this)" STYLE="margin-top: 0; margin-bottom: 0">
 188 END
 189     foreach my $f ( @$form_elements, @$form_text, @$form_checkbox, @$form_radio, @$form_select )
 190     {
 191       $html .= <<END;
 192         <INPUT TYPE="hidden" NAME="$f" VALUE="">
 193 END
 194     }
 195
 196     #layer
 197     $html .= &{$self->{layer_callback}}($layer);
 198
 199     #end form & layer
 200     $html .= <<END
 201       </FORM>
 202       </DIV>
 203       <SCRIPT>
 204         if ( document.getElementById('${key}d$layer').offsetHeight > ${key}maxHeight )
 205           ${key}maxHeight = document.getElementById('${key}d$layer').offsetHeight;
 206       </SCRIPT>
 207 END
 208
 209   }
 210
 211   if ( $under_position eq 'absolute' ) {
 212     $html .= <<END;
 213       <SCRIPT>
 214         //var max = ${key}maxHeight;
 215         document.write("<DIV STYLE=\\\"position:relative; top: " + ${key}maxHeight + "px\\\">");
 216       </SCRIPT>
 217 END
 218   }
 219
 220   $html;
 221 }
 222
 223 sub _fixup {
 224   my $self = shift;
 225   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 226   my $form_name = $self->{form_name} or return '';
 227
 228   my $form_elements =
 229     exists($self->{form_elements}) ? $self->{form_elements} : [];
 230   my $form_text =
 231     exists($self->{form_text}) ? $self->{form_text} : [];
 232   my $form_checkbox =
 233     exists($self->{form_checkbox}) ? $self->{form_checkbox} : [];
 234   my $form_radio =
 235     exists($self->{form_radio}) ? $self->{form_radio} : [];
 236   my $form_select =
 237     exists($self->{form_select}) ? $self->{form_select} : [];
 238   my $html = <<END;
 239     <SCRIPT>
 240
 241 function copyelement(from, to) {
 242   if ( from == undefined ) {
 243     to.value = '';
 244   } else if ( from.type == 'select-one' ) {
 245     to.value = from.options[from.selectedIndex].value;
 246     //alert(from + " (" + from.type + "): " + to.name + " => (" + from.selectedIndex + ") " + to.value);
 247   } else if ( from.type == 'checkbox' ) {
 248     if ( from.checked ) {
 249       to.value = from.value;
 250     } else {
 251       to.value = '';
 252     }
 253 //  } else if ( from.type == 'radio' ) {
 254   } else {
 255     if ( from.value == undefined ) {
 256       to.value = '';
 257     } else {
 258       to.value = from.value;
 259     }
 260   }
 261   //alert(from + " (" + from.type + "): " + to.name + " => " + to.value);
 262 }
 263 END
 264
 265   $html .= "
 266     function ${key}fchanged(what) {
 267       ${key}fixup(what.form);
 268     }
 269     function ${key}fixup(what) {\n";
 270
 271   foreach my $f ( @$form_elements ) {
 272     $html .= "copyelement( document.$form_name.elements['$f'],
 273                            what.elements['$f']
 274                          )\n";
 275   }
 276
 277   foreach my $f ( @$form_text ) {
 278     $html .= "what.$f.value = document.$form_name.$f.value;\n";
 279   }
 280
 281   foreach my $f ( @$form_checkbox ) {
 282     $html .= "if (document.$form_name.$f.checked)
 283                 what.$f.value = document.$form_name.$f.value;
 284               else
 285                 what.$f.value = '';\n"
 286   }
 287
 288   foreach my $f ( @$form_radio ) {
 289     $html .= "what.$f.value = '';
 290               for ( i=0; i< document.$form_name.$f.length; i++ )
 291                 if ( document.$form_name.$f\[i].checked )
 292                   what.$f.value = document.$form_name.$f\[i].value;\n";
 293   }
 294
 295   foreach my $f ( @$form_select ) {
 296     $html .= "what.$f.value = document.$form_name.$f.options[document.$form_name.$f.selectedIndex].value;\n";
 297   }
 298
 299   $html .= &{$self->{fixup_callback}}() if exists($self->{fixup_callback});
 300
 301   $html .= "}\n</SCRIPT>";
 302
 303   $html;
 304
 305 }
 306
 307 sub _select {
 308   my $self = shift;
 309   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 310   my $options = $self->{options};
 311   my $selected = exists($self->{selected_layer}) ? $self->{selected_layer} : '';
 312   my $size =  exists($self->{size}) ? $self->{size} : 1;
 313   my $html = "
 314     <SELECT NAME=\"${key}select\" SIZE=$size onChange=\"${key}changed(this);\">
 315   ";
 316   foreach my $option ( keys %$options ) {
 317     $html .= qq(<OPTION VALUE="$option");
 318     $html .= ' SELECTED' if $option eq $selected;
 319     $html .= '>'. $options->{$option}. '</OPTION>';
 320   }
 321   $html .= '</SELECT>';
 322 }
 323
 324 sub _changed {
 325   my $self = shift;
 326   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 327   my $options = $self->{options};
 328   my $under_position =
 329     exists($self->{under_position}) ? $self->{under_position} : 'static';
 330
 331   my $html = "
 332     <SCRIPT>
 333     var ${key}layer = null;
 334     function ${key}changed(what) {
 335       ${key}layer = what.options[what.selectedIndex].value;\n";
 336   foreach my $layer ( keys %$options ) {
 337     $html .= qq(  if (${key}layer == "$layer" ) {\n);
 338     foreach my $not ( grep { $_ ne $layer } keys %$options ) {
 339       my $element_style = "document.getElementById('${key}d$not').style";
 340       if ( $under_position eq 'absolute' ) {
 341         $html .= qq(  $element_style.visibility = "hidden";\n);
 342       } else {
 343         $html .= qq(  $element_style.display = "none";\n);
 344       }
 345       $html .= qq(  $element_style.zIndex = 0;\n);
 346     }
 347     my $element_style = "document.getElementById('${key}d$layer').style";
 348     if ( $under_position eq 'absolute' ) {
 349       $html .= qq(  $element_style.visibility = "visible";\n);
 350     } else {
 351       $html .= qq(  $element_style.display = "";\n);
 352     }
 353     $html .= qq(  $element_style.zIndex = 1;\n);
 354     $html .= "  }\n";
 355   }
 356   $html .= "}\n</SCRIPT>";
 357   $html;
 358 }
 359
 360 sub _visualize {
 361   my $self = shift;
 362   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 363   return '' unless exists($self->{selected_layer});
 364   my $selected = $self->{selected_layer};
 365   my $under_position =
 366     exists($self->{under_position}) ? $self->{under_position} : 'static';
 367   my $display = ( $under_position eq 'absolute' )
 368                   ? 'visibility = "visible"'
 369                   : 'display = ""';
 370   <<END;
 371 <SCRIPT>
 372 function ${key}visualize() {
 373   document.getElementById('${key}d$selected').style.$display;
 374   document.getElementById('${key}d$selected').style.zIndex = 1;
 375 }
 376 </SCRIPT>
 377 END
 378 }
 379
 380 sub _safeonload {
 381   <<END;
 382 <SCRIPT>
 383 var gSafeOnload = new Array();
 384 function SafeAddOnLoad(f) {
 385   if (window.onload) {
 386     if (window.onload != SafeOnload) {
 387       gSafeOnload[0] = window.onload;
 388       window.onload = SafeOnload;
 389     }
 390     gSafeOnload[gSafeOnload.length] = f;
 391   } else {
 392     window.onload = f;
 393   }
 394 }
 395 function SafeOnload()
 396 {
 397   for (var i=0;i<gSafeOnload.length;i++)
 398     gSafeOnload[i]();
 399 }
 400 </SCRIPT>
 401 END
 402 }
 403
 404 =back
 405
 406 =head1 AUTHOR
 407
 408 Ivan Kohler E<lt>ivan-selectlayers@420.amE<gt>
 409
 410 =head1 COPYRIGHT
 411
 412 Copyright (c) 2002-2005 Ivan Kohler
 413 All rights reserved.
 414 This program is free software; you can redistribute it and/or modify it under
 415 the same terms as Perl itself.
 416
 417 =head1 BUGS
 418
 419 JavaScript
 420
 421 All the different form_* options are unnecessary, could use .type to auto-sense
 422
 423 Could give you a function or something for copying variables out of the
 424 layered forms.
 425
 426 =head1 SEE ALSO
 427
 428 L<perl>.  L<Tie::IxHash>, http://www.xs4all.nl/~ppk/js/dom.html,
 429 http://javascript.about.com/library/scripts/blsafeonload.htm
 430
 431 =cut