r76144 - in /branches/upstream/libcgi-application-plugin-stream-perl: ./ current/ current/lib/ current/lib/CGI/ current/lib/CGI/Application/ current/lib/CGI/Application/Plugin/ current/t/ current/t/lib/
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Sun Jun 19 16:20:51 UTC 2011
Author: periapt-guest
Date: Sun Jun 19 16:20:48 2011
New Revision: 76144
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=76144
Log:
[svn-inject] Installing original source of libcgi-application-plugin-stream-perl (2.10)
Added:
branches/upstream/libcgi-application-plugin-stream-perl/
branches/upstream/libcgi-application-plugin-stream-perl/current/
branches/upstream/libcgi-application-plugin-stream-perl/current/Build.PL
branches/upstream/libcgi-application-plugin-stream-perl/current/Changes
branches/upstream/libcgi-application-plugin-stream-perl/current/MANIFEST
branches/upstream/libcgi-application-plugin-stream-perl/current/META.yml
branches/upstream/libcgi-application-plugin-stream-perl/current/Makefile.PL
branches/upstream/libcgi-application-plugin-stream-perl/current/README
branches/upstream/libcgi-application-plugin-stream-perl/current/lib/
branches/upstream/libcgi-application-plugin-stream-perl/current/lib/CGI/
branches/upstream/libcgi-application-plugin-stream-perl/current/lib/CGI/Application/
branches/upstream/libcgi-application-plugin-stream-perl/current/lib/CGI/Application/Plugin/
branches/upstream/libcgi-application-plugin-stream-perl/current/lib/CGI/Application/Plugin/Stream.pm
branches/upstream/libcgi-application-plugin-stream-perl/current/t/
branches/upstream/libcgi-application-plugin-stream-perl/current/t/02-pod.t
branches/upstream/libcgi-application-plugin-stream-perl/current/t/03-pod_coverage.t
branches/upstream/libcgi-application-plugin-stream-perl/current/t/basic.t
branches/upstream/libcgi-application-plugin-stream-perl/current/t/lib/
branches/upstream/libcgi-application-plugin-stream-perl/current/t/lib/TieOut.pm
branches/upstream/libcgi-application-plugin-stream-perl/current/t/test_file_to_stream.txt
Added: branches/upstream/libcgi-application-plugin-stream-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-stream-perl/current/Build.PL?rev=76144&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-stream-perl/current/Build.PL (added)
+++ branches/upstream/libcgi-application-plugin-stream-perl/current/Build.PL Sun Jun 19 16:20:48 2011
@@ -1,0 +1,18 @@
+use Module::Build;
+
+Module::Build->new(
+ 'module_name' => 'CGI::Application::Plugin::Stream',
+ license => 'perl',
+ requires => {
+ 'Test::More' => 0,
+ 'File::Basename' => 1.0,
+ 'CGI::Application' => 3.21,
+ 'File::MMagic' => 0,
+ 'FileHandle' => 1.22,
+ },
+ create_makefile_pl => 'traditional',
+ create_readme => 1,
+ dist_author => 'Jason Purdy <Jason at Purdy.INFO>',
+ dist_abstract => 'Plugin that adds file streaming support to CGI::Application',
+)->create_build_script;
+
Added: branches/upstream/libcgi-application-plugin-stream-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-stream-perl/current/Changes?rev=76144&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-stream-perl/current/Changes (added)
+++ branches/upstream/libcgi-application-plugin-stream-perl/current/Changes Sun Jun 19 16:20:48 2011
@@ -1,0 +1,56 @@
+Revision history for Perl extension CGI::Application::Plugin::Stream.
+
+2.10 Mon Mar 30 12:04:57 EDT 2009
+ * Added support for CGI_APP_RETURN_ONLY env. variable
+ - Thanks, Brad Bailey
+
+2.06 Tue Dec 19 09:04:18 EST 2006
+ * Testing library was missing some override functions
+ - Thanks, Makio Tsukamoto
+ * Minor whitespace issue
+ * Added content regex to header check
+
+2.05 Tue Sep 27 14:39:41 EDT 2005
+ * Added README to MANIFEST (not sure how it got removed)
+
+2.04 Thu Sep 8 11:52:34 EDT 2005
+ * Added test coverage for the PODs, to boost Kwalitee
+
+2.03 Sun Jul 3 22:13:00 2005
+ [BUG FIX]
+ - Patch - tolerates absence of File::MMagic (Thilo Phanz)
+
+2.02 Thu Jun 23 17:01:00 2005
+ [BUG FIX]
+ - Added a binmode line to address a problem on Windows (William McKee)
+
+2.01 Wed Mar 30 14:59:17 2005
+ [BUG FIXES]
+ - We now use the correct 'Content-Length' header instead of 'Size'. (Mark Stosberg)
+ - A case in which the first few characters of the file could have been
+ missing after the stream was fixed. (Mark Stosberg)
+
+2.00 Mon Dec 6 14:26:17 2004
+ The use of the second argument to stream_file() has changed and is not
+ backward compatible.
+
+ [ENHANCEMENTS]
+ - header_props() and header_add() can now be used to manage headers
+ - The right content type will now attempt to be auto-detected if none is
+ provided.
+ - The chunk size of the stream is now configurable.
+
+ [INTERNALS]
+ - A test suite was added.
+ - started Exporter import technique is used now.
+ - Documentation was updated
+ - Test::More, File::MMagic and FileHandle are now required.
+ - Migrate distribution management to Module::Build
+
+1.00 Thu Dec 3 10:42:04 2004
+ - production version
+
+0.01 Thu Dec 2 16:07:45 2004
+ - original version; created by h2xs 1.21 with options
+ -AX -n CGI::Application::Plugin::Stream
+
Added: branches/upstream/libcgi-application-plugin-stream-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-stream-perl/current/MANIFEST?rev=76144&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-stream-perl/current/MANIFEST (added)
+++ branches/upstream/libcgi-application-plugin-stream-perl/current/MANIFEST Sun Jun 19 16:20:48 2011
@@ -1,0 +1,12 @@
+Changes
+Build.PL
+Makefile.PL
+MANIFEST
+META.yml
+README
+lib/CGI/Application/Plugin/Stream.pm
+t/basic.t
+t/test_file_to_stream.txt
+t/lib/TieOut.pm
+t/02-pod.t
+t/03-pod_coverage.t
Added: branches/upstream/libcgi-application-plugin-stream-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-stream-perl/current/META.yml?rev=76144&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-stream-perl/current/META.yml (added)
+++ branches/upstream/libcgi-application-plugin-stream-perl/current/META.yml Sun Jun 19 16:20:48 2011
@@ -1,0 +1,18 @@
+---
+name: CGI-Application-Plugin-Stream
+version: 2.10
+author:
+ - 'Jason Purdy <Jason at Purdy.INFO>'
+abstract: Plugin that adds file streaming support to CGI::Application
+license: perl
+requires:
+ CGI::Application: 3.21
+ File::Basename: 1
+ File::MMagic: 0
+ FileHandle: 1.22
+ Test::More: 0
+provides:
+ CGI::Application::Plugin::Stream:
+ file: lib/CGI/Application/Plugin/Stream.pm
+ version: 2.10
+generated_by: Module::Build version 0.26
Added: branches/upstream/libcgi-application-plugin-stream-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-stream-perl/current/Makefile.PL?rev=76144&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-stream-perl/current/Makefile.PL (added)
+++ branches/upstream/libcgi-application-plugin-stream-perl/current/Makefile.PL Sun Jun 19 16:20:48 2011
@@ -1,0 +1,17 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'NAME' => 'CGI::Application::Plugin::Stream',
+ 'VERSION_FROM' => 'lib/CGI/Application/Plugin/Stream.pm',
+ 'PREREQ_PM' => {
+ 'CGI::Application' => '3.21',
+ 'File::Basename' => '1',
+ 'File::MMagic' => '0',
+ 'FileHandle' => '1.22',
+ 'Test::More' => '0'
+ },
+ 'INSTALLDIRS' => 'site',
+ 'PL_FILES' => {}
+ )
+;
Added: branches/upstream/libcgi-application-plugin-stream-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-stream-perl/current/README?rev=76144&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-stream-perl/current/README (added)
+++ branches/upstream/libcgi-application-plugin-stream-perl/current/README Sun Jun 19 16:20:48 2011
@@ -1,0 +1,85 @@
+SYNOPSIS
+ use CGI::Application::Plugin::Stream (qw/stream_file/);
+
+ sub runmode {
+ # ...
+
+ # Set up any headers you want to set explicitly
+ # using header_props() or header_add() as usual
+
+ #...
+
+ if ( $self->stream_file( $file ) ) {
+ return;
+ } else {
+ return $self->error_mode();
+ }
+ }
+
+DESCRIPTION
+ This plugin provides a way to stream a file back to the user.
+
+ This is useful if you are creating a PDF or Spreadsheet document
+ dynamically to deliver to the user.
+
+ 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.
+
+METHODS
+ stream_file()
+ $self->stream_file($fh);
+ $self->stream_file( '/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 because it couldn't find the file you referenced.
+
+ We highly recommend you provide a file name if passing along a
+ filehandle, as we won't be able to deduce the file name, and will use
+ 'FILE' by default. Example:
+
+ $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' will be used if File::MMagic can't figure it
+ out.
+
+ The size will be calculated and added to the headers as well.
+
+ Again, you can set these explicitly if you want as well:
+
+ $self->header_add(
+ -type => 'text/plain',
+ -Content_Length => 42, # bytes
+ );
+
+AUTHOR
+ Jason Purdy, <Jason at Purdy.INFO>, with inspiration from Tobias Henoeckl
+ and tremendous support from the cgiapp mailing list.
+
+ Mark Stosberg also contributed to this module.
+
+SEE ALSO
+ CGI::Application, <http://www.cgi-app.org>, "CREATING A STANDARD HTTP
+ HEADER" in CGI.pm,
+ <http://www.mail-archive.com/cgiapp@lists.erlbaum.net/msg02660.html>,
+ File::Basename, "$|" in perlvar
+
+LICENSE
+ Copyright (C) 2004-2005 Jason Purdy, <Jason at Purdy.INFO>
+
+ This library is free software. You can modify and or distribute it under
+ the same terms as Perl itself.
+
Added: branches/upstream/libcgi-application-plugin-stream-perl/current/lib/CGI/Application/Plugin/Stream.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-stream-perl/current/lib/CGI/Application/Plugin/Stream.pm?rev=76144&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-stream-perl/current/lib/CGI/Application/Plugin/Stream.pm (added)
+++ branches/upstream/libcgi-application-plugin-stream-perl/current/lib/CGI/Application/Plugin/Stream.pm Sun Jun 19 16:20:48 2011
@@ -1,0 +1,197 @@
+package CGI::Application::Plugin::Stream;
+
+use 5.006;
+use strict;
+use warnings;
+
+use CGI::Application 3.21;
+use File::Basename;
+require Exporter;
+use vars (qw/@ISA @EXPORT_OK/);
+ at ISA = qw(Exporter);
+
+ at EXPORT_OK = qw(stream_file);
+
+our $VERSION = '2.10';
+
+sub stream_file {
+ my ( $self, $file_or_fh, $bytes ) = @_;
+ $bytes ||= 1024;
+ my ($fh, $basename);
+ my $size = (stat( $file_or_fh ))[7];
+
+ # If we have a file path
+ 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;
+ # Now let's go binmode (Thanks, William!)
+ binmode $fh;
+ $basename = basename( $file_or_fh );
+ }
+ # We have a file handle.
+ else {
+ $fh = $file_or_fh;
+ $basename = 'FILE';
+ }
+
+ # Use FileHandle to make File::MMagic happy;
+ # bless the filehandle into the FileHandle package to make File::MMagic happy
+ require FileHandle;
+ bless $fh, "FileHandle";
+
+ # Check what headers the user has already set and
+ # don't override them.
+ my %existing_headers = $self->header_props();
+
+ # Check for a existing type header set with or without a hypheout a hyphen
+ unless ( $existing_headers{'-type'} || $existing_headers{'type'} ) {
+ my $mime_type;
+
+ eval {
+ require File::MMagic;
+ my $magic = File::MMagic->new();
+ $mime_type = $magic->checktype_filehandle($fh);
+ };
+ warn "Failed to load File::MMagic module to determine mime type: $@" if $@;
+
+ # Set Default
+ $mime_type ||= 'application/octet-stream';
+
+ $self->header_add('-type' => $mime_type);
+ }
+
+
+ unless ( $existing_headers{'Content_Length'}
+ || $existing_headers{'-Content_Length'}
+ ) {
+ $self->header_add('-Content_Length' => $size);
+ }
+
+ unless ( $existing_headers{'-attachment'}
+ || $existing_headers{'attachment'}
+ || grep( /-?content-disposition/i, keys %existing_headers )
+ ) {
+ $self->header_add('-attachment' => $basename);
+ }
+
+ unless ( $ENV{'CGI_APP_RETURN_ONLY'} ) {
+ $self->header_type( 'none' );
+ print $self->query->header( $self->header_props() );
+ }
+
+ # This reads in the file in $byte size chunks
+ # File::MMagic may have read some of the file, so seek back to the beginning
+ my $output = "";
+ seek($fh,0,0);
+ while ( read( $fh, my $buffer, $bytes ) ) {
+ if ( $ENV{'CGI_APP_RETURN_ONLY'} ) {
+ $output .= $buffer;
+ } else {
+ print $buffer;
+ }
+ }
+
+ print '' unless $ENV{'CGI_APP_RETURN_ONLY'}; # print a null string at the end
+ close ( $fh );
+ return $ENV{'CGI_APP_RETURN_ONLY'} ? \$output : 1;
+}
+
+1;
+__END__
+=head1 NAME
+
+CGI::Application::Plugin::Stream - CGI::Application Plugin for streaming files
+
+=head1 SYNOPSIS
+
+ use CGI::Application::Plugin::Stream (qw/stream_file/);
+
+ sub runmode {
+ # ...
+
+ # Set up any headers you want to set explicitly
+ # using header_props() or header_add() as usual
+
+ #...
+
+ if ( $self->stream_file( $file ) ) {
+ return;
+ } else {
+ return $self->error_mode();
+ }
+ }
+
+=head1 DESCRIPTION
+
+This plugin provides a way to stream a file back to the user.
+
+This is useful if you are creating a PDF or Spreadsheet document dynamically to
+deliver to the user.
+
+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.
+
+=head1 METHODS
+
+=head2 stream_file()
+
+ $self->stream_file($fh);
+ $self->stream_file( '/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
+because it couldn't find the file you referenced.
+
+We highly recommend you provide a file name if passing along a filehandle, as we
+won't be able to deduce the file name, and will use 'FILE' by default. Example:
+
+ $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'
+will be used if File::MMagic can't figure it out.
+
+The size will be calculated and added to the headers as well.
+
+Again, you can set these explicitly if you want as well:
+
+ $self->header_add(
+ -type => 'text/plain',
+ -Content_Length => 42, # bytes
+ );
+
+=head1 AUTHOR
+
+Jason Purdy, E<lt>Jason at Purdy.INFOE<gt>,
+with inspiration from Tobias Henoeckl
+and tremendous support from the cgiapp mailing list.
+
+Mark Stosberg also contributed to this module.
+
+=head1 SEE ALSO
+
+L<CGI::Application>,
+L<http://www.cgi-app.org>,
+L<CGI.pm/"CREATING A STANDARD HTTP HEADER">,
+L<http://www.mail-archive.com/cgiapp@lists.erlbaum.net/msg02660.html>,
+L<File::Basename>,
+L<perlvar/$E<verbar>>
+
+=head1 LICENSE
+
+Copyright (C) 2004-2005 Jason Purdy, E<lt>Jason at Purdy.INFOE<gt>
+
+This library is free software. You can modify and or distribute it under the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libcgi-application-plugin-stream-perl/current/t/02-pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-stream-perl/current/t/02-pod.t?rev=76144&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-stream-perl/current/t/02-pod.t (added)
+++ branches/upstream/libcgi-application-plugin-stream-perl/current/t/02-pod.t Sun Jun 19 16:20:48 2011
@@ -1,0 +1,7 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required" if $@;
+all_pod_files_ok();
Added: branches/upstream/libcgi-application-plugin-stream-perl/current/t/03-pod_coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-stream-perl/current/t/03-pod_coverage.t?rev=76144&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-stream-perl/current/t/03-pod_coverage.t (added)
+++ branches/upstream/libcgi-application-plugin-stream-perl/current/t/03-pod_coverage.t Sun Jun 19 16:20:48 2011
@@ -1,0 +1,13 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+if ( $@ )
+{
+ plan skip_all => "Test::Pod::Coverage 1.04 required" if $@;
+} else {
+ plan tests => 1;
+}
+
+pod_coverage_ok( "CGI::Application::Plugin::Stream", "CGI::Application::Plugin::Stream has good pod coverage" );
Added: branches/upstream/libcgi-application-plugin-stream-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-stream-perl/current/t/basic.t?rev=76144&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-stream-perl/current/t/basic.t (added)
+++ branches/upstream/libcgi-application-plugin-stream-perl/current/t/basic.t Sun Jun 19 16:20:48 2011
@@ -1,0 +1,161 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#########################
+
+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 (qw/stream_file/);
+
+sub setup {
+ my $self = shift;
+ $self->run_modes([qw/start with_fh with_bytes/])
+}
+
+
+sub start {
+ my $self = shift;
+ return $self->stream_file('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_file($fh);
+}
+
+sub with_bytes {
+ my $self = shift;
+ return $self->stream_file('t/test_file_to_stream.txt',2048);
+}
+
+1;
Added: branches/upstream/libcgi-application-plugin-stream-perl/current/t/lib/TieOut.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-stream-perl/current/t/lib/TieOut.pm?rev=76144&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-stream-perl/current/t/lib/TieOut.pm (added)
+++ branches/upstream/libcgi-application-plugin-stream-perl/current/t/lib/TieOut.pm Sun Jun 19 16:20:48 2011
@@ -1,0 +1,27 @@
+package TieOut;
+
+sub TIEHANDLE {
+ bless( \(my $scalar), $_[0]);
+}
+
+sub PRINT {
+ my $self = shift;
+ $$self .= join('', @_);
+}
+
+sub PRINTF {
+ my $self = shift;
+ my $fmt = shift;
+ $$self .= sprintf $fmt, @_;
+}
+
+sub read {
+ my $self = shift;
+ return substr($$self, 0, length($$self), '');
+}
+
+# Thanks, Makio!
+sub FILENO { 1; }
+sub BINMODE { 1; }
+
+1;
Added: branches/upstream/libcgi-application-plugin-stream-perl/current/t/test_file_to_stream.txt
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-stream-perl/current/t/test_file_to_stream.txt?rev=76144&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-stream-perl/current/t/test_file_to_stream.txt (added)
+++ branches/upstream/libcgi-application-plugin-stream-perl/current/t/test_file_to_stream.txt Sun Jun 19 16:20:48 2011
@@ -1,0 +1,2 @@
+darcs
+http://www.darcs.net/
More information about the Pkg-perl-cvs-commits
mailing list