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