diff --git a/lib/CGI/Application.pm b/lib/CGI/Application.pm index f715b4e..c64e1f1 100644 --- a/lib/CGI/Application.pm +++ b/lib/CGI/Application.pm @@ -2,6 +2,7 @@ package CGI::Application; use Carp; use strict; use Class::ISA; +use Scalar::Util; $CGI::Application::VERSION = '4.50'; @@ -37,7 +38,7 @@ sub new { # # We set them up here and not in the setup() because a subclass # which implements setup() still needs default values! - + $self->header_type('header'); $self->mode_param('rm'); $self->start_mode('start'); @@ -196,19 +197,38 @@ sub run { # Call cgiapp_postrun() hook $self->call_hook('postrun', \$body); - my $return_value; - if ($self->{__IS_PSGI}) { - my ($status, $headers) = $self->_send_psgi_headers(); - $return_value = [ $status, $headers, [ $body ]]; - } - else { - # Set up HTTP headers non-PSGI responses - my $headers = $self->_send_headers(); + my $return_value; + if ($self->{__IS_PSGI}) { + my ($status, $headers) = $self->_send_psgi_headers(); - # Build up total output - $return_value = $headers.$body; - print $return_value unless $ENV{CGI_APP_RETURN_ONLY}; - } + if (ref($body) eq 'GLOB' || (Scalar::Util::blessed($body) && $body->can('getline'))) { + # body a file handle - return it + $return_value = [ $status, $headers, $body]; + } + elsif (ref($body) eq 'CODE') { + + # body is a subref, or an explicit callback method is set + $return_value = sub { + my $respond = shift; + + my $writer = $respond->([ $status, $headers ]); + + &$body($writer); + }; + } + else { + + $return_value = [ $status, $headers, [ $body ]]; + } + } + else { + # Set up HTTP headers non-PSGI responses + my $headers = $self->_send_headers(); + + # Build up total output + $return_value = $headers.$body; + print $return_value unless $ENV{CGI_APP_RETURN_ONLY}; + } # clean up operations $self->call_hook('teardown'); @@ -385,7 +405,7 @@ sub _header_props_update { # If data is provided, set it! if (scalar(@data)) { if ($self->header_type eq 'none') { - warn "header_props called while header_type set to 'none', headers will NOT be sent!" + warn "header_props called while header_type set to 'none', headers will NOT be sent!" } # Is it a hash, or hash-ref? if (ref($data[0]) eq 'HASH') { @@ -661,7 +681,7 @@ sub _send_psgi_headers { # Make all hash keys CAPITAL # although this method is internal, some other extensions # have come to rely on it, so any changes here should be -# made with great care or avoided. +# made with great care or avoided. sub _cap_hash { my $self = shift; my $rhash = shift; @@ -733,10 +753,10 @@ environments, and a high performance choice in persistent environments like FastCGI or mod_perl. By adding L as your needs grow, you can add advanced and complex -features when you need them. +features when you need them. First released in 2000 and used and expanded by a number of professional -website developers, CGI::Application is a stable, reliable choice. +website developers, CGI::Application is a stable, reliable choice. =head1 USAGE EXAMPLE @@ -908,7 +928,7 @@ CGI::Application will run equally well on NT/IIS or any other CGI-compatible environment. CGI::Application-based projects are, however, ripe for use on Apache/mod_perl servers, as they naturally encourage Good Programming Practices and will often work -in persistent environments without modification. +in persistent environments without modification. For more information on using CGI::Application with mod_perl, please see our website at http://www.cgi-app.org/, as well as @@ -919,7 +939,7 @@ L, which integrates with L. It is intended that your Application Module will be implemented as a sub-class of CGI::Application. This is done simply as follows: - package My::App; + package My::App; use base 'CGI::Application'; B @@ -987,7 +1007,7 @@ design allows you to define project wide configuration objects used by many several instance scripts. There are several plugins which simplify the syntax for this and provide lazy loading. Here's an example using L, which uses L to support -many configuration file formats. +many configuration file formats. my $app = WebApp->new(PARAMS => { cfg_file => 'config.pl' }); @@ -1080,6 +1100,32 @@ The final result might look like this: $webapp->run_as_psgi; }; +=head2 Additional PSGI Return Values + +The PSGI Specification allows for returning a file handle or a subroutine reference instead of byte strings. In PSGI mode this is supported directly by CGI::Application. Have your run mode return a file handle or compatible subref as follows: + + sub returning_a_file_handle { + my $self = shift; + + $self->header_props(-type => 'text/plain'); + + open my $fh, "<", 'test_file.txt' or die "OOPS! $!"; + + return $fh; + } + + sub returning_a_subref { + my $self = shift; + + $self->header_props(-type => 'text/plain'); + return sub { + my $writer = shift; + foreach my $i (1..10) { + #sleep 1; + $writer->write("check $i: " . time . "\n"); + } + }; + } =head2 Methods to possibly override @@ -1118,7 +1164,7 @@ Your setup() method might be implemented something like this: } However, often times all that needs to be in setup() is defining your run modes -and your start mode. L allows you to do +and your start mode. L allows you to do this with a simple syntax, using run mode attributes: use CGI::Application::Plugin::AutoRunmode; @@ -1270,19 +1316,19 @@ modes, and when a C is a particular value. my $q = $webapp->cgiapp_get_query; Override this method to retrieve the query object if you wish to use a -different query interface instead of CGI.pm. +different query interface instead of CGI.pm. CGI.pm is only loaded if it is used on a given request. If you can use an alternative to CGI.pm, it needs to have some compatibility with the CGI.pm API. For normal use, just having a compatible C method -should be sufficient. +should be sufficient. If you use the C option to the mode_param() method, then we will call the C method on the query object. If you use the C method in CGI::Application, we will call the C and -C methods on the query object. +C methods on the query object. =head2 Essential Application Methods @@ -1299,7 +1345,7 @@ of them to get any application up and running. These functions are listed in al my $tmpl_obj = $webapp->load_tmpl( FILEHANDLE ); This method takes the name of a template file, a reference to template data -or a FILEHANDLE and returns an HTML::Template object. If the filename is undefined or missing, CGI::Application will default to trying to use the current run mode name, plus the extension ".html". +or a FILEHANDLE and returns an HTML::Template object. If the filename is undefined or missing, CGI::Application will default to trying to use the current run mode name, plus the extension ".html". If you use the default template naming system, you should also use L, which simply helps to keep the current @@ -1343,13 +1389,13 @@ If your application requires more specialized behavior than this, you can always replace it by overriding load_tmpl() by implementing your own load_tmpl() in your CGI::Application sub-class application module. -First, you may want to check out the template related plugins. +First, you may want to check out the template related plugins. L focuses just on Template Toolkit integration, and features pre-and-post features, singleton support and more. L can help if you want to return a stream and -not a file. It features a simple syntax and MIME-type detection. +not a file. It features a simple syntax and MIME-type detection. B @@ -1364,14 +1410,14 @@ provide at least the following parts of the HTML::Template API: $t = $class->new( scalarref => ... ); # If you use scalarref templates $t = $class->new( filehandle => ... ); # If you use filehandle templates $t = $class->new( filename => ... ); - $t->param(...); + $t->param(...); Here's an example case allowing you to precisely test what's sent to your templates: $ENV{CGI_APP_RETURN_ONLY} = 1; my $webapp = WebApp->new; - $webapp->html_tmpl_class('HTML::Template::Dumper'); + $webapp->html_tmpl_class('HTML::Template::Dumper'); my $out_str = $webapp->run; my $tmpl_href = eval "$out_str"; @@ -1391,20 +1437,20 @@ will be executed just before load_tmpl() returns: $self->add_callback('load_tmpl',\&your_method); -When C is executed, it will be passed three arguments: +When C is executed, it will be passed three arguments: 1. A hash reference of the extra params passed into C - 2. Followed by a hash reference to template parameters. - With both of these, you can modify them by reference to affect + 2. Followed by a hash reference to template parameters. + With both of these, you can modify them by reference to affect values that are actually passed to the new() and param() methods of the template object. - 3. The name of the template file. + 3. The name of the template file. -Here's an example stub for a load_tmpl() callback: +Here's an example stub for a load_tmpl() callback: sub my_load_tmpl_callback { my ($c, $ht_params, $tmpl_params, $tmpl_file) = @_ - # modify $ht_params or $tmpl_params by reference... + # modify $ht_params or $tmpl_params by reference... } =head3 param() @@ -1469,8 +1515,8 @@ If, for some reason, you want to use your own CGI query object, the new() method supports passing in your existing query object on construction using the QUERY attribute. -There are a few rare situations where you want your own query object to be -used after your Application Module has already been constructed. In that case +There are a few rare situations where you want your own query object to be +used after your Application Module has already been constructed. In that case you can pass it to c like this: $webapp->query($new_query_object); @@ -1486,13 +1532,13 @@ you can pass it to c like this: # With a hashref, use a different name or a code ref $webapp->run_modes( - 'mode1' => 'some_sub_by_name', + 'mode1' => 'some_sub_by_name', 'mode2' => \&some_other_sub_by_ref ); This accessor/mutator specifies the dispatch table for the -application states, using the syntax examples above. It returns -the dispatch table as a hash. +application states, using the syntax examples above. It returns +the dispatch table as a hash. The run_modes() method may be called more than once. Additional values passed into run_modes() will be added to the run modes table. In the case that an @@ -1617,7 +1663,7 @@ pass in a text scalar or an array reference of multiple paths. =head2 More Application Methods -You can skip this section if you are just getting started. +You can skip this section if you are just getting started. The following additional methods are inherited from CGI::Application, and are available to be called by your application within your Application Module. @@ -1665,7 +1711,7 @@ as a run mode, passing $@ as the only parameter. Plugins authors will be interested to know that just before C is called, the C hook will be executed, with the error message passed in as -the only parameter. +the only parameter. No C is defined by default. The death of your C run mode is not trapped, so you can also use it to die in your own special way. @@ -1712,8 +1758,8 @@ been set. # clobber / reset all headers %set_headers = $webapp->header_props({}); - # Just retrieve the headers - %set_headers = $webapp->header_props(); + # Just retrieve the headers + %set_headers = $webapp->header_props(); The C method expects a hash of CGI.pm-compatible HTTP header properties. These properties will be passed directly @@ -1749,15 +1795,15 @@ the HTTP header properly. $webapp->header_type('none'); This method used to declare that you are setting a redirection header, -or that you want no header to be returned by the framework. +or that you want no header to be returned by the framework. -The value of 'header' is almost never used, as it is the default. +The value of 'header' is almost never used, as it is the default. B: sub some_redirect_mode { my $self = shift; - # do stuff here.... + # do stuff here.... $self->header_type('redirect'); $self->header_props(-url=> "http://site/path/doc.html" ); } @@ -1775,7 +1821,7 @@ for a cron script! =cut -sub html_tmpl_class { +sub html_tmpl_class { my $self = shift; my $tmpl_class = shift; @@ -1817,7 +1863,7 @@ sub load_tmpl { # Define a default template name based on the current run mode unless (defined $tmpl_file) { - $tmpl_file = $self->get_current_runmode . $self->{__CURRENT_TMPL_EXTENSION}; + $tmpl_file = $self->get_current_runmode . $self->{__CURRENT_TMPL_EXTENSION}; } $self->call_hook('load_tmpl', \%ht_params, \%tmpl_params, $tmpl_file); @@ -1898,7 +1944,7 @@ This also demonstrates that you don't need to pass in the C hash key. It still default to C. You can also set C to a negative value. This works just like a negative -list index: if it is -1 the run mode name will be taken from the last part of +list index: if it is -1 the run mode name will be taken from the last part of $ENV{PATH_INFO}, if it is -2, the one before that, and so on. @@ -1917,7 +1963,7 @@ example form submission using this syntax:
- + Here the run mode would be set to "edit_form". Here's another example with a query string: @@ -1954,9 +2000,9 @@ sub mode_param { my $idx = $p{path_info}; # two cases: negative or positive index # negative index counts from the end of path_info - # positive index needs to be fixed because + # positive index needs to be fixed because # computer scientists like to start counting from zero. - $idx -= 1 if ($idx > 0) ; + $idx -= 1 if ($idx > 0) ; # remove the leading slash $pi =~ s!^/!!; @@ -2025,7 +2071,7 @@ prerun_mode() elsewhere, such as in setup() or a run mode method. =head2 Dispatching Clean URIs to run modes Modern web frameworks dispense with cruft in URIs, providing in clean -URIs instead. Instead of: +URIs instead. Instead of: /cgi-bin/item.cgi?rm=view&id=15 @@ -2040,9 +2086,9 @@ layer you can fairly easily add to an application later. =head2 Offline website development You can work on your CGI::Application project on your desktop or laptop without -installing a full-featured web-server like Apache. Instead, install +installing a full-featured web-server like Apache. Instead, install L from CPAN. After a few minutes of setup, you'll -have your own private application server up and running. +have your own private application server up and running. =head2 Automated Testing @@ -2050,21 +2096,21 @@ There a couple of testing modules specifically made for CGI::Application. L allows functional testing of a CGI::App-based project without starting a web server. L could be used to test the app -through a real web server. +through a real web server. L is similar, but uses Selenium for the testing, meaning that a local web-browser would be used, allowing testing of websites that contain JavaScript. Direct testing is also easy. CGI::Application will normally print the output of it's -run modes directly to STDOUT. This can be suppressed with an enviroment variable, +run modes directly to STDOUT. This can be suppressed with an enviroment variable, CGI_APP_RETURN_ONLY. For example: $ENV{CGI_APP_RETURN_ONLY} = 1; $output = $webapp->run(); like($output, qr/good/, "output is good"); -Examples of this style can be seen in our own test suite. +Examples of this style can be seen in our own test suite. =head1 PLUG-INS @@ -2073,30 +2119,30 @@ to develop new plug-ins for. =head2 Recommended Plug-ins -The following plugins are recommended for general purpose web/db development: +The following plugins are recommended for general purpose web/db development: =over 4 -=item * +=item * -L - is a simple plugin to provide a shorter syntax for executing a redirect. +L - is a simple plugin to provide a shorter syntax for executing a redirect. =item * -L - Keeping your config details in a separate file is recommended for every project. This one integrates with L. Several more config plugin options are listed below. +L - Keeping your config details in a separate file is recommended for every project. This one integrates with L. Several more config plugin options are listed below. =item * -L - Provides easy management of one or more database handles and can delay making the database connection until the moment it is actually used. +L - Provides easy management of one or more database handles and can delay making the database connection until the moment it is actually used. =item * -L - makes it a breeze to fill in an HTML form from data originating from a CGI query or a database record. +L - makes it a breeze to fill in an HTML form from data originating from a CGI query or a database record. =item * L - For a project that requires session -management, this plugin provides a useful wrapper around L +management, this plugin provides a useful wrapper around L =item * @@ -2121,9 +2167,9 @@ L - Use any templating system from within L - Use Apache::* modules without interference -=item * +=item * -L - Automatically register runmodes +L - Automatically register runmodes =item * @@ -2138,7 +2184,7 @@ L - Integration with L - Integration with L. -=item * +=item * L - Add Gzip compression @@ -2155,7 +2201,7 @@ L - Help stream files to the browser L - Allows for more of an ASP-style code structure, with the difference that code and HTML for each screen are in -separate files. +separate files. =item * @@ -2330,7 +2376,7 @@ at the given hook. It is used in conjunction with the C method which allows you to create a new hook location. The first argument to C is the hook name. Any remaining arguments -are passed to every callback executed at the hook location. So, a stub for a +are passed to every callback executed at the hook location. So, a stub for a callback at the 'pretemplate' hook would look like this: sub my_hook { @@ -2461,8 +2507,8 @@ send a blank message to "cgiapp-subscribe@lists.erlbaum.net". B -You can also drop by C<#cgiapp> on C with a good chance of finding -some people involved with the project there. +You can also drop by C<#cgiapp> on C with a good chance of finding +some people involved with the project there. B @@ -2474,11 +2520,11 @@ This project is managed using git and is available on Github: =over 4 -=item o +=item o L -=item o +=item o L @@ -2513,7 +2559,7 @@ the numerous contributors documented in the Changes file. =head1 CREDITS CGI::Application was originally developed by The Erlbaum Group, a software -engineering and consulting firm in New York City. +engineering and consulting firm in New York City. Thanks to Vanguard Media (http://www.vm.com) for funding the initial development of this library and for encouraging Jesse Erlbaum to release it to diff --git a/t/lib/TestApp_PSGI_Callback.pm b/t/lib/TestApp_PSGI_Callback.pm new file mode 100644 index 0000000..a5af140 --- /dev/null +++ b/t/lib/TestApp_PSGI_Callback.pm @@ -0,0 +1,40 @@ +package TestApp_PSGI_Callback; +use base qw(CGI::Application); + +sub setup { + my $self = shift; + $self->start_mode('test'); + $self->mode_param('rm'); + $self->run_modes([qw/test file_handle callback_subref/]) +} + +sub test { + return "test"; +} + +sub file_handle { + my $self = shift; + + my $test_file = 't/test_file_to_stream.txt'; + + open my $fh, "<", $test_file or die "OOPS! $!"; + + $self->header_props(-type => 'text/plain'); + + return $fh; +} + +sub callback_subref { + my $self = shift; + + $self->header_props(-type => 'text/plain'); + return sub { + my $writer = shift; + foreach my $i (1..10) { + #sleep 1; + $writer->write("check $i: " . time . "\n"); + } + }; +} + +1; diff --git a/t/psgi_streaming_callback.t b/t/psgi_streaming_callback.t new file mode 100644 index 0000000..6c10c8f --- /dev/null +++ b/t/psgi_streaming_callback.t @@ -0,0 +1,105 @@ +use lib "t/lib"; +use Test::More tests => 18; +#use Plack::Test; +use Test::Requires qw(Plack::Loader LWP::UserAgent); +use Test::TCP; + +use TestApp_PSGI_Callback; +use CGI::Application::PSGI; + +my $test_file = 't/test_file_to_stream.txt'; + +diag "this first test does not use CGI::App but provides a benchmark to how how streaming callback works in plain old psgi"; + +test_tcp( + client => sub { + my $port = shift; + my $ua = LWP::UserAgent->new; + my $res = $ua->get("http://127.0.0.1:$port/"); + like $res->content, qr/check 1: \d+\n/; + like $res->content, qr/check 5: \d+\n/; + unlike $res->content, qr/Content-Type/, "No headers"; + like $res->content_type, qr/plain/; + }, + server => sub { + my $port = shift; + Plack::Loader->auto(port => $port)->run(sub { + my $env = shift; + return sub { + my $respond = shift; + use Data::Dumper; + my $w = $respond->([ 200, ['X-Foo' => 'bar', 'Content-Type' => 'text/plain'] ]); + foreach my $i (1..5) { + #sleep 1; + $w->write("check $i: " . time . "\n"); + } + }; + }); + }, +); + +diag "another test this time returning a file handle"; + +test_tcp( + client => sub { + my $port = shift; + my $ua = LWP::UserAgent->new; + my $res = $ua->get("http://127.0.0.1:$port/"); + like $res->content, qr/test 1\n/; + like $res->content, qr/test 3\n/; + unlike $res->content, qr/Content-Type/, "No headers"; + like $res->content_type, qr/plain/; + is $res->content_length, 21; + }, + server => sub { + my $port = shift; + Plack::Loader->auto(port => $port)->run(sub { + open my $fh, "<", $test_file or die "OOPS! $!"; + return [ 200, ['X-Foo' => 'bar', 'Content-Type' => 'text/plain'], $fh]; + }); + }, +); + +diag "now do streaming with CGI::Application - return file handle"; +test_tcp( + client => sub { + my $port = shift; + my $ua = LWP::UserAgent->new; + my $res = $ua->get("http://127.0.0.1:$port/?rm=file_handle"); + like $res->content, qr/test 1+\n/; + like $res->content, qr/test 3\n/; + unlike $res->content, qr/Content-Type/, "No headers"; + like $res->content_type, qr/plain/; + is $res->content_length, 21; + }, + server => sub { + my $port = shift; + Plack::Loader->auto(port => $port)->run(sub { + my $env = shift; + my $cgiapp = TestApp_PSGI_Callback->new({ QUERY => CGI::PSGI->new($env) }); + return $cgiapp->run_as_psgi; + }); + }, +); + +diag "now do streaming with CGI::Application - return subref"; +test_tcp( + client => sub { + my $port = shift; + my $ua = LWP::UserAgent->new; + my $res = $ua->get("http://127.0.0.1:$port/?rm=callback_subref"); + like $res->content, qr/check 1: \d+\n/; + like $res->content, qr/check 5: \d+\n/; + unlike $res->content, qr/Content-Type/, "No headers"; + like $res->content_type, qr/plain/; + }, + server => sub { + my $port = shift; + Plack::Loader->auto(port => $port)->run(sub { + my $env = shift; + my $cgiapp = TestApp_PSGI_Callback->new({ QUERY => CGI::PSGI->new($env) }); + return $cgiapp->run_as_psgi; + }); + }, +); + diff --git a/t/test_file_to_stream.txt b/t/test_file_to_stream.txt new file mode 100644 index 0000000..241483b --- /dev/null +++ b/t/test_file_to_stream.txt @@ -0,0 +1,3 @@ +test 1 +test 2 +test 3