lib/CGI/Push.pm

   1 package CGI::Push;
   2
   3 # See the bottom of this file for the POD documentation.  Search for the
   4 # string '=head'.
   5
   6 # You can run this file through either pod2man or pod2html to produce pretty
   7 # documentation in manual or html file format (these utilities are part of the
   8 # Perl 5 distribution).
   9
  10 # Copyright 1995,1996, Lincoln D. Stein.  All rights reserved.
  11 # It may be used and modified freely, but I do request that this copyright
  12 # notice remain attached to the file.  You may modify this module as you
  13 # wish, but if you redistribute a modified version, please attach a note
  14 # listing the modifications you have made.
  15
  16 # The most recent version and complete docs are available at:
  17 #   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
  18 #   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
  19
  20 $CGI::Push::VERSION='1.00';
  21 use CGI;
  22 @ISA = ('CGI');
  23
  24 # add do_push() to exported tags
  25 push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push');
  26
  27 sub do_push {
  28     my ($self,@p) = CGI::self_or_CGI(@_);
  29
  30     # unbuffer output
  31     $| = 1;
  32     srand;
  33     my ($random) = rand()*1E16;
  34     my ($boundary) = "----------------------------------$random";
  35
  36     my (@header);
  37     my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,@other) =
  38         $self->rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES],@p);
  39     $type = 'text/html' unless $type;
  40     $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE';
  41     $delay = 1 unless defined($delay);
  42
  43     my(@o);
  44     foreach (@other) { push(@o,split("=")); }
  45     push(@o,'-Target'=>$target) if defined($target);
  46     push(@o,'-Cookie'=>$cookie) if defined($cookie);
  47     push(@o,'-Type'=>"multipart/x-mixed-replace; boundary=$boundary");
  48     push(@o,'-Server'=>"CGI.pm Push Module");
  49     push(@o,'-Status'=>'200 OK');
  50     push(@o,'-nph'=>1);
  51     print $self->header(@o);
  52     print "${boundary}$CGI::CRLF";
  53
  54     # now we enter a little loop
  55     my @contents;
  56     while (1) {
  57         last unless (@contents = &$callback($self,++$COUNTER)) && defined($contents[0]);
  58         print "Content-type: ${type}$CGI::CRLF$CGI::CRLF";
  59         print @contents,"$CGI::CRLF";
  60         print "${boundary}$CGI::CRLF";
  61         do_sleep($delay) if $delay;
  62     }
  63     print "Content-type: ${type}$CGI::CRLF$CGI::CRLF",
  64           &$last_page($self,++$COUNTER),
  65           "$CGI::CRLF${boundary}$CGI::CRLF"
  66               if $last_page && ref($last_page) eq 'CODE';
  67 }
  68
  69 sub simple_counter {
  70     my ($self,$count) = @_;
  71     return (
  72             CGI->start_html("CGI::Push Default Counter"),
  73             CGI->h1("CGI::Push Default Counter"),
  74             "This page has been updated ",CGI->strong($count)," times.",
  75             CGI->hr(),
  76             CGI->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'),
  77             CGI->end_html
  78             );
  79 }
  80
  81 sub do_sleep {
  82     my $delay = shift;
  83     if ( ($delay >= 1) && ($delay!~/\./) ){
  84         sleep($delay);
  85     } else {
  86         select(undef,undef,undef,$delay);
  87     }
  88 }
  89
  90 1;
  91
  92 =head1 NAME
  93
  94 CGI::Push - Simple Interface to Server Push
  95
  96 =head1 SYNOPSIS
  97
  98     use CGI::Push qw(:standard);
  99
 100     do_push(-next_page=>\&next_page,
 101             -last_page=>\&last_page,
 102             -delay=>0.5);
 103
 104     sub next_page {
 105         my($q,$counter) = @_;
 106         return undef if $counter >= 10;
 107         return start_html('Test'),
 108                h1('Visible'),"\n",
 109                "This page has been called ", strong($counter)," times",
 110                end_html();
 111       }
 112
 113      sub last_page {
 114          my($q,$counter) = @_;
 115          return start_html('Done'),
 116                 h1('Finished'),
 117                 strong($counter),' iterations.',
 118                 end_html;
 119      }
 120
 121 =head1 DESCRIPTION
 122
 123 CGI::Push is a subclass of the CGI object created by CGI.pm.  It is
 124 specialized for server push operations, which allow you to create
 125 animated pages whose content changes at regular intervals.
 126
 127 You provide CGI::Push with a pointer to a subroutine that will draw
 128 one page.  Every time your subroutine is called, it generates a new
 129 page.  The contents of the page will be transmitted to the browser
 130 in such a way that it will replace what was there beforehand.  The
 131 technique will work with HTML pages as well as with graphics files,
 132 allowing you to create animated GIFs.
 133
 134 =head1 USING CGI::Push
 135
 136 CGI::Push adds one new method to the standard CGI suite, do_push().
 137 When you call this method, you pass it a reference to a subroutine
 138 that is responsible for drawing each new page, an interval delay, and
 139 an optional subroutine for drawing the last page.  Other optional
 140 parameters include most of those recognized by the CGI header()
 141 method.
 142
 143 You may call do_push() in the object oriented manner or not, as you
 144 prefer:
 145
 146     use CGI::Push;
 147     $q = new CGI::Push;
 148     $q->do_push(-next_page=>\&draw_a_page);
 149
 150         -or-
 151
 152     use CGI::Push qw(:standard);
 153     do_push(-next_page=>\&draw_a_page);
 154
 155 Parameters are as follows:
 156
 157 =over 4
 158
 159 =item -next_page
 160
 161     do_push(-next_page=>\&my_draw_routine);
 162
 163 This required parameter points to a reference to a subroutine responsible for
 164 drawing each new page.  The subroutine should expect two parameters
 165 consisting of the CGI object and a counter indicating the number
 166 of times the subroutine has been called.  It should return the
 167 contents of the page as an B<array> of one or more items to print.
 168 It can return a false value (or an empty array) in order to abort the
 169 redrawing loop and print out the final page (if any)
 170
 171     sub my_draw_routine {
 172         my($q,$counter) = @_;
 173         return undef if $counter > 100;
 174         return start_html('testing'),
 175                h1('testing'),
 176                "This page called $counter times";
 177     }
 178
 179 =item -last_page
 180
 181 This optional parameter points to a reference to the subroutine
 182 responsible for drawing the last page of the series.  It is called
 183 after the -next_page routine returns a false value.  The subroutine
 184 itself should have exactly the same calling conventions as the
 185 -next_page routine.
 186
 187 =item -type
 188
 189 This optional parameter indicates the content type of each page.  It
 190 defaults to "text/html".  Currently, server push of heterogeneous
 191 document types is not supported.
 192
 193 =item -delay
 194
 195 This indicates the delay, in seconds, between frames.  Smaller delays
 196 refresh the page faster.  Fractional values are allowed.
 197
 198 B<If not specified, -delay will default to 1 second>
 199
 200 =item -cookie, -target, -expires
 201
 202 These have the same meaning as the like-named parameters in
 203 CGI::header().
 204
 205 =back
 206
 207 =head1 INSTALLING CGI::Push SCRIPTS
 208
 209 Server push scripts B<must> be installed as no-parsed-header (NPH)
 210 scripts in order to work correctly.  On Unix systems, this is most
 211 often accomplished by prefixing the script's name with "nph-".
 212 Recognition of NPH scripts happens automatically with WebSTAR and
 213 Microsoft IIS.  Users of other servers should see their documentation
 214 for help.
 215
 216 =head1 CAVEATS
 217
 218 This is a new module.  It hasn't been extensively tested.
 219
 220 =head1 AUTHOR INFORMATION
 221
 222 be used and modified freely, but I do request that this copyright
 223 notice remain attached to the file.  You may modify this module as you
 224 wish, but if you redistribute a modified version, please attach a note
 225 listing the modifications you have made.
 226
 227 Address bug reports and comments to:
 228 lstein@genome.wi.mit.edu
 229
 230 =head1 BUGS
 231
 232 This section intentionally left blank.
 233
 234 =head1 SEE ALSO
 235
 236 L<CGI::Carp>, L<CGI>
 237
 238 =cut
 239