view release on metacpan or  search on metacpan

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

The second argument, CLIENT, is an IO::Socket::INET object which is the client 
we will be sending our output to.

=head2 send_quick_html_response( CONTENT, CLIENT )

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.
The second argument, CLIENT, is an IO::Socket::INET object which is the client 
we will be sending our output to.

=head2 send_quick_redirect_response( URL, CLIENT )

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.
The second argument, CLIENT, is an IO::Socket::INET object which is the client 
we will be sending our output to.

=cut

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

sub send_user_output {
	my ($self, $globals, $client) = @_;
	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( $client, $status, $type, $url, $target, $content, 
		$binary, \@cookies, \%misc );
}

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

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

# _send_output( CLIENT, 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, $client, $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} );
	unshift( @header, "HTTP/1.0 $status" );

	my $endl = "\015\012";  # cr + lf
	my $header = join( $endl, @header ).$endl.$endl;

	$client->autoflush(1);
	print $client $header;
	$is_binary and binmode( $client );
	print $client $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, IO::Socket, IO::Socket::INET.

=cut