summaryrefslogtreecommitdiff
path: root/SelectLayers.pm
diff options
context:
space:
mode:
Diffstat (limited to 'SelectLayers.pm')
-rw-r--r--SelectLayers.pm336
1 files changed, 336 insertions, 0 deletions
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
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-15 04:24:17 +0000