Commit | Line | Data |
54310121 |
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- |
3e3baf6d |
151 | |
54310121 |
152 | use CGI::Push qw(:standard); |
153 | do_push(-next_page=>\&draw_a_page); |
154 | |
155 | Parameters are as follows: |
156 | |
157 | =over 4 |
3e3baf6d |
158 | |
54310121 |
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> |
3e3baf6d |
237 | |
54310121 |
238 | =cut |
239 | |