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