~ubuntu-branches/ubuntu/saucy/libhtml-widgets-selectlayers-perl/saucy

package HTML::Widgets::SelectLayers;

use strict;
use vars qw($VERSION);

$VERSION = '0.07';

=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_action'   => 'process.cgi',

    #new code auto-detects form types (radio not yet supported)
    #'form_elements' => [ qw( textfield1 textfield2 checkbox1 radio1 select1 ) ],
    'form_elements' => [ qw( textfield1 textfield2 checkbox1 radio1 select1 ) ],
    
    #deprecated style still works for now
    #'form_text'     => [ qw( textfield1 textfield2 ) ],
    #'form_checkbox' => [ qw( checkbox1 ) ],
    #'form_radio'    => [ qw( radio1 ) ],
    #'form_select'   => [ qw( select1 ) ],

    'layer_callback' => sub {
      my $layer = shift;
      my $html = qq!<INPUT TYPE="hidden" NAME="layer" VALUE="$layer">!;
      $html .= $other_stuff;
      $html;
    },
  );

  print '<FORM NAME=dummy STYLE="margin-top: 0; margin-bottom: 0">'.
        '<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.  The 0.05 release drops Navigator 4
compatibility and has been tested under Mozilla Firefox 1.0.6, MSIE 6.0, 
Konqueror 3.3.2, and Opera 8.0.2 (2006 note: still working under newer
browsers such as IE7, Firefox 2.0, etc.).

=head1 FORMS

My understanding is that forms cannot span E<lt>DIVE<gt>s elements.  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_elements - (optional) Array reference of form fields to copy from the
                B<form_name> form.  Field type is autodetected; currently
                text, hidden, checkbox, and select fields are
                supported.  Radio fields are not yet supported.

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.

form_radio - (optional) Array reference of radio form fields to copy from the
             B<form_name> form.

form_select - (optional) Array reference of select 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.

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.

under_position - (optional) specifies the positioning of any HTML appearing after the widget.  I<static>, the default, positions subsequent HTML underneath the current layer (or immediately under the select box if no layer has yet been selected), reflowing when layers are changed.  I<absolute> calculates the size of the largest layer and keeps the subsequent HTML in a single position underneath it.  Note that I<absolute> works by positioning subsequent HTML in a E<lt>DIVE<gt>, so you should probably close it yourself with a E<lt>/DIVE<gt> before your E<lt>/HTMLE<gt> end tag.  I<absolute> is a bit experimental and might have some quirks with truncating the end of the page under IE; you might have better results by just making all your layers the exact same size at the moment.

=cut

sub new {
  my($proto, %options) = @_;
  my $class = ref($proto) || $proto;
  my $self = \%options;
  bless($self, $class);
}

=pod

=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_elements =
    exists($self->{form_elements}) ? $self->{form_elements} : [];
  my $form_text =
    exists($self->{form_text}) ? $self->{form_text} : [];
  my $form_checkbox =
    exists($self->{form_checkbox}) ? $self->{form_checkbox} : [];
  my $form_radio =
    exists($self->{form_radio}) ? $self->{form_radio} : [];
  my $form_select =
    exists($self->{form_select}) ? $self->{form_select} : [];

  my $under_position = 
    exists($self->{under_position}) ? $self->{under_position} : 'static';
  my $hidden = lc($under_position) eq 'absolute'
                 ? 'visibility: hidden; position: absolute; z-index: 0'
                 : 'display: none; z-index: 0';
  #my $show = lc($under_position) eq 'absolute'
  #             ? 'visibility: visible'
  #             : 'display: "" ';

  my $html = $self->_safeonload.
             $self->_visualize.
             "<SCRIPT>SafeAddOnLoad(${key}visualize)</SCRIPT>".
             $self->_changed.
             $self->_fixup.
             $self->_select. $between. '</FORM>'.
             "<SCRIPT>var ${key}maxHeight = 0;</SCRIPT>";

  #foreach my $layer ( 'konq_kludge', keys %$options ) {
  foreach my $layer ( keys %$options ) {

    #start layer

    $html .= <<END;
      <DIV ID="${key}d$layer" STYLE="$hidden">
END

    #form fields
    $html .= <<END;
      <FORM NAME="${key}$layer" ACTION="$form_action" METHOD=POST onsubmit="${key}fixup(this)" STYLE="margin-top: 0; margin-bottom: 0">
END
    foreach my $f ( @$form_elements, @$form_text, @$form_checkbox, @$form_radio, @$form_select )
    {
      $html .= <<END;
        <INPUT TYPE="hidden" NAME="$f" VALUE="">
END
    }

    #layer
    $html .= &{$self->{layer_callback}}($layer);

    #end form & layer
    $html .= <<END
      </FORM>
      </DIV>
      <SCRIPT>
        if ( document.getElementById('${key}d$layer').offsetHeight > ${key}maxHeight )
          ${key}maxHeight = document.getElementById('${key}d$layer').offsetHeight;
      </SCRIPT>
END

  }

  if ( $under_position eq 'absolute' ) {
    $html .= <<END;
      <SCRIPT>
        //var max = ${key}maxHeight;
        document.write("<DIV STYLE=\\\"position:relative; top: " + ${key}maxHeight + "px\\\">");
      </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_elements =
    exists($self->{form_elements}) ? $self->{form_elements} : [];
  my $form_text =
    exists($self->{form_text}) ? $self->{form_text} : [];
  my $form_checkbox =
    exists($self->{form_checkbox}) ? $self->{form_checkbox} : [];
  my $form_radio =
    exists($self->{form_radio}) ? $self->{form_radio} : [];
  my $form_select =
    exists($self->{form_select}) ? $self->{form_select} : [];
  my $html = <<END;
    <SCRIPT>

function copyelement(from, to) {
  if ( from.type == undefined ) {
    to.value = '';
  } else if ( from.type == 'select-one' ) {
    to.value = from.options[from.selectedIndex].value;
    //alert(from + " (" + from.type + "): " + to.name + " => (" + from.selectedIndex + ") " + to.value);
  } else if ( from.type == 'select-multiple' ) {
    var i = 0;
    var count = 0;
    var values = new Array();
    for (i=0;i<from.length;i++) {
      if (from.options[i].selected){
        values[count++] = from.options[i].value;
      }
    }
    for (i=0;i<values.length-1;i++) {
      var clone = to.cloneNode(true);
      clone.value = values[i];
      to.form.appendChild(clone);
    }
    if (count > 0) {
      to.value = values[values.length-1];
    }else{
      to.value = '';
    }
  } else if ( from.type == 'checkbox' ) {
    if ( from.checked ) {
      to.value = from.value;
    } else {
      to.value = '';
    }
//  } else if ( from.type == 'radio' ) {
  } else {
    if ( from.value == undefined ) {
      to.value = '';
    } else {
      to.value = from.value;
    }
  }
  //alert(from + " (" + from.type + "): " + to.name + " => " + to.value);
}
END

  $html .= "
    //function ${key}fchanged(what) {
    //  ${key}fixup(what.form);
    //}
    function ${key}fixup(what) {\n";

  foreach my $f ( @$form_elements ) {
    $html .= "copyelement( document.$form_name.elements['$f'],
                           what.elements['$f']
                         )\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_radio ) {
    $html .= "what.$f.value = '';
              for ( i=0; i< document.$form_name.$f.length; i++ )
                if ( document.$form_name.$f\[i].checked )
                  what.$f.value = document.$form_name.$f\[i].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 .= qq(<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 $under_position = 
    exists($self->{under_position}) ? $self->{under_position} : 'static';

  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 .= qq(  if (${key}layer == "$layer" ) {\n);
    foreach my $not ( grep { $_ ne $layer } keys %$options ) {
      my $element_style = "document.getElementById('${key}d$not').style";
      if ( $under_position eq 'absolute' ) {
        $html .= qq(  $element_style.visibility = "hidden";\n);
      } else {
        $html .= qq(  $element_style.display = "none";\n);
      }
      $html .= qq(  $element_style.zIndex = 0;\n);
    }
    my $element_style = "document.getElementById('${key}d$layer').style";
    if ( $under_position eq 'absolute' ) {
      $html .= qq(  $element_style.visibility = "visible";\n);
    } else {
      $html .= qq(  $element_style.display = "";\n);
    }
    $html .= qq(  $element_style.zIndex = 1;\n);
    $html .= "  }\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};
  my $under_position = 
    exists($self->{under_position}) ? $self->{under_position} : 'static';
  my $display = ( $under_position eq 'absolute' )
                  ? 'visibility = "visible"'
                  : 'display = ""';
  <<END;
<SCRIPT>
function ${key}visualize() {
  document.getElementById('${key}d$selected').style.$display;
  document.getElementById('${key}d$selected').style.zIndex = 1;
}
</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-2005 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

All the different form_* options are unnecessary, could use .type to auto-sense

Could give you a function or something for copying variables out of the
layered forms.

=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