| Subject: | PATCH: improved auto-buffering and error handling. |
See patch.
| Subject: | stream_not_stream_file.patch |
diff -rN -u old-CGI-Application-Plugin-Stream-2.06/Changes new-CGI-Application-Plugin-Stream-2.06/Changes
--- old-CGI-Application-Plugin-Stream-2.06/Changes 2008-06-22 09:33:27.000000000 -0400
+++ new-CGI-Application-Plugin-Stream-2.06/Changes 2008-06-22 09:33:27.000000000 -0400
@@ -1,5 +1,11 @@
Revision history for Perl extension CGI::Application::Plugin::Stream.
+3.00_1
+ * Turn on local auto-flushing automatically. (Mark Stosberg)
+ * New stream() method provides access to $@ if there is a problem,
+ and will invoke error_mode() automatically if no other error
+ handing is installed. (Mark Stosberg).
+
2.06 Tue Dec 19 09:04:18 EST 2006
* Testing library was missing some override functions
- Thanks, Makio Tsukamoto
diff -rN -u old-CGI-Application-Plugin-Stream-2.06/lib/CGI/Application/Plugin/Stream.pm new-CGI-Application-Plugin-Stream-2.06/lib/CGI/Application/Plugin/Stream.pm
--- old-CGI-Application-Plugin-Stream-2.06/lib/CGI/Application/Plugin/Stream.pm 2008-06-22 09:33:27.000000000 -0400
+++ new-CGI-Application-Plugin-Stream-2.06/lib/CGI/Application/Plugin/Stream.pm 2008-06-22 09:33:27.000000000 -0400
@@ -10,13 +10,18 @@
use vars (qw/@ISA @EXPORT_OK/);
@ISA = qw(Exporter);
-@EXPORT_OK = qw(stream_file);
+@EXPORT_OK = qw(stream stream_file);
-our $VERSION = '2.06';
+our $VERSION = '3.00_1';
-sub stream_file {
+sub stream {
my ( $self, $file_or_fh, $bytes ) = @_;
+
$bytes ||= 1024;
+
+ # Use unbuffered output, but return the state of $| to its previous state when we are done.
+ local $| = 1;
+
my ($fh, $basename);
my $size = (stat( $file_or_fh ))[7];
@@ -24,7 +29,7 @@
if ( ref( \$file_or_fh ) eq 'SCALAR' ) {
# They passed along a scalar, pointing to the path of the file
# So we need to open the file
- open($fh,"<$file_or_fh" ) || return 0;
+ open($fh,"<$file_or_fh" ) || die "failed to open file: $file_or_fh: $!";
# Now let's go binmode (Thanks, William!)
binmode $fh;
$basename = basename( $file_or_fh );
@@ -91,6 +96,27 @@
return 1;
}
+# The old way. Requires manually calling error_mode() if there's a problem,
+# but error_mode() won't have access to "$@"
+sub stream_file {
+ my $self = shift;
+ my $out;
+
+ # Perhaps bad style to not use a method call here,
+ # But this keeps the legacy case working, where only stream_file() was exported.
+ eval { stream($self,@_) };
+
+ # Starting with 3.0, we warn if there's a problem opening the file
+ # instead of ignoring the error.
+ if ($@) {
+ warn $@;
+ return 0;
+ }
+ else {
+ return 1;
+ }
+}
+
1;
__END__
=head1 NAME
@@ -99,7 +125,7 @@
=head1 SYNOPSIS
- use CGI::Application::Plugin::Stream (qw/stream_file/);
+ use CGI::Application::Plugin::Stream 'stream';
sub runmode {
# ...
@@ -109,11 +135,7 @@
#...
- if ( $self->stream_file( $file ) ) {
- return;
- } else {
- return $self->error_mode();
- }
+ return $self->stream($file);
}
=head1 DESCRIPTION
@@ -125,26 +147,22 @@
The file is read and printed in small chunks to keep memory consumption down.
-This plugin is a consumer, as in your runmode shouldn't try to do any output or
-anything afterwards. This plugin affects the HTTP response headers, so
-anything you do afterwards will probably not work. If you pass along a
-filehandle, we'll make sure to close it for you.
-
-It's recommended that you increment $| (or set it to 1), which will
-autoflush the buffer as your application is streaming out the file.
+The C<stream()> method should be run as the last call in a a run mode, and
+affects the HTTP response headers. If you pass along a filehandle, we'll make
+sure to close it for you.
=head1 METHODS
-=head2 stream_file()
+=head2 stream()
- $self->stream_file($fh);
- $self->stream_file( '/path/to/file',2048);
+ $self->stream($fh);
+ $self->stream( '/path/to/file',2048);
This method can take two parameters, the first the path to the file
or a filehandle and the second, an optional number of bytes to determine
the chunk size of the stream. It defaults to 1024.
-It will either stream a file to the user or return false if it fails, perhaps
+It will either stream a file to the user or die if it fails, perhaps
because it couldn't find the file you referenced.
We highly recommend you provide a file name if passing along a filehandle, as we
@@ -153,7 +171,7 @@
$self->header_add( -attachment => 'my_file.txt' );
With both a file handle or file name, we will try to determine the correct
-content type by using File::MMagic. A default of 'application/octet-stream'
+content type by using L<File::MMagic>. A default of 'application/octet-stream'
will be used if File::MMagic can't figure it out.
The size will be calculated and added to the headers as well.
@@ -165,6 +183,13 @@
-Content_Length => 42, # bytes
);
+=head2 stream_file() ( deprecated )
+
+This works the same as stream(), but returns false to indicate a problem.
+
+This is included because this was the original API. It does not give you
+access to "$@" if there is a problem.
+
=head1 AUTHOR
Jason Purdy, E<lt>Jason@Purdy.INFOE<gt>,
diff -rN -u old-CGI-Application-Plugin-Stream-2.06/t/stream.t new-CGI-Application-Plugin-Stream-2.06/t/stream.t
--- old-CGI-Application-Plugin-Stream-2.06/t/stream.t 1969-12-31 19:00:00.000000000 -0500
+++ new-CGI-Application-Plugin-Stream-2.06/t/stream.t 2008-06-22 09:33:27.000000000 -0400
@@ -0,0 +1,163 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+# This script tests "stream" instead of "stream_file"
+
+#########################
+
+use Test::More tests => 15;
+BEGIN {
+ use_ok('CGI::Application::Plugin::Stream');
+
+ unshift @INC, 't/lib';
+}
+
+use strict;
+use TieOut;
+
+
+
+# Useless here, since the point is to test streaming directly.
+#$ENV{CGI_APP_RETURN_ONLY} = 1;
+
+#####
+
+
+my $stdout = tie *STDOUT, 'TieOut' or die;
+my ($content_sent, $test_name);
+
+##############
+
+# Testing with a file handle
+
+my $app = StreamTest->new();
+$app->with_fh();
+
+$content_sent = $stdout->read;
+
+$test_name = "with fh: Content-Disposition and filename headers are correct";
+like($content_sent, qr/Content-Disposition: attachment; filename="FILE"/i,$test_name);
+
+$test_name = 'with fh: Content-type detected correctly by File::MMagic';
+like($content_sent, qr!Content-Type: text/plain!i, $test_name);
+
+$test_name = 'with fh: correct Content-Length header found';
+like($content_sent, qr/Content-Length: 29/i,$test_name);
+
+# Testing with a file
+$app = StreamTest->new();
+$app->run();
+
+$content_sent = $stdout->read;
+$test_name = "Content-Disposition and filename headers are correct";
+like($content_sent, qr/Content-Disposition: attachment; filename="test_file_to_stream.txt"/i,$test_name);
+
+$test_name = 'Content-type detected correctly by File::MMagic';
+like($content_sent, qr!Content-Type: text/plain!i, $test_name);
+
+$test_name = 'correct Content-Length header found';
+like($content_sent, qr/Content-Length: 29/i,$test_name);
+
+###
+
+$test_name = 'Setting a custom Content-Length';
+$app = StreamTest->new();
+$app->header_props(Content_Length => 1 );
+$app->with_fh();
+$content_sent = $stdout->read;
+like($content_sent, qr/Content-Length: 1/i,$test_name);
+
+###
+
+$test_name = 'Setting a custom -Content-Length';
+$app = StreamTest->new();
+$app->header_props(-Content_Length => 4 );
+$app->with_fh();
+$content_sent = $stdout->read;
+like($content_sent, qr/Content-Length: 4/i,$test_name);
+
+###
+
+$test_name = 'Setting a custom type';
+$app = StreamTest->new();
+$app->header_props(type => 'jelly/bean' );
+$app->with_fh();
+$content_sent = $stdout->read;
+like($content_sent, qr/jelly/i,$test_name);
+
+###
+
+$test_name = 'Setting a custom -type';
+$app = StreamTest->new();
+$app->header_props(-type => 'recumbent/bicycle' );
+$app->with_fh();
+$content_sent = $stdout->read;
+like($content_sent, qr/recumbent/i,$test_name);
+
+###
+
+$test_name = 'Setting a custom attachment';
+$app = StreamTest->new();
+$app->header_props(attachment => 'save_the_planet_from_the_humans.txt' );
+$app->with_fh();
+$content_sent = $stdout->read;
+like($content_sent, qr/save_the_planet/i,$test_name);
+
+###
+
+$test_name = 'Setting a custom -type';
+$app = StreamTest->new();
+$app->header_props(-attachment => 'do_some_yoga.mp3' );
+$app->with_fh();
+$content_sent = $stdout->read;
+like($content_sent, qr/yoga/i,$test_name);
+
+###
+
+$test_name = 'Setting a non-attachment header is preserved';
+$app = StreamTest->new();
+$app->header_props(-dryer => 'clothes_line' );
+$app->with_fh();
+$content_sent = $stdout->read;
+like($content_sent, qr/dryer/i,$test_name);
+
+###
+
+$test_name = 'Setting a explicit byte Content-Length at least doesn\'t die';
+$app = StreamTest->new();
+$app->with_bytes();
+$content_sent = $stdout->read;
+like($content_sent, qr/Content-type/i,$test_name);
+
+
+#################
+
+package StreamTest;
+use base 'CGI::Application';
+use CGI::Application::Plugin::Stream 'stream';
+
+sub setup {
+ my $self = shift;
+ $self->run_modes([qw/start with_fh with_bytes/])
+}
+
+
+sub start {
+ my $self = shift;
+ return $self->stream('t/test_file_to_stream.txt');
+}
+
+sub with_fh {
+ my $self = shift;
+
+ my $fh;
+ open($fh,'<t/test_file_to_stream.txt') || die;
+ return $self->stream($fh);
+}
+
+sub with_bytes {
+ my $self = shift;
+ return $self->stream('t/test_file_to_stream.txt',2048);
+}
+
+1;