initial importHTML_Widgets_SelectLayers_0_01BEGIN

8 files changed, 596 insertions, 0 deletions

diff --git a/Changes b/Changes
new file mode 100644
index 0000000..6bda248
--- /dev/null
+++ b/Changes
@@ -0,0 +1,6 @@
+Revision history for Perl extension HTML::Widgets::SelectLayers.
+
+0.01  Thu Mar  7 04:36:46 2002
+	- original version; created by h2xs 1.21 with options
+		-A -X -n HTML::Widgets::SelectLayers
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..a7fc9d8
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,8 @@
+Changes
+Makefile.PL
+MANIFEST
+MANIFEST.SKIP
+README
+SelectLayers.pm
+test.pl
+homepage.pl
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..ae335e7
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1 @@
+CVS/
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..9bc7d50
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    'NAME'		=> 'HTML::Widgets::SelectLayers',
+    'VERSION_FROM'	=> 'SelectLayers.pm', # finds $VERSION
+    'PREREQ_PM'		=> {}, # e.g., Module::Name => 1.1
+    ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM => 'SelectLayers.pm', # retrieve abstract from module
+       AUTHOR     => 'Ivan Kohler <ivan-selectlayers@420.am>') : ()),
+);
diff --git a/README b/README
new file mode 100644
index 0000000..e2fed72
--- /dev/null
+++ b/README
@@ -0,0 +1,28 @@
+HTML::Widgets::SelectLayers version 0.01
+========================================
+
+This module implements an HTML widget with multiple layers.  Only one layer
+is visible at any given time, controlled by a <SELECT> 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.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+COPYRIGHT AND LICENCE
+
+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.
+
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
diff --git a/homepage.pl b/homepage.pl
new file mode 100755
index 0000000..7e112d2
--- /dev/null
+++ b/homepage.pl
@@ -0,0 +1,189 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Tie::IxHash;
+use HTML::Widgets::SelectLayers;
+
+tie my %o, 'Tie::IxHash',
+  'download'     => 'Download',
+  'installation' => 'Installation',
+  'compatibility' => 'Compatibility',
+  'documentation' => 'Documentation',
+  'cvs' => 'Anonymous CVS access',
+;
+
+my %html = (
+
+  'download' => '<A HREF="HTML-Widgets-SelectLayers-0.01.tar.gz">Download HTML-Widgets-SelectLayers-0.01.tar.gz</a>',
+
+  'installation' => '<PRE>
+  perl Makefile.PL
+  make
+  make test
+  make install
+</PRE>',
+
+'cvs' => '<PRE>
+Anonymous CVS access is available:
+  $ export CVSROOT=":pserver:anonymous@cleanwhisker.420.am:/home/cvs/cvsroot"
+  $ cvs login
+  (Logging in to anonymous@cleanwhisker.420.am
+  CVS password: anonymous
+  $ cvs checkout DBIx-DBSchema
+as well as <A HREF="http://www.420.am/cgi-bin/cvsweb/HTML-Widgets-SelectLayers">browsable via cvsweb</A>.
+</PRE>',
+
+'documentation' => join('',<DATA>),
+
+'compatibility' => '<PRE>
+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.
+</PRE>',
+
+);
+close DATA;
+
+my $w = new HTML::Widgets::SelectLayers(
+  'options' => \%o,
+  'selected_layer' => 'download',
+  'layer_callback' => sub {
+    my $layer = shift;
+    "<BR>". $html{$layer};
+  },
+  #'form_action'    => '',
+  #'form_text' => [],
+  #'form_checkbox' => [],
+);
+
+print <<END, $w->html, "</BODY></HTML>\n";
+<HTML>
+<HEAD>
+<TITLE>HTML::Widgets::SelectLayers - selectable HTML layers</TITLE>
+</HEAD>
+<BODY>
+<PRE>
+HTML::Widgets::SelectLayers
+
+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.
+
+This module implements an HTML widget with multiple layers.  Only one layer
+is visible at any given time, controlled by a &lt;SELECT&gt; box.  For an example
+see below.
+
+</PRE>
+<FORM NAME="dummy">
+END
+
+__DATA__
+<HR>
+<P>
+<H1><A NAME="name">NAME</A></H1>
+<P>HTML::Widgets::SelectLayers - Perl extension for selectable HTML layers</P>
+<P>
+<HR>
+<H1><A NAME="synopsis">SYNOPSIS</A></H1>
+<PRE>
+  use HTML::Widgets::SelectLayers;</PRE>
+<PRE>
+  use Tie::IxHash;
+  tie my %options, 'Tie::IxHash',
+    'value'  =&gt; 'Select One',
+    'value2' =&gt; 'Select Two',
+  ;</PRE>
+<PRE>
+  $widget = new HTML::Widgets::SelectLayers(
+    'options'       =&gt; \%options,
+    'form_name'     =&gt; 'dummy',
+    'form_actoin'   =&gt; 'process.cgi',
+    'form_text'     =&gt; [ qw( textfield1 textfield2 ) ],
+    'form_checkbox' =&gt; [ qw( checkbox1 ) ],
+    'layer_callback' =&gt; sub {
+      my $layer = shift;
+      my $html = qq!&lt;INPUT TYPE=&quot;hidden&quot; NAME=&quot;layer&quot; VALUE=&quot;$layer&quot;&gt;!;
+      $html .= $other_stuff;
+      $html;
+    },
+  );</PRE>
+<PRE>
+  print '&lt;FORM NAME=dummy&gt;'.
+        '&lt;INPUT TYPE=&quot;text&quot; NAME=&quot;textfield1&quot;&gt;'.
+        '&lt;INPUT TYPE=&quot;text&quot; NAME=&quot;textfield2&quot;&gt;'.
+        '&lt;INPUT TYPE=&quot;checkbox&quot; NAME=&quot;checkbox1&quot; VALUE=&quot;Y&quot;&gt;'.
+        $widget-&gt;html;</PRE>
+<P>
+<HR>
+<H1><A NAME="description">DESCRIPTION</A></H1>
+<P>This module implements an HTML widget with multiple layers.  Only one layer
+is visible at any given time, controlled by a &lt;SELECT&gt; box.  For an
+example see <A HREF="http://www.420.am/selectlayers/">http://www.420.am/selectlayers/</A></P>
+<P>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.</P>
+<P>
+<HR>
+<H1><A NAME="forms">FORMS</A></H1>
+<P>Not all browsers seem happy with forms that span layers.  The generated HTML
+will have a &lt;/FORM&gt; tag before the layers and will generate
+&lt;FORM&gt; and &lt;/FORM&gt; tags for each layer.  To facilitate
+&lt;SUBMIT&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 <STRONG>form_</STRONG> options below.</P>
+<P>
+<HR>
+<H1><A NAME="methods">METHODS</A></H1>
+<DL>
+<DT><STRONG><A NAME="item_new_KEY%2C_VALUE%2C_KEY%2C_VALUE%2E%2E%2E">new KEY, VALUE, KEY, VALUE...</A></STRONG><BR>
+<DD>
+Options are passed as name/value pairs:
+<P>options - Hash reference of layers and labels for the &lt;SELECT&gt;.  See
+          <A HREF="http://search.cpan.org/doc/GSAR/Tie-IxHash-1.21/lib/Tie/IxHash.pm">the Tie::IxHash manpage</A> to control ordering.
+          In HTML: &lt;OPTION VALUE=``$layer''&gt;$label&lt;/OPTION&gt;</P>
+<P>layer_callback - subroutine reference to create each layer.  The layer name
+                 is passed as an option in <EM>@_</EM></P>
+<P>selected_layer - (optional) initially selected layer</P>
+<P>form_name - (optional) Form name to copy values from.  If not supplied, no
+            values will be copied.</P>
+<P>form_action - Form action</P>
+<P>form_text - (optional) Array reference of text (or hidden) form fields to copy
+            from the <STRONG>form_name</STRONG> form.</P>
+<P>form_checkbox - (optional) Array reference of checkbox form fields to copy from
+                the <STRONG>form_name</STRONG> form.</P>
+<P>fixup_callback - (optional) subroutine reference, returns supplimentary
+                 JavaScript for the function described above under FORMS.</P>
+<P>#form_select</P>
+<P>size - (optional) size of the &lt;SELECT&gt;, default 1.</P>
+<P>unique_key - (optional) prepended to all JavaScript function/variable/object
+             names to avoid namespace collisions.</P>
+<P>html_beween - (optional) HTML between the &lt;SELECT&gt; and the layers.</P>
+<P></P>
+<DT><STRONG><A NAME="item_html">html</A></STRONG><BR>
+<DD>
+Returns HTML for the widget.
+<P></P></DL>
+<P>
+<HR>
+<H1><A NAME="author">AUTHOR</A></H1>
+<P>Ivan Kohler &lt;<A HREF="mailto:ivan-selectlayers@420.am">ivan-selectlayers@420.am</A>&gt;</P>
+<P>
+<HR>
+<H1><A NAME="copyright">COPYRIGHT</A></H1>
+<P>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.</P>
+<P>
+<HR>
+<H1><A NAME="bugs">BUGS</A></H1>
+<P>JavaScript</P>
+<P>
+<HR>
+<H1><A NAME="see also">SEE ALSO</A></H1>
+<P><EM>perl</EM>.  <A HREF="http://search.cpan.org/doc/GSAR/Tie-IxHash-1.21/lib/Tie/IxHash.pm">the Tie::IxHash manpage</A>, <A HREF="http://www.xs4all.nl/~ppk/js/dom.html">http://www.xs4all.nl/~ppk/js/dom.html</A>,
+<A HREF="http://javascript.about.com/library/scripts/blsafeonload.htm">http://javascript.about.com/library/scripts/blsafeonload.htm</A></P>
+
diff --git a/test.pl b/test.pl
new file mode 100644
index 0000000..9d970e0
--- /dev/null
+++ b/test.pl
@@ -0,0 +1,17 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test;
+BEGIN { plan tests => 1 };
+use HTML::Widgets::SelectLayers;
+ok(1); # If we made it this far, we're ok.
+
+#########################
+
+# Insert your test code below, the Test module is use()ed here so read
+# its man page ( perldoc Test ) for help writing this test script.
+