SelectLayers.pm

   1 package HTML::Widgets::SelectLayers;
   2
   3 use strict;
   4 use vars qw($VERSION);
   5
   6 $VERSION = '0.02';
   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     'layer_callback' => sub {
  29       my $layer = shift;
  30       my $html = qq!<INPUT TYPE="hidden" NAME="layer" VALUE="$layer">!;
  31       $html .= $other_stuff;
  32       $html;
  33     },
  34   );
  35
  36   print '<FORM NAME=dummy>'.
  37         '<INPUT TYPE="text" NAME="textfield1">'.
  38         '<INPUT TYPE="text" NAME="textfield2">'.
  39         '<INPUT TYPE="checkbox" NAME="checkbox1" VALUE="Y">'.
  40         $widget->html;
  41
  42 =head1 DESCRIPTION
  43
  44 This module implements an HTML widget with multiple layers.  Only one layer
  45 is visible at any given time, controlled by a E<lt>SELECTE<gt> box.  For an
  46 example see http://www.420.am/selectlayers/
  47
  48 This HTML generated by this module uses JavaScript, but nevertheless attempts
  49 to be as cross-browser as possible, testing for features via DOM support rather
  50 than specific browsers or versions.  It has been tested under Mozilla 0.9.8,
  51 Netscape 4.77, IE 5.5, Konqueror 2.2.2, and Opera 5.0.
  52
  53 =head1 FORMS
  54
  55 Not all browsers seem happy with forms that span layers.  The generated HTML
  56 will have a E<lt>/FORME<gt> tag before the layers and will generate
  57 E<lt>FORME<gt> and E<lt>/FORME<gt> tags for each layer.  To facilitate
  58 E<lt>SUBMITE<gt> buttons located within the layers, you can pass a form name
  59 and element names, and the relevant values will be copied to the layer's form.
  60 See the B<form_> options below.
  61
  62 =head1 METHODS
  63
  64 =over 4
  65
  66 =item new KEY, VALUE, KEY, VALUE...
  67
  68 Options are passed as name/value pairs:
  69
  70 options - Hash reference of layers and labels for the E<lt>SELECTE<gt>.  See
  71           L<Tie::IxHash> to control ordering.
  72           In HTML: E<lt>OPTION VALUE="$layer"E<gt>$labelE<lt>/OPTIONE<gt>
  73
  74 layer_callback - subroutine reference to create each layer.  The layer name
  75                  is passed as an option in I<@_>
  76
  77 selected_layer - (optional) initially selected layer
  78
  79 form_name - (optional) Form name to copy values from.  If not supplied, no
  80             values will be copied.
  81
  82 form_action - Form action
  83
  84 form_text - (optional) Array reference of text (or hidden) form fields to copy
  85             from the B<form_name> form.
  86
  87 form_checkbox - (optional) Array reference of checkbox form fields to copy from
  88                 the B<form_name> form.
  89
  90 form_select - (optional) Array reference of select (not select multiple) form
  91               fields to copy from the B<form_name> form.
  92
  93 fixup_callback - (optional) subroutine reference, returns supplimentary
  94                  JavaScript for the function described above under FORMS.
  95
  96 size - (optional) size of the E<lt>SELECTE<gt>, default 1.
  97
  98 unique_key - (optional) prepended to all JavaScript function/variable/object
  99              names to avoid namespace collisions.
 100
 101 html_beween - (optional) HTML between the E<lt>SELECTE<gt> and the layers.
 102
 103 =cut
 104
 105 sub new {
 106   my($proto, %options) = @_;
 107   my $class = ref($proto) || $proto;
 108   my $self = \%options;
 109   bless($self, $class);
 110 }
 111
 112 =cut
 113
 114 =item html
 115
 116 Returns HTML for the widget.
 117
 118 =cut
 119
 120 sub html {
 121   my $self = shift;
 122   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 123   my $between = exists($self->{html_between}) ? $self->{html_between} : '';
 124   my $options = $self->{options};
 125   my $form_action = exists($self->{form_action}) ? $self->{form_action} : '';
 126   my $form_text =
 127     exists($self->{form_text}) ? $self->{form_text} : [];
 128   my $form_checkbox =
 129     exists($self->{form_checkbox}) ? $self->{form_checkbox} : [];
 130   my $form_select =
 131     exists($self->{form_select}) ? $self->{form_select} : [];
 132
 133   my $html = $self->_safeonload.
 134              $self->_visualize.
 135              "<SCRIPT>SafeAddOnLoad(${key}visualize)</SCRIPT>".
 136              $self->_changed.
 137              $self->_fixup.
 138              $self->_select. $between. '</FORM>';
 139
 140   #foreach my $layer ( 'konq_kludge', keys %$options ) {
 141   foreach my $layer ( keys %$options ) {
 142
 143     #start layer
 144     my $visibility = "hidden";
 145     $html .= <<END;
 146       <SCRIPT>
 147       if (document.getElementById) {
 148         document.write("<DIV ID=\\"${key}d$layer\\" STYLE=\\"visibility: $visibility; position: absolute\\">");
 149       } else {
 150 END
 151     $visibility="show" if $visibility eq "visible";
 152     $html .= <<END;
 153         document.write("<LAYER ID=\\"${key}l$layer\\" VISIBILITY=\\"$visibility\\">");
 154       }
 155       </SCRIPT>
 156 END
 157
 158     #form fields
 159     $html .= <<END;
 160       <FORM NAME="${key}$layer" ACTION="$form_action" METHOD=POST onSubmit="${key}fixup(this)">
 161 END
 162     foreach my $f ( @$form_text, @$form_checkbox, @$form_select ) {
 163       $html .= <<END;
 164         <INPUT TYPE="hidden" NAME="$f" VALUE="">
 165 END
 166     }
 167
 168     #layer
 169     $html .= &{$self->{layer_callback}}($layer);
 170
 171     #end form & layer
 172     $html .= <<END
 173       </FORM>
 174
 175       <SCRIPT>
 176       if (document.getElementById) {
 177         document.write("</DIV>");
 178       } else {
 179         document.write("</LAYER>");
 180       }
 181       </SCRIPT>
 182 END
 183
 184   }
 185
 186   $html;
 187 }
 188
 189 sub _fixup {
 190   my $self = shift;
 191   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 192   my $form_name = $self->{form_name} or return '';
 193   my $form_text =
 194     exists($self->{form_text}) ? $self->{form_text} : [];
 195   my $form_checkbox =
 196     exists($self->{form_checkbox}) ? $self->{form_checkbox} : [];
 197   my $form_select =
 198     exists($self->{form_select}) ? $self->{form_select} : [];
 199   my $html = "
 200     <SCRIPT>
 201     function ${key}fchanged(what) {
 202       ${key}fixup(what.form);
 203     }
 204     function ${key}fixup(what) {\n";
 205
 206   foreach my $f ( @$form_text ) {
 207     $html .= "what.$f.value = document.$form_name.$f.value;\n";
 208   }
 209
 210   foreach my $f ( @$form_checkbox ) {
 211     $html .= "if (document.$form_name.$f.checked)
 212                 what.$f.value = document.$form_name.$f.value;
 213               else
 214                 what.$f.value = '';\n"
 215   }
 216
 217   foreach my $f ( @$form_select ) {
 218     $html .= "what.$f.value = document.$form_name.$f.options[document.$form_name.$f.selectedIndex].value;\n";
 219   }
 220
 221   $html .= &{$self->{fixup_callback}}() if exists($self->{fixup_callback});
 222
 223   $html .= "}\n</SCRIPT>";
 224
 225   $html;
 226
 227 }
 228
 229 sub _select {
 230   my $self = shift;
 231   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 232   my $options = $self->{options};
 233   my $selected = exists($self->{selected_layer}) ? $self->{selected_layer} : '';
 234   my $size =  exists($self->{size}) ? $self->{size} : 1;
 235   my $html = "
 236     <SELECT NAME=\"${key}select\" SIZE=$size onChange=\"${key}changed(this);\">
 237   ";
 238   foreach my $option ( keys %$options ) {
 239     $html .= "<OPTION VALUE=\"$option\"";
 240     $html .= ' SELECTED' if $option eq $selected;
 241     $html .= '>'. $options->{$option}. '</OPTION>';
 242   }
 243   $html .= '</SELECT>';
 244 }
 245
 246 sub _changed {
 247   my $self = shift;
 248   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 249   my $options = $self->{options};
 250   my $html = "
 251     <SCRIPT>
 252     var ${key}layer = null;
 253     function ${key}changed(what) {
 254       ${key}layer = what.options[what.selectedIndex].value;\n";
 255   foreach my $layer ( keys %$options ) {
 256     $html .= "if (${key}layer == \"$layer\" ) {\n";
 257     foreach my $not ( grep { $_ ne $layer } keys %$options ) {
 258       $html .= "
 259         if (document.getElementById) {
 260           document.getElementById('${key}d$not').style.visibility = \"hidden\";
 261         } else {
 262           document.${key}l$not.visibility = \"hidden\";
 263         }\n";
 264     }
 265     $html .= "
 266       if (document.getElementById) {
 267         document.getElementById('${key}d$layer').style.visibility = \"visible\";
 268       } else {
 269         document.${key}l$layer.visibility = \"visible\";
 270       }
 271     }\n";
 272   }
 273   $html .= "}\n</SCRIPT>";
 274   $html;
 275 }
 276
 277 sub _visualize {
 278   my $self = shift;
 279   my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
 280   return '' unless exists($self->{selected_layer});
 281   my $selected = $self->{selected_layer};
 282   <<END;
 283 <SCRIPT>
 284 function ${key}visualize() {
 285   if (document.getElementById) {
 286     document.getElementById('${key}d$selected').style.visibility = "visible";
 287   } else {
 288     document.${key}l$selected.visibility = "visible";
 289   }
 290 }
 291 </SCRIPT>
 292 END
 293 }
 294
 295 sub _safeonload {
 296   <<END;
 297 <SCRIPT>
 298 var gSafeOnload = new Array();
 299 function SafeAddOnLoad(f) {
 300   if (window.onload) {
 301     if (window.onload != SafeOnload) {
 302       gSafeOnload[0] = window.onload;
 303       window.onload = SafeOnload;
 304     }
 305     gSafeOnload[gSafeOnload.length] = f;
 306   } else {
 307     window.onload = f;
 308   }
 309 }
 310 function SafeOnload()
 311 {
 312   for (var i=0;i<gSafeOnload.length;i++)
 313     gSafeOnload[i]();
 314 }
 315 </SCRIPT>
 316 END
 317 }
 318
 319 =back
 320
 321 =head1 AUTHOR
 322
 323 Ivan Kohler E<lt>ivan-selectlayers@420.amE<gt>
 324
 325 =head1 COPYRIGHT
 326
 327 Copyright (c) 2002 Ivan Kohler
 328 All rights reserved.
 329 This program is free software; you can redistribute it and/or modify it under
 330 the same terms as Perl itself.
 331
 332 =head1 BUGS
 333
 334 JavaScript
 335
 336 =head1 SEE ALSO
 337
 338 L<perl>.  L<Tie::IxHash>, http://www.xs4all.nl/~ppk/js/dom.html,
 339 http://javascript.about.com/library/scripts/blsafeonload.htm
 340
 341 =cut