view release on metacpan or  search on metacpan

lib/CGI/Portable/AdapterCGI.pm  view on Meta::CPAN

=head2 send_user_output( GLOBALS )

This method takes a CGI::Portable object as its first argument, GLOBALS, and 
sends to the user as much of the HTTP response and user output details that it 
can get from the object.

=head2 send_quick_html_response( CONTENT )

This method takes a string containing an HTML document as its first argument, 
CONTENT, and sends an http response appropriate for an HTML document which 
includes CONTENT as the http body.

=head2 send_quick_redirect_response( URL )

This method takes a string containing an url as its first argument, URL, and 
sends an http redirection header to send the client browser to that url.

=cut

######################################################################

sub send_user_output {
	my ($self, $globals) = @_;
	my $status = $globals->http_status_code() || '200 OK';
	my $target = $globals->http_window_target();
	my $type = $globals->http_content_type() || 'text/html';
	my $url = $globals->http_redirect_url();
	my @cookies = $globals->get_http_cookies();
	my %misc = $globals->get_http_headers();
	my $content = $globals->http_body() || $globals->page_as_string();
	my $binary = $globals->http_body_is_binary();
	$self->_send_output( $status, $type, $url, $target, $content, $binary, 
		\@cookies, \%misc );
}

sub send_quick_html_response {
	my ($self, $content) = @_;
	$self->_send_output( '200 OK', 'text/html', undef, undef, $content );
}

sub send_quick_redirect_response {
	my ($self, $url) = @_;
	$self->_send_output( '301 Moved', undef, $url );
}

# _send_output( STATUS, TYPE, [URL, [TARGET[, CONTENT[, IS_BINARY[, 
#    COOKIES[, MISC]]]]]] )
# This private method is used to implement all the send_*() methods above, 
# and works under both mod_perl and cgi.  It currently does not support NPH 
# responses but that should be added in the future.

sub _send_output {
	my ($self, $status, $type, $url, $target, $content, $is_binary, 
		$cook, $misc) = @_;
	ref($cook) eq 'ARRAY' or $cook = [];
	ref($misc) eq 'HASH' or $misc = {};

	my @header = ("Status: $status");
	$target and push( @header, "Window-Target: $target" );
	@{$cook} and push( @header, map { "Set-Cookie: $_" } @{$cook} );
	push( @header, $url ? "Location: $url" : "Content-Type: $type" );
	%{$misc} and push( @header, map { "$_: $misc->{$_}" } sort keys %{$misc} );
	my $endl = "\015\012";  # cr + lf
	my $header = join( $endl, @header ).$endl.$endl;

	if( $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl/ ) {
		require Apache;
		$| = 1;
		my $req = Apache->request();
		$req->send_cgi_header( $header );

	} else {
		print STDOUT $header;
	}

	$is_binary and binmode( STDOUT );
	print STDOUT $content;
}

######################################################################

1;
__END__

=head1 AUTHOR

Copyright (c) 1999-2004, Darren R. Duncan.  All rights reserved.  This module
is free software; you can redistribute it and/or modify it under the same terms
as Perl itself.  However, I do request that this copyright information and
credits remain attached to the file.  If you modify this module and
redistribute a changed version then please attach a note listing the
modifications.  This module is available "as-is" and the author can not be held
accountable for any problems resulting from its use.

I am always interested in knowing how my work helps others, so if you put this
module to use in any of your own products or services then I would appreciate
(but not require) it if you send me the website url for said product or
service, so I know who you are.  Also, if you make non-proprietary changes to
the module because it doesn't work the way you need, and you are willing to
make these freely available, then please send me a copy so that I can roll
desirable changes into the main release.

Address comments, suggestions, and bug reports to B<perl@DarrenDuncan.net>.

=head1 SEE ALSO

perl(1), CGI::Portable, Apache.

=cut