vendor/perl5/5.005.02

1 files changed, 313 insertions, 0 deletions

diff --git a/contrib/perl5/lib/CGI/Push.pm b/contrib/perl5/lib/CGI/Push.pm
new file mode 100644
index 0000000000000..eeec3f81108f3
--- /dev/null
+++ b/contrib/perl5/lib/CGI/Push.pm
@@ -0,0 +1,313 @@
+package CGI::Push;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# documentation in manual or html file format (these utilities are part of the
+# Perl 5 distribution).
+
+# Copyright 1995,1996, Lincoln D. Stein.  All rights reserved.
+# It may be used and modified freely, but I do request that this copyright
+# notice remain attached to the file.  You may modify this module as you 
+# wish, but if you redistribute a modified version, please attach a note
+# listing the modifications you have made.
+
+# The most recent version and complete docs are available at:
+#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
+#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+
+$CGI::Push::VERSION='1.01';
+use CGI;
+@ISA = ('CGI');
+
+$CGI::DefaultClass = 'CGI::Push';
+$CGI::Push::AutoloadClass = 'CGI';
+
+# add do_push() and push_delay() to exported tags
+push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push','push_delay');
+
+sub do_push {
+    my ($self,@p) = CGI::self_or_default(@_);
+
+    # unbuffer output
+    $| = 1;
+    srand;
+    my ($random) = sprintf("%16.0f",rand()*1E16);
+    my ($boundary) = "----------------------------------$random";
+
+    my (@header);
+    my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,@other) =
+	$self->rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES],@p);
+    $type = 'text/html' unless $type;
+    $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE';
+    $delay = 1 unless defined($delay);
+    $self->push_delay($delay);
+
+    my(@o);
+    foreach (@other) { push(@o,split("=")); }
+    push(@o,'-Target'=>$target) if defined($target);
+    push(@o,'-Cookie'=>$cookie) if defined($cookie);
+    push(@o,'-Type'=>"multipart/x-mixed-replace; boundary=$boundary");
+    push(@o,'-Server'=>"CGI.pm Push Module");
+    push(@o,'-Status'=>'200 OK');
+    push(@o,'-nph'=>1);
+    print $self->header(@o);
+    print "${boundary}$CGI::CRLF";
+    
+    # now we enter a little loop
+    my @contents;
+    while (1) {
+	last unless (@contents = &$callback($self,++$COUNTER)) && defined($contents[0]);
+	print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" 
+	    unless $type eq 'dynamic';
+	print @contents,"$CGI::CRLF";
+	print "${boundary}$CGI::CRLF";
+	do_sleep($self->push_delay()) if $self->push_delay();
+    }
+
+    # Optional last page
+    if ($last_page && ref($last_page) eq 'CODE') {
+	print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i;
+	print  &$last_page($self,$COUNTER),"$CGI::CRLF${boundary}$CGI::CRLF";
+    }
+}
+
+sub simple_counter {
+    my ($self,$count) = @_;
+    return (
+	    CGI->start_html("CGI::Push Default Counter"),
+	    CGI->h1("CGI::Push Default Counter"),
+	    "This page has been updated ",CGI->strong($count)," times.",
+	    CGI->hr(),
+	    CGI->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'),
+	    CGI->end_html
+	    );
+}
+
+sub do_sleep {
+    my $delay = shift;
+    if ( ($delay >= 1) && ($delay!~/\./) ){
+	sleep($delay);
+    } else {
+	select(undef,undef,undef,$delay);
+    }
+}
+
+sub push_delay {
+   my ($self,$delay) = CGI::self_or_default(@_);
+   return defined($delay) ? $self->{'.delay'} = 
+	$delay : $self->{'.delay'};
+}
+
+1;
+
+=head1 NAME
+
+CGI::Push - Simple Interface to Server Push
+
+=head1 SYNOPSIS
+
+    use CGI::Push qw(:standard);
+
+    do_push(-next_page=>\&next_page,
+            -last_page=>\&last_page,
+            -delay=>0.5);
+
+    sub next_page {
+        my($q,$counter) = @_;
+        return undef if $counter >= 10;
+        return start_html('Test'),
+  	       h1('Visible'),"\n",
+               "This page has been called ", strong($counter)," times",
+               end_html();
+      }
+
+     sub last_page {
+	 my($q,$counter) = @_;
+         return start_html('Done'),
+                h1('Finished'),
+                strong($counter),' iterations.',
+                end_html;
+     }
+
+=head1 DESCRIPTION
+
+CGI::Push is a subclass of the CGI object created by CGI.pm.  It is
+specialized for server push operations, which allow you to create
+animated pages whose content changes at regular intervals.
+
+You provide CGI::Push with a pointer to a subroutine that will draw
+one page.  Every time your subroutine is called, it generates a new
+page.  The contents of the page will be transmitted to the browser
+in such a way that it will replace what was there beforehand.  The
+technique will work with HTML pages as well as with graphics files, 
+allowing you to create animated GIFs.
+
+=head1 USING CGI::Push
+
+CGI::Push adds one new method to the standard CGI suite, do_push().
+When you call this method, you pass it a reference to a subroutine
+that is responsible for drawing each new page, an interval delay, and
+an optional subroutine for drawing the last page.  Other optional
+parameters include most of those recognized by the CGI header()
+method.
+
+You may call do_push() in the object oriented manner or not, as you
+prefer:
+
+    use CGI::Push;
+    $q = new CGI::Push;
+    $q->do_push(-next_page=>\&draw_a_page);
+
+        -or-
+
+    use CGI::Push qw(:standard);
+    do_push(-next_page=>\&draw_a_page);
+
+Parameters are as follows:
+
+=over 4
+
+=item -next_page
+
+    do_push(-next_page=>\&my_draw_routine);
+
+This required parameter points to a reference to a subroutine responsible for
+drawing each new page.  The subroutine should expect two parameters
+consisting of the CGI object and a counter indicating the number
+of times the subroutine has been called.  It should return the
+contents of the page as an B<array> of one or more items to print.  
+It can return a false value (or an empty array) in order to abort the
+redrawing loop and print out the final page (if any)
+
+    sub my_draw_routine {
+        my($q,$counter) = @_;
+        return undef if $counter > 100;
+        return start_html('testing'),
+               h1('testing'),
+	       "This page called $counter times";
+    }
+
+You are of course free to refer to create and use global variables
+within your draw routine in order to achieve special effects.
+
+=item -last_page
+
+This optional parameter points to a reference to the subroutine
+responsible for drawing the last page of the series.  It is called
+after the -next_page routine returns a false value.  The subroutine
+itself should have exactly the same calling conventions as the
+-next_page routine.
+
+=item -type
+
+This optional parameter indicates the content type of each page.  It
+defaults to "text/html".  Normally the module assumes that each page
+is of a homogenous MIME type.  However if you provide either of the
+magic values "heterogeneous" or "dynamic" (the latter provided for the
+convenience of those who hate long parameter names), you can specify
+the MIME type -- and other header fields -- on a per-page basis.  See 
+"heterogeneous pages" for more details.
+
+=item -delay
+
+This indicates the delay, in seconds, between frames.  Smaller delays
+refresh the page faster.  Fractional values are allowed.
+
+B<If not specified, -delay will default to 1 second>
+
+=item -cookie, -target, -expires
+
+These have the same meaning as the like-named parameters in
+CGI::header().
+
+=back
+
+=head2 Heterogeneous Pages
+
+Ordinarily all pages displayed by CGI::Push share a common MIME type.
+However by providing a value of "heterogeneous" or "dynamic" in the
+do_push() -type parameter, you can specify the MIME type of each page
+on a case-by-case basis.  
+
+If you use this option, you will be responsible for producing the
+HTTP header for each page.  Simply modify your draw routine to
+look like this:
+
+    sub my_draw_routine {
+        my($q,$counter) = @_;
+        return header('text/html'),   # note we're producing the header here
+	       start_html('testing'),
+               h1('testing'),
+	       "This page called $counter times";
+    }
+
+You can add any header fields that you like, but some (cookies and
+status fields included) may not be interpreted by the browser.  One
+interesting effect is to display a series of pages, then, after the
+last page, to redirect the browser to a new URL.  Because redirect() 
+does b<not> work, the easiest way is with a -refresh header field,
+as shown below:
+
+    sub my_draw_routine {
+        my($q,$counter) = @_;
+	return undef if $counter > 10;
+        return header('text/html'),   # note we're producing the header here
+	       start_html('testing'),
+               h1('testing'),
+	       "This page called $counter times";
+    }
+   
+    sub my_last_page {
+	header(-refresh=>'5; URL=http://somewhere.else/finished.html',
+	       -type=>'text/html'),
+        start_html('Moved'),
+        h1('This is the last page'),
+	'Goodbye!'
+         hr,	
+         end_html; 
+    }
+
+=head2 Changing the Page Delay on the Fly
+
+If you would like to control the delay between pages on a page-by-page
+basis, call push_delay() from within your draw routine.  push_delay()
+takes a single numeric argument representing the number of seconds you
+wish to delay after the current page is displayed and before
+displaying the next one.  The delay may be fractional.  Without
+parameters, push_delay() just returns the current delay.
+
+=head1 INSTALLING CGI::Push SCRIPTS
+
+Server push scripts B<must> be installed as no-parsed-header (NPH)
+scripts in order to work correctly.  On Unix systems, this is most
+often accomplished by prefixing the script's name with "nph-".  
+Recognition of NPH scripts happens automatically with WebSTAR and 
+Microsoft IIS.  Users of other servers should see their documentation
+for help.
+
+=head1 CAVEATS
+
+This is a new module.  It hasn't been extensively tested.
+
+=head1 AUTHOR INFORMATION
+
+be used and modified freely, but I do request that this copyright
+notice remain attached to the file.  You may modify this module as you
+wish, but if you redistribute a modified version, please attach a note
+listing the modifications you have made.
+
+Address bug reports and comments to:
+lstein@genome.wi.mit.edu
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 SEE ALSO
+
+L<CGI::Carp>, L<CGI>
+
+=cut
+