path: root/SelectLayers.pm

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