SelectLayers.pm

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