| 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-2000, 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://stein.cshl.org/WWW/software/CGI/ |
| 18 |
|
| 19 |
$CGI::Push::VERSION='1.04'; |
| 20 |
use CGI; |
| 21 |
use CGI::Util 'rearrange'; |
| 22 |
@ISA = ('CGI'); |
| 23 |
|
| 24 |
$CGI::DefaultClass = 'CGI::Push'; |
| 25 |
$CGI::Push::AutoloadClass = 'CGI'; |
| 26 |
|
| 27 |
# add do_push() and push_delay() to exported tags |
| 28 |
push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push','push_delay'); |
| 29 |
|
| 30 |
sub do_push { |
| 31 |
my ($self,@p) = CGI::self_or_default(@_); |
| 32 |
|
| 33 |
# unbuffer output |
| 34 |
$| = 1; |
| 35 |
srand; |
| 36 |
my ($random) = sprintf("%08.0f",rand()*1E8); |
| 37 |
my ($boundary) = "----=_NeXtPaRt$random"; |
| 38 |
|
| 39 |
my (@header); |
| 40 |
my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,$nph,@other) = rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p); |
| 41 |
$type = 'text/html' unless $type; |
| 42 |
$callback = \&simple_counter unless $callback && ref($callback) eq 'CODE'; |
| 43 |
$delay = 1 unless defined($delay); |
| 44 |
$self->push_delay($delay); |
| 45 |
$nph = 1 unless defined($nph); |
| 46 |
|
| 47 |
my(@o); |
| 48 |
foreach (@other) { push(@o,split("=")); } |
| 49 |
push(@o,'-Target'=>$target) if defined($target); |
| 50 |
push(@o,'-Cookie'=>$cookie) if defined($cookie); |
| 51 |
push(@o,'-Type'=>"multipart/x-mixed-replace;boundary=\"$boundary\""); |
| 52 |
push(@o,'-Server'=>"CGI.pm Push Module") if $nph; |
| 53 |
push(@o,'-Status'=>'200 OK'); |
| 54 |
push(@o,'-nph'=>1) if $nph; |
| 55 |
print $self->header(@o); |
| 56 |
|
| 57 |
$boundary = "$CGI::CRLF--$boundary"; |
| 58 |
|
| 59 |
print "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.${boundary}$CGI::CRLF"; |
| 60 |
|
| 61 |
my (@contents) = &$callback($self,++$COUNTER); |
| 62 |
|
| 63 |
# now we enter a little loop |
| 64 |
while (1) { |
| 65 |
print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i; |
| 66 |
print @contents; |
| 67 |
@contents = &$callback($self,++$COUNTER); |
| 68 |
if ((@contents) && defined($contents[0])) { |
| 69 |
print "${boundary}$CGI::CRLF"; |
| 70 |
do_sleep($self->push_delay()) if $self->push_delay(); |
| 71 |
} else { |
| 72 |
if ($last_page && ref($last_page) eq 'CODE') { |
| 73 |
print "${boundary}$CGI::CRLF"; |
| 74 |
do_sleep($self->push_delay()) if $self->push_delay(); |
| 75 |
print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i; |
| 76 |
print &$last_page($self,$COUNTER); |
| 77 |
} |
| 78 |
print "${boundary}--$CGI::CRLF"; |
| 79 |
last; |
| 80 |
} |
| 81 |
} |
| 82 |
print "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.$CGI::CRLF"; |
| 83 |
} |
| 84 |
|
| 85 |
sub simple_counter { |
| 86 |
my ($self,$count) = @_; |
| 87 |
return $self->start_html("CGI::Push Default Counter"), |
| 88 |
$self->h1("CGI::Push Default Counter"), |
| 89 |
"This page has been updated ",$self->strong($count)," times.", |
| 90 |
$self->hr(), |
| 91 |
$self->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'), |
| 92 |
$self->end_html; |
| 93 |
} |
| 94 |
|
| 95 |
sub do_sleep { |
| 96 |
my $delay = shift; |
| 97 |
if ( ($delay >= 1) && ($delay!~/\./) ){ |
| 98 |
sleep($delay); |
| 99 |
} else { |
| 100 |
select(undef,undef,undef,$delay); |
| 101 |
} |
| 102 |
} |
| 103 |
|
| 104 |
sub push_delay { |
| 105 |
my ($self,$delay) = CGI::self_or_default(@_); |
| 106 |
return defined($delay) ? $self->{'.delay'} = |
| 107 |
$delay : $self->{'.delay'}; |
| 108 |
} |
| 109 |
|
| 110 |
1; |
| 111 |
|
| 112 |
=head1 NAME |
| 113 |
|
| 114 |
CGI::Push - Simple Interface to Server Push |
| 115 |
|
| 116 |
=head1 SYNOPSIS |
| 117 |
|
| 118 |
use CGI::Push qw(:standard); |
| 119 |
|
| 120 |
do_push(-next_page=>\&next_page, |
| 121 |
-last_page=>\&last_page, |
| 122 |
-delay=>0.5); |
| 123 |
|
| 124 |
sub next_page { |
| 125 |
my($q,$counter) = @_; |
| 126 |
return undef if $counter >= 10; |
| 127 |
return start_html('Test'), |
| 128 |
h1('Visible'),"\n", |
| 129 |
"This page has been called ", strong($counter)," times", |
| 130 |
end_html(); |
| 131 |
} |
| 132 |
|
| 133 |
sub last_page { |
| 134 |
my($q,$counter) = @_; |
| 135 |
return start_html('Done'), |
| 136 |
h1('Finished'), |
| 137 |
strong($counter - 1),' iterations.', |
| 138 |
end_html; |
| 139 |
} |
| 140 |
|
| 141 |
=head1 DESCRIPTION |
| 142 |
|
| 143 |
CGI::Push is a subclass of the CGI object created by CGI.pm. It is |
| 144 |
specialized for server push operations, which allow you to create |
| 145 |
animated pages whose content changes at regular intervals. |
| 146 |
|
| 147 |
You provide CGI::Push with a pointer to a subroutine that will draw |
| 148 |
one page. Every time your subroutine is called, it generates a new |
| 149 |
page. The contents of the page will be transmitted to the browser |
| 150 |
in such a way that it will replace what was there beforehand. The |
| 151 |
technique will work with HTML pages as well as with graphics files, |
| 152 |
allowing you to create animated GIFs. |
| 153 |
|
| 154 |
Only Netscape Navigator supports server push. Internet Explorer |
| 155 |
browsers do not. |
| 156 |
|
| 157 |
=head1 USING CGI::Push |
| 158 |
|
| 159 |
CGI::Push adds one new method to the standard CGI suite, do_push(). |
| 160 |
When you call this method, you pass it a reference to a subroutine |
| 161 |
that is responsible for drawing each new page, an interval delay, and |
| 162 |
an optional subroutine for drawing the last page. Other optional |
| 163 |
parameters include most of those recognized by the CGI header() |
| 164 |
method. |
| 165 |
|
| 166 |
You may call do_push() in the object oriented manner or not, as you |
| 167 |
prefer: |
| 168 |
|
| 169 |
use CGI::Push; |
| 170 |
$q = new CGI::Push; |
| 171 |
$q->do_push(-next_page=>\&draw_a_page); |
| 172 |
|
| 173 |
-or- |
| 174 |
|
| 175 |
use CGI::Push qw(:standard); |
| 176 |
do_push(-next_page=>\&draw_a_page); |
| 177 |
|
| 178 |
Parameters are as follows: |
| 179 |
|
| 180 |
=over 4 |
| 181 |
|
| 182 |
=item -next_page |
| 183 |
|
| 184 |
do_push(-next_page=>\&my_draw_routine); |
| 185 |
|
| 186 |
This required parameter points to a reference to a subroutine responsible for |
| 187 |
drawing each new page. The subroutine should expect two parameters |
| 188 |
consisting of the CGI object and a counter indicating the number |
| 189 |
of times the subroutine has been called. It should return the |
| 190 |
contents of the page as an B<array> of one or more items to print. |
| 191 |
It can return a false value (or an empty array) in order to abort the |
| 192 |
redrawing loop and print out the final page (if any) |
| 193 |
|
| 194 |
sub my_draw_routine { |
| 195 |
my($q,$counter) = @_; |
| 196 |
return undef if $counter > 100; |
| 197 |
return start_html('testing'), |
| 198 |
h1('testing'), |
| 199 |
"This page called $counter times"; |
| 200 |
} |
| 201 |
|
| 202 |
You are of course free to refer to create and use global variables |
| 203 |
within your draw routine in order to achieve special effects. |
| 204 |
|
| 205 |
=item -last_page |
| 206 |
|
| 207 |
This optional parameter points to a reference to the subroutine |
| 208 |
responsible for drawing the last page of the series. It is called |
| 209 |
after the -next_page routine returns a false value. The subroutine |
| 210 |
itself should have exactly the same calling conventions as the |
| 211 |
-next_page routine. |
| 212 |
|
| 213 |
=item -type |
| 214 |
|
| 215 |
This optional parameter indicates the content type of each page. It |
| 216 |
defaults to "text/html". Normally the module assumes that each page |
| 217 |
is of a homogenous MIME type. However if you provide either of the |
| 218 |
magic values "heterogeneous" or "dynamic" (the latter provided for the |
| 219 |
convenience of those who hate long parameter names), you can specify |
| 220 |
the MIME type -- and other header fields -- on a per-page basis. See |
| 221 |
"heterogeneous pages" for more details. |
| 222 |
|
| 223 |
=item -delay |
| 224 |
|
| 225 |
This indicates the delay, in seconds, between frames. Smaller delays |
| 226 |
refresh the page faster. Fractional values are allowed. |
| 227 |
|
| 228 |
B<If not specified, -delay will default to 1 second> |
| 229 |
|
| 230 |
=item -cookie, -target, -expires, -nph |
| 231 |
|
| 232 |
These have the same meaning as the like-named parameters in |
| 233 |
CGI::header(). |
| 234 |
|
| 235 |
If not specified, -nph will default to 1 (as needed for many servers, see below). |
| 236 |
|
| 237 |
=back |
| 238 |
|
| 239 |
=head2 Heterogeneous Pages |
| 240 |
|
| 241 |
Ordinarily all pages displayed by CGI::Push share a common MIME type. |
| 242 |
However by providing a value of "heterogeneous" or "dynamic" in the |
| 243 |
do_push() -type parameter, you can specify the MIME type of each page |
| 244 |
on a case-by-case basis. |
| 245 |
|
| 246 |
If you use this option, you will be responsible for producing the |
| 247 |
HTTP header for each page. Simply modify your draw routine to |
| 248 |
look like this: |
| 249 |
|
| 250 |
sub my_draw_routine { |
| 251 |
my($q,$counter) = @_; |
| 252 |
return header('text/html'), # note we're producing the header here |
| 253 |
start_html('testing'), |
| 254 |
h1('testing'), |
| 255 |
"This page called $counter times"; |
| 256 |
} |
| 257 |
|
| 258 |
You can add any header fields that you like, but some (cookies and |
| 259 |
status fields included) may not be interpreted by the browser. One |
| 260 |
interesting effect is to display a series of pages, then, after the |
| 261 |
last page, to redirect the browser to a new URL. Because redirect() |
| 262 |
does b<not> work, the easiest way is with a -refresh header field, |
| 263 |
as shown below: |
| 264 |
|
| 265 |
sub my_draw_routine { |
| 266 |
my($q,$counter) = @_; |
| 267 |
return undef if $counter > 10; |
| 268 |
return header('text/html'), # note we're producing the header here |
| 269 |
start_html('testing'), |
| 270 |
h1('testing'), |
| 271 |
"This page called $counter times"; |
| 272 |
} |
| 273 |
|
| 274 |
sub my_last_page { |
| 275 |
return header(-refresh=>'5; URL=http://somewhere.else/finished.html', |
| 276 |
-type=>'text/html'), |
| 277 |
start_html('Moved'), |
| 278 |
h1('This is the last page'), |
| 279 |
'Goodbye!' |
| 280 |
hr, |
| 281 |
end_html; |
| 282 |
} |
| 283 |
|
| 284 |
=head2 Changing the Page Delay on the Fly |
| 285 |
|
| 286 |
If you would like to control the delay between pages on a page-by-page |
| 287 |
basis, call push_delay() from within your draw routine. push_delay() |
| 288 |
takes a single numeric argument representing the number of seconds you |
| 289 |
wish to delay after the current page is displayed and before |
| 290 |
displaying the next one. The delay may be fractional. Without |
| 291 |
parameters, push_delay() just returns the current delay. |
| 292 |
|
| 293 |
=head1 INSTALLING CGI::Push SCRIPTS |
| 294 |
|
| 295 |
Server push scripts must be installed as no-parsed-header (NPH) |
| 296 |
scripts in order to work correctly on many servers. On Unix systems, |
| 297 |
this is most often accomplished by prefixing the script's name with "nph-". |
| 298 |
Recognition of NPH scripts happens automatically with WebSTAR and |
| 299 |
Microsoft IIS. Users of other servers should see their documentation |
| 300 |
for help. |
| 301 |
|
| 302 |
Apache web server from version 1.3b2 on does not need server |
| 303 |
push scripts installed as NPH scripts: the -nph parameter to do_push() |
| 304 |
may be set to a false value to disable the extra headers needed by an |
| 305 |
NPH script. |
| 306 |
|
| 307 |
=head1 AUTHOR INFORMATION |
| 308 |
|
| 309 |
Copyright 1995-1998, Lincoln D. Stein. All rights reserved. |
| 310 |
|
| 311 |
This library is free software; you can redistribute it and/or modify |
| 312 |
it under the same terms as Perl itself. |
| 313 |
|
| 314 |
Address bug reports and comments to: lstein@cshl.org |
| 315 |
|
| 316 |
=head1 BUGS |
| 317 |
|
| 318 |
This section intentionally left blank. |
| 319 |
|
| 320 |
=head1 SEE ALSO |
| 321 |
|
| 322 |
L<CGI::Carp>, L<CGI> |
| 323 |
|
| 324 |
=cut |
| 325 |
|
