lib/CGI/Toggle.pm

   1 package CGI::Toggle;
   2
   3 use strict;
   4 use base 'Exporter';
   5 use CGI 'div','span','img','url';
   6
   7 our @EXPORT = ('toggle_section',
   8                'start_html');
   9
  10 use constant PLUS    => 'plus.png';
  11 use constant MINUS   => 'minus.png';
  12 use constant JS      => 'toggle.js';
  13 use constant XCOOK   => 'x_cook.js';
  14
  15 my $image_dir = '/gbrowse/images/buttons';
  16 my $js_dir    = '/gbrowse/js';
  17
  18 my $cookie_name = __PACKAGE__;
  19 $cookie_name    =~ s/:/_/g;
  20
  21 my $style = <<'END';
  22 .el_hidden  {display:none}
  23 .el_visible {display:inline}
  24 .ctl_hidden {
  25              cursor:hand;
  26              display:none;
  27             }
  28 .ctl_visible {
  29              cursor:hand;
  30              display:inline;
  31             }
  32 .tctl      {  text-decoration:underline; }
  33 END
  34
  35 sub start_html {
  36   my %args = @_ == 1 ? (-title=>shift) : @_;
  37
  38   $image_dir           = $args{-gbrowse_images} if defined $args{-gbrowse_images};
  39   $js_dir              = $args{-gbrowse_js}     if defined $args{-gbrowse_js};
  40
  41   delete $args{-gbrowse_images};
  42   delete $args{-gbrowse_js};
  43
  44   # earlier versions of CGI.pm don't support multiple -style and -script args.
  45   if ($CGI::VERSION >= 3.05) {
  46     if ($args{-style}) {
  47       $args{-style}= [{src => $args{-style}}] if !ref $args{-style};
  48       $args{-style}= [$args{-style}]          if ref $args{-style} && ref $args{-style} ne 'ARRAY';
  49     }
  50     push @{$args{-style}},{code=>$style};
  51
  52     if ($args{-script}) {
  53       $args{-script} = [{src => $args{-script}}] if !ref $args{-script};
  54       $args{-script} = [$args{-script}]          if ref $args{-script} && ref $args{-script} ne 'ARRAY';
  55     }
  56
  57     push @{$args{-script}},{src=>"$js_dir/".JS};
  58     push @{$args{-script}},{src=>"$js_dir/".XCOOK};
  59   }
  60
  61   my $result = CGI::start_html(%args);
  62
  63   if ($CGI::VERSION < 3.05) {
  64     my $style_section  = join '',$CGI::Q->_style({code=>$style});
  65     my $script_section = join '',$CGI::Q->_script({src=>"$js_dir/".JS});
  66     $result =~ s/<\/head>/$style_section\n$script_section\n<\/head>/i;
  67   }
  68
  69   return $result;
  70 }
  71
  72 # The weird playing around with class names is to accomodate the need to have
  73 # a default setting of visibility that can be overridden by a stored cookie.
  74 sub toggle_section {
  75   my %config = ref $_[0] eq 'HASH' ? %{shift()} : ();
  76   my ($name,$section_title,@section_body) = @_;
  77   my $visible = $config{on};
  78
  79   my $plus  = $config{plus_img}  || "$image_dir/".PLUS;
  80   my $minus = $config{minus_img} || "$image_dir/".MINUS;
  81
  82   my $show_ctl = div({-id=>"${name}_show",
  83                        -class=>'ctl_hidden',
  84                        -style=>$visible ? 'display:none' : 'display:inline',
  85                        -onClick=>"visibility('$name',1)"
  86                      },
  87                      img({-src=>$plus,-alt=>'+'}).'&nbsp;'.span({-class=>'tctl'},$section_title));
  88   my $hide_ctl = div({-id=>"${name}_hide",
  89                        -class=>'ctl_visible',
  90                        -style=>$visible ? 'display:inline' : 'display:none',
  91                        -onClick=>"visibility('$name',0)"
  92                      },
  93                      img({-src=>$minus,-alt=>'-'}).'&nbsp;'.span({-class=>'tctl'},$section_title));
  94   my $content  = div({-id    => $name,
  95                       -style=>$visible ? 'display:inline' : 'display:none',
  96                       -class => 'el_visible'},
  97                      @section_body);
  98   my @result = $config{nodiv} ? ($show_ctl.$hide_ctl,$content) : div(($show_ctl.$hide_ctl,$content));
  99
 100   return wantarray ? @result : "@result";
 101 }
 102
 103 1;
 104
 105 __END__
 106
 107 =head1 NAME
 108
 109 CGI::Toggle -- Utility methods for collapsible sections
 110
 111 =head1 SYNOPSIS
 112
 113 use CGI ':standard';
 114 use CGI::Toggle
 115
 116 print header(),
 117   start_html('Toggle Test'),
 118   h1("Toggle Test"),
 119   toggle_section({on=>1},p('This section is on by default'),
 120   toggle_section({on=>0},p('This section is off by default'),
 121   toggle_section({plus_img=>'/icons/open.png',
 122                   minus_img=>'/icons/close.png'},
 123                  p('This section has custom open and close icons.')),
 124   hr,
 125   end_html;
 126
 127 =head1 DESCRIPTION
 128
 129 This package adds JavaScript-based support for collapsible sections by
 130 adding a single new function toggle_section().
 131
 132 It overrides the CGI start_html() method, so CGI must be imported
 133 before bringing this module in.
 134
 135 =head2 METHODS
 136
 137 =over 4
 138
 139 =item ($control,$content) = toggle_section([\%options],$section_title=>@section_content)
 140
 141 This method takes an optional \%options hashref, a section title and
 142 one or more strings containing the section content and returns a list
 143 of HTML fragments corresponding to the control link and the content.
 144 In a scalar context the control and content will be concatenated
 145 together.
 146
 147 The option keys are as follows:
 148
 149 =over 4
 150
 151 =item b<on>
 152
 153 If true, the section will be on (visible) by default.  The default is
 154 false (collapsed).
 155
 156 =item b<plus_img>
 157
 158 URL of the icon to display next to the section title when the section
 159 is collapsed.  The default is /gbrowse/images/plus.png.
 160
 161 =item b<minus_img>
 162
 163 URL of the icon to display next to the section title when the section
 164 is expanded..  The default is /gbrowse/images/minus.png.
 165
 166 =item b<override>
 167
 168 If false (default), the state of the section will be remembered in a
 169 cookie.  If true, the initial state will be taken from the b<on>
 170 option, ignoring the cookie (which will, however, still be generated).
 171
 172 =back
 173
 174 =back
 175
 176
 177 =head1 SEE ALSO
 178
 179 L<CGI>
 180
 181 =head1 AUTHOR
 182
 183 Lincoln Stein E<lt>lstein@cshl.orgE<gt>.
 184
 185 Copyright (c) 2005 Cold Spring Harbor Laboratory
 186
 187 This library is free software; you can redistribute it and/or modify
 188 it under the same terms as Perl itself.  See DISCLAIMER.txt for
 189 disclaimers of warranty.
 190
 191 The xGetCookie() and xSetCookie() JavaScript functions were derived
 192 from www.cross-browser.com, and are copyright (c) 2004 Michael Foster,
 193 and licensed under the LGPL (gnu.org).
 194
 195 =cut