SelectLayers.pm

   1 package HTML::Widgets::SelectLayers;
   2
   3 use strict;
   4 use vars qw($VERSION);
   5
   6 $VERSION = '0.04';
   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>'.
  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, testing for features via DOM support rather
  52 than specific browsers or versions.  It has been tested under Mozilla 0.9.8,
  53 Netscape 4.77, IE 5.5, Konqueror 2.2.2, and Opera 5.0.
  54
  55 =head1 FORMS
  56
  57 Not all browsers seem happy with forms that span layers.  The generated HTML
  58 will have a E<lt>/FORME<gt> tag before the layers and will generate
  59 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 =cut
 109
 110 sub new {
 111   my($proto, %options) = @_;
 112   my $class = ref($proto) || $proto;
 113   my $self = \%options;
 114   bless($self, $class);
 115 }
 116
 117 =cut
 118
 119 =item html
 120
 121 Returns HTML for the widget.
 122
 123 =cut
 124
 125 sub html {
 126   my $self = shift;
 127   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 128   my $between = exists($self->{html_between}) ? $self->{html_between} : '';
 129   my $options = $self->{options};
 130   my $form_action = exists($self->{form_action}) ? $self->{form_action} : '';
 131   my $form_text =
 132     exists($self->{form_text}) ? $self->{form_text} : [];
 133   my $form_checkbox =
 134     exists($self->{form_checkbox}) ? $self->{form_checkbox} : [];
 135   my $form_radio =
 136     exists($self->{form_radio}) ? $self->{form_radio} : [];
 137   my $form_select =
 138     exists($self->{form_select}) ? $self->{form_select} : [];
 139
 140   my $html = $self->_safeonload.
 141              $self->_visualize.
 142              "<SCRIPT>SafeAddOnLoad(${key}visualize)</SCRIPT>".
 143              $self->_changed.
 144              $self->_fixup.
 145              $self->_select. $between. '</FORM>';
 146
 147   #foreach my $layer ( 'konq_kludge', keys %$options ) {
 148   foreach my $layer ( keys %$options ) {
 149
 150     #start layer
 151     my $visibility = "hidden";
 152     $html .= <<END;
 153       <SCRIPT>
 154       if (document.getElementById) {
 155         document.write("<DIV ID=\\"${key}d$layer\\" STYLE=\\"visibility: $visibility; position: absolute\\">");
 156       } else {
 157 END
 158     $visibility="show" if $visibility eq "visible";
 159     $html .= <<END;
 160         document.write("<LAYER ID=\\"${key}l$layer\\" VISIBILITY=\\"$visibility\\">");
 161       }
 162       </SCRIPT>
 163 END
 164
 165     #form fields
 166     $html .= <<END;
 167       <FORM NAME="${key}$layer" ACTION="$form_action" METHOD=POST onSubmit="${key}fixup(this)">
 168 END
 169     foreach my $f ( @$form_text, @$form_checkbox, @$form_radio, @$form_select )
 170     {
 171       $html .= <<END;
 172         <INPUT TYPE="hidden" NAME="$f" VALUE="">
 173 END
 174     }
 175
 176     #layer
 177     $html .= &{$self->{layer_callback}}($layer);
 178
 179     #end form & layer
 180     $html .= <<END
 181       </FORM>
 182
 183       <SCRIPT>
 184       if (document.getElementById) {
 185         document.write("</DIV>");
 186       } else {
 187         document.write("</LAYER>");
 188       }
 189       </SCRIPT>
 190 END
 191
 192   }
 193
 194   $html;
 195 }
 196
 197 sub _fixup {
 198   my $self = shift;
 199   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 200   my $form_name = $self->{form_name} or return '';
 201   my $form_text =
 202     exists($self->{form_text}) ? $self->{form_text} : [];
 203   my $form_checkbox =
 204     exists($self->{form_checkbox}) ? $self->{form_checkbox} : [];
 205   my $form_radio =
 206     exists($self->{form_radio}) ? $self->{form_radio} : [];
 207   my $form_select =
 208     exists($self->{form_select}) ? $self->{form_select} : [];
 209   my $html = "
 210     <SCRIPT>
 211     function ${key}fchanged(what) {
 212       ${key}fixup(what.form);
 213     }
 214     function ${key}fixup(what) {\n";
 215
 216   foreach my $f ( @$form_text ) {
 217     $html .= "what.$f.value = document.$form_name.$f.value;\n";
 218   }
 219
 220   foreach my $f ( @$form_checkbox ) {
 221     $html .= "if (document.$form_name.$f.checked)
 222                 what.$f.value = document.$form_name.$f.value;
 223               else
 224                 what.$f.value = '';\n"
 225   }
 226
 227   foreach my $f ( @$form_radio ) {
 228     $html .= "what.$f.value = '';
 229               for ( i=0; i< document.$form_name.$f.length; i++ )
 230                 if ( document.$form_name.$f\[i].checked )
 231                   what.$f.value = document.$form_name.$f\[i].value;\n";
 232   }
 233
 234   foreach my $f ( @$form_select ) {
 235     $html .= "what.$f.value = document.$form_name.$f.options[document.$form_name.$f.selectedIndex].value;\n";
 236   }
 237
 238   $html .= &{$self->{fixup_callback}}() if exists($self->{fixup_callback});
 239
 240   $html .= "}\n</SCRIPT>";
 241
 242   $html;
 243
 244 }
 245
 246 sub _select {
 247   my $self = shift;
 248   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 249   my $options = $self->{options};
 250   my $selected = exists($self->{selected_layer}) ? $self->{selected_layer} : '';
 251   my $size =  exists($self->{size}) ? $self->{size} : 1;
 252   my $html = "
 253     <SELECT NAME=\"${key}select\" SIZE=$size onChange=\"${key}changed(this);\">
 254   ";
 255   foreach my $option ( keys %$options ) {
 256     $html .= "<OPTION VALUE=\"$option\"";
 257     $html .= ' SELECTED' if $option eq $selected;
 258     $html .= '>'. $options->{$option}. '</OPTION>';
 259   }
 260   $html .= '</SELECT>';
 261 }
 262
 263 sub _changed {
 264   my $self = shift;
 265   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 266   my $options = $self->{options};
 267   my $html = "
 268     <SCRIPT>
 269     var ${key}layer = null;
 270     function ${key}changed(what) {
 271       ${key}layer = what.options[what.selectedIndex].value;\n";
 272   foreach my $layer ( keys %$options ) {
 273     $html .= "if (${key}layer == \"$layer\" ) {\n";
 274     foreach my $not ( grep { $_ ne $layer } keys %$options ) {
 275       $html .= "
 276         if (document.getElementById) {
 277           document.getElementById('${key}d$not').style.visibility = \"hidden\";
 278         } else {
 279           document.${key}l$not.visibility = \"hidden\";
 280         }\n";
 281     }
 282     $html .= "
 283       if (document.getElementById) {
 284         document.getElementById('${key}d$layer').style.visibility = \"visible\";
 285       } else {
 286         document.${key}l$layer.visibility = \"visible\";
 287       }
 288     }\n";
 289   }
 290   $html .= "}\n</SCRIPT>";
 291   $html;
 292 }
 293
 294 sub _visualize {
 295   my $self = shift;
 296   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 297   return '' unless exists($self->{selected_layer});
 298   my $selected = $self->{selected_layer};
 299   <<END;
 300 <SCRIPT>
 301 function ${key}visualize() {
 302   if (document.getElementById) {
 303     document.getElementById('${key}d$selected').style.visibility = "visible";
 304   } else {
 305     document.${key}l$selected.visibility = "visible";
 306   }
 307 }
 308 </SCRIPT>
 309 END
 310 }
 311
 312 sub _safeonload {
 313   <<END;
 314 <SCRIPT>
 315 var gSafeOnload = new Array();
 316 function SafeAddOnLoad(f) {
 317   if (window.onload) {
 318     if (window.onload != SafeOnload) {
 319       gSafeOnload[0] = window.onload;
 320       window.onload = SafeOnload;
 321     }
 322     gSafeOnload[gSafeOnload.length] = f;
 323   } else {
 324     window.onload = f;
 325   }
 326 }
 327 function SafeOnload()
 328 {
 329   for (var i=0;i<gSafeOnload.length;i++)
 330     gSafeOnload[i]();
 331 }
 332 </SCRIPT>
 333 END
 334 }
 335
 336 =back
 337
 338 =head1 AUTHOR
 339
 340 Ivan Kohler E<lt>ivan-selectlayers@420.amE<gt>
 341
 342 =head1 COPYRIGHT
 343
 344 Copyright (c) 2002 Ivan Kohler
 345 All rights reserved.
 346 This program is free software; you can redistribute it and/or modify it under
 347 the same terms as Perl itself.
 348
 349 =head1 BUGS
 350
 351 JavaScript
 352
 353 =head1 SEE ALSO
 354
 355 L<perl>.  L<Tie::IxHash>, http://www.xs4all.nl/~ppk/js/dom.html,
 356 http://javascript.about.com/library/scripts/blsafeonload.htm
 357
 358 =cut