From 25743a94d01bed5db01be7eebfdbd543a63e6a3e Mon Sep 17 00:00:00 2001
From: ivan <ivan>
Date: Tue, 12 Mar 2002 14:51:45 +0000
Subject: initial import

---
 SelectLayers.pm | 336 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 336 insertions(+)
 create mode 100644 SelectLayers.pm

(limited to 'SelectLayers.pm')

diff --git a/SelectLayers.pm b/SelectLayers.pm
new file mode 100644
index 0000000..7cef104
--- /dev/null
+++ b/SelectLayers.pm
@@ -0,0 +1,336 @@
+package HTML::Widgets::SelectLayers;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = '0.01';
+
+=head1 NAME
+
+HTML::Widgets::SelectLayers - Perl extension for selectable HTML layers
+
+=head1 SYNOPSIS
+
+  use HTML::Widgets::SelectLayers;
+
+  use Tie::IxHash;
+  tie my %options, 'Tie::IxHash',
+    'value'  => 'Select One',
+    'value2' => 'Select Two',
+  ;
+
+  $widget = new HTML::Widgets::SelectLayers(
+    'options'       => \%options,
+    'form_name'     => 'dummy',
+    'form_actoin'   => 'process.cgi',
+    'form_text'     => [ qw( textfield1 textfield2 ) ],
+    'form_checkbox' => [ qw( checkbox1 ) ],
+    'layer_callback' => sub {
+      my $layer = shift;
+      my $html = qq!<INPUT TYPE="hidden" NAME="layer" VALUE="$layer">!;
+      $html .= $other_stuff;
+      $html;
+    },
+  );
+
+  print '<FORM NAME=dummy>'.
+        '<INPUT TYPE="text" NAME="textfield1">'.
+        '<INPUT TYPE="text" NAME="textfield2">'.
+        '<INPUT TYPE="checkbox" NAME="checkbox1" VALUE="Y">'.
+        $widget->html;
+
+=head1 DESCRIPTION
+
+This module implements an HTML widget with multiple layers.  Only one layer
+is visible at any given time, controlled by a E<lt>SELECTE<gt> box.  For an
+example see http://www.420.am/selectlayers/
+
+This HTML generated by this module uses JavaScript, but nevertheless attempts
+to be as cross-browser as possible, testing for features via DOM support rather
+than specific browsers or versions.  It has been tested under Mozilla 0.9.8,
+Netscape 4.77, IE 5.5, Konqueror 2.2.2, and Opera 5.0.
+
+=head1 FORMS
+
+Not all browsers seem happy with forms that span layers.  The generated HTML
+will have a E<lt>/FORME<gt> tag before the layers and will generate
+E<lt>FORME<gt> and E<lt>/FORME<gt> tags for each layer.  To facilitate
+E<lt>SUBMITE<gt> buttons located within the layers, you can pass a form name
+and element names, and the relevant values will be copied to the layer's form.
+See the B<form_> options below.
+
+=head1 METHODS
+
+=over 4
+
+=item new KEY, VALUE, KEY, VALUE...
+
+Options are passed as name/value pairs:
+
+options - Hash reference of layers and labels for the E<lt>SELECTE<gt>.  See
+          L<Tie::IxHash> to control ordering.
+          In HTML: E<lt>OPTION VALUE="$layer"E<gt>$labelE<lt>/OPTIONE<gt>
+
+layer_callback - subroutine reference to create each layer.  The layer name
+                 is passed as an option in I<@_>
+
+selected_layer - (optional) initially selected layer
+
+form_name - (optional) Form name to copy values from.  If not supplied, no
+            values will be copied.
+
+form_action - Form action
+
+form_text - (optional) Array reference of text (or hidden) form fields to copy
+            from the B<form_name> form.
+
+form_checkbox - (optional) Array reference of checkbox form fields to copy from
+                the B<form_name> form.
+
+fixup_callback - (optional) subroutine reference, returns supplimentary
+                 JavaScript for the function described above under FORMS.
+
+#form_select
+
+size - (optional) size of the E<lt>SELECTE<gt>, default 1.
+
+unique_key - (optional) prepended to all JavaScript function/variable/object
+             names to avoid namespace collisions.
+
+html_beween - (optional) HTML between the E<lt>SELECTE<gt> and the layers.
+
+=cut
+
+sub new {
+  my($proto, %options) = @_;
+  my $class = ref($proto) || $proto;
+  my $self = \%options;
+  bless($self, $class);
+}
+
+=cut
+
+=item html
+
+Returns HTML for the widget.
+
+=cut
+
+sub html {
+  my $self = shift;
+  my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
+  my $between = exists($self->{html_between}) ? $self->{html_between} : '';
+  my $options = $self->{options};
+  my $form_action = exists($self->{form_action}) ? $self->{form_action} : '';
+  my $form_text =
+    exists($self->{form_text}) ? $self->{form_text} : [];
+  my $form_checkbox =
+    exists($self->{form_checkbox}) ? $self->{form_checkbox} : [];
+
+  my $html = $self->_safeonload.
+             $self->_visualize.
+             "<SCRIPT>SafeAddOnLoad(${key}visualize)</SCRIPT>".
+             $self->_changed.
+             $self->_fixup.
+             $self->_select. $between. '</FORM>';
+
+  #foreach my $layer ( 'konq_kludge', keys %$options ) {
+  foreach my $layer ( keys %$options ) {
+
+    #start layer
+    my $visibility = "hidden";
+    $html .= <<END;
+      <SCRIPT>
+      if (document.getElementById) {
+        document.write("<DIV ID=\\"${key}d$layer\\" STYLE=\\"visibility: $visibility; position: absolute\\">");
+      } else {
+END
+    $visibility="show" if $visibility eq "visible";
+    $html .= <<END;
+        document.write("<LAYER ID=\\"${key}l$layer\\" VISIBILITY=\\"$visibility\\">");
+      }
+      </SCRIPT>
+END
+
+    #form fields
+    $html .= <<END;
+      <FORM NAME="${key}$layer" ACTION="$form_action" METHOD=POST onSubmit="${key}fixup(this)">
+END
+    foreach my $f ( @$form_text, @$form_checkbox ) {
+      $html .= <<END;
+        <INPUT TYPE="hidden" NAME="$f" VALUE="">
+END
+    }
+
+    #layer
+    $html .= &{$self->{layer_callback}}($layer);
+
+    #end form & layer
+    $html .= <<END
+      </FORM>
+
+      <SCRIPT>
+      if (document.getElementById) {
+        document.write("</DIV>");
+      } else {
+        document.write("</LAYER>");
+      }
+      </SCRIPT>
+END
+
+  }
+
+  $html;
+}
+
+sub _fixup {
+  my $self = shift;
+  my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
+  my $form_name = $self->{form_name} or return '';
+  my $form_text =
+    exists($self->{form_text}) ? $self->{form_text} : [];
+  my $form_checkbox =
+    exists($self->{form_checkbox}) ? $self->{form_checkbox} : [];
+  my $html = "
+    <SCRIPT>
+    function ${key}fchanged(what) {
+      ${key}fixup(what.form);
+    }
+    function ${key}fixup(what) {\n";
+
+  foreach my $f ( @$form_text ) {
+    $html .= "what.$f.value = document.$form_name.$f.value;\n";
+  }
+
+  foreach my $f ( @$form_checkbox ) {
+    $html .= "if (document.$form_name.$f.checked)
+                what.$f.value = document.$form_name.$f.value;
+              else
+                what.$f.value = '';\n"
+  }
+
+#  foreach my $f ( @$form_select ) {
+#    $html .= "what.$f.value = document.$form_name.$f.options[document.$form_name.$f.selectedIndex].value;\n";
+#  }
+
+  $html .= &{$self->{fixup_callback}}() if exists($self->{fixup_callback});
+
+  $html .= "}\n</SCRIPT>";
+
+  $html;
+
+}
+
+sub _select {
+  my $self = shift;
+  my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
+  my $options = $self->{options};
+  my $selected = exists($self->{selected_layer}) ? $self->{selected_layer} : '';
+  my $size =  exists($self->{size}) ? $self->{size} : 1;
+  my $html = "
+    <SELECT NAME=\"${key}select\" SIZE=$size onChange=\"${key}changed(this);\">
+  ";
+  foreach my $option ( keys %$options ) {
+    $html .= "<OPTION VALUE=\"$option\"";
+    $html .= ' SELECTED' if $option eq $selected;
+    $html .= '>'. $options->{$option}. '</OPTION>';
+  }
+  $html .= '</SELECT>';
+}
+
+sub _changed {
+  my $self = shift;
+  my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
+  my $options = $self->{options};
+  my $html = "
+    <SCRIPT>
+    var ${key}layer = null;
+    function ${key}changed(what) {
+      ${key}layer = what.options[what.selectedIndex].value;\n";
+  foreach my $layer ( keys %$options ) {
+    $html .= "if (${key}layer == \"$layer\" ) {\n";
+    foreach my $not ( grep { $_ ne $layer } keys %$options ) {
+      $html .= "
+        if (document.getElementById) {
+          document.getElementById('${key}d$not').style.visibility = \"hidden\";
+        } else {
+          document.${key}l$not.visibility = \"hidden\";
+        }\n";
+    }
+    $html .= "
+      if (document.getElementById) {
+        document.getElementById('${key}d$layer').style.visibility = \"visible\";
+      } else {
+        document.${key}l$layer.visibility = \"visible\";
+      }
+    }\n";
+  }
+  $html .= "}\n</SCRIPT>";
+  $html;
+}
+
+sub _visualize {
+  my $self = shift;
+  my $key = exists($self->{unique_key}) ? $self->{unique_key} : '';
+  return '' unless exists($self->{selected_layer});
+  my $selected = $self->{selected_layer};
+  <<END;
+<SCRIPT>
+function ${key}visualize() {
+  if (document.getElementById) {
+    document.getElementById('${key}d$selected').style.visibility = "visible";
+  } else {
+    document.${key}l$selected.visibility = "visible";
+  }
+}
+</SCRIPT>
+END
+}
+
+sub _safeonload {
+  <<END;
+<SCRIPT>
+var gSafeOnload = new Array();
+function SafeAddOnLoad(f) {
+  if (window.onload) {
+    if (window.onload != SafeOnload) {
+      gSafeOnload[0] = window.onload;
+      window.onload = SafeOnload;
+    }  
+    gSafeOnload[gSafeOnload.length] = f;
+  } else {
+    window.onload = f;
+  }
+}
+function SafeOnload()
+{
+  for (var i=0;i<gSafeOnload.length;i++)
+    gSafeOnload[i]();
+}
+</SCRIPT>
+END
+}
+
+=back
+
+=head1 AUTHOR
+
+Ivan Kohler E<lt>ivan-selectlayers@420.amE<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2002 Ivan Kohler
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+JavaScript
+
+=head1 SEE ALSO
+
+L<perl>.  L<Tie::IxHash>, http://www.xs4all.nl/~ppk/js/dom.html,
+http://javascript.about.com/library/scripts/blsafeonload.htm
+
+=cut
-- 
cgit v1.2.1