Hi,

I'm trying to figure out a good way to download dynamically generated files (mainly PDF files and ZIP files) using CGI-Application.

The user directs his browser at a CGI script, rather than a static PDF file or ZIP file, and that script generates the file in question based on various input variables and then downloads it to the client.

At the moment, the only way I can see to do this with CGI-Application is to read the whole generated file into a scalar variable, and return (a reference to) that from the run-mode. This is highly undesirable since the files in question could be very large.

What I think I want is for CGI-Application to support run-modes returning some kind of valid filehandle (GLOB reference or IO::Handle). CGI::Application->run() would then read (in small chunks at a time) data from the returned filehandle and output it. The attached patch (against version 3.1) is a quick stab at this. It would need polishing up, but basically works OK as a demonstration of what I'm after.

The following simple module (together with the obvious CGI script) shows it in action (albeit on a static file, rather than a dynamically generated one):

==========
package MyDownloader;
use CGI::Application;
our @ISA = qw(CGI::Application);

sub setup {
   my $self = shift;
   $self->run_modes(['download']);
   $self->start_mode('download');
}

sub download {
   my $self = shift;
   my $type = 'image/gif';
   my $file = 'C:\\Temp\\downloadee.gif';
   $self->header_props(-type => $type);
   open FH, $file;
   return \*FH;
}

1;
==========

What are your thoughts on this?

Or is there a better way to do what I'm trying to achieve here?

Cheers,
- Steve
--- Application.pm.orig 2003-06-02 13:43:18.000000000 +0100
+++ Application.pm      2003-09-10 09:07:24.000000000 +0100
@@ -142,8 +142,8 @@
         my $body = eval { $autoload_mode ? $self->$rmeth($rm) : $self->$rmeth() };
         die "Error executing run mode '$rm': $@" if $@;
 
-        # Support scalar-ref for body return
-        my $bodyref = (ref($body) eq 'SCALAR') ? $body : \$body;
+        # Support scalar- and glob-ref for body return
+        my $bodyref = (ref($body) eq 'SCALAR' or ref($body) eq 'GLOB') ? $body : 
\$body;
 
         # Call cgiapp_postrun() hook
         $self->cgiapp_postrun($bodyref);
@@ -151,12 +151,46 @@
        # Set up HTTP headers
        my $headers = $self->_send_headers();
 
-       # Build up total output
-       my $output = $headers . $$bodyref;
+       my $output = $headers;
 
-       # Send output to browser (unless we're in serious debug mode!)
-       unless ($ENV{CGI_APP_RETURN_ONLY}) {
-               print $output;
+       if (ref($bodyref) eq 'GLOB') {
+               unless (defined fileno $bodyref) {
+                       croak("GLOB ref is not a valid filehandle");
+               }
+
+               # Send headers to browser (unless we're in serious debug mode!)
+               unless ($ENV{CGI_APP_RETURN_ONLY}) {
+                       print $output;
+               }
+
+               binmode $bodyref;
+               binmode STDOUT;
+
+               # Read data from the filehandle in 2KB chunks in case there is a
+               # large amount of it (and don't rely on the data being "text"
+               # with frequent "newline" separators)
+               my $len = 0;
+               my $buf = '';
+               while ($len = read $bodyref, $buf, 2048) {
+                       # Send data to browser (unless we're in serious debug mode!)
+                       unless ($ENV{CGI_APP_RETURN_ONLY}) {
+                               print $buf;
+                       }
+               }
+
+               # read() returns undef on failure
+               unless (defined $len) {
+                       croak("Error reading from filehandle: $!");
+               }
+       }
+       else {
+               # Build up total output
+               $output .= $$bodyref;
+
+               # Send output to browser (unless we're in serious debug mode!)
+               unless ($ENV{CGI_APP_RETURN_ONLY}) {
+                       print $output;
+               }
        }
 
        # clean up operations

---------------------------------------------------------------------
Web Archive:  http://www.mail-archive.com/[EMAIL PROTECTED]/
              http://marc.theaimsgroup.com/?l=cgiapp&r=1&w=2
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]

Reply via email to