view release on metacpan or  search on metacpan

lib/Apache/ASP/Response.pm  view on Meta::CPAN

package Apache::ASP::Response;

use Apache::ASP::Collection;

use strict;
no strict qw(refs);
use vars qw(@ISA @Members %LinkTags $TextHTMLRegexp);
@ISA = qw(Apache::ASP::Collection);
use Carp qw(confess);
use Data::Dumper qw(DumperX);
use bytes;

@Members = qw( Buffer Clean ContentType Expires ExpiresAbsolute Status );

# used for session id auto parsing
%LinkTags = (
	     'a' => 'href',
	     'area' => 'href',
	     'form' => 'action',
	     'frame' => 'src',
	     'iframe' => 'src',
	     'img' => 'src',
	     'input' => 'src',
	     'link' => 'href',
	    );

$TextHTMLRegexp = '^text/html(;|$)';

sub new {
    my $asp = shift;

    my $r = $asp->{'r'};
    my $out = '';

    my $self = bless 
      {
       asp => $asp,
       out => \$out,
       # internal extension allowing various scripts like Session_OnStart
       # to end the same response
       #       Ended => 0, 
       CacheControl => 'private',
       CH => &config($asp, 'CgiHeaders') || 0,
       #       Charset => undef,
       Clean => &config($asp, 'Clean') || 0,
       Cookies => bless({}, 'Apache::ASP::Collection'),
       ContentType => 'text/html',
       'Debug' => $asp->{dbg},
       FormFill => &config($asp, 'FormFill'),
       IsClientConnected => 1,
       #       PICS => undef,
       #       Status => 200,
       #       header_buffer => '',
       #       header_done => 0,
       Buffer => &config($asp, 'BufferingOn', undef, 1),
       BinaryRef => \$out,
       CompressGzip => ($asp->{compressgzip} and ($asp->{headers_in}->get('Accept-Encoding') =~ /gzip/io)) ? 1 : 0,
       r => $r,
       headers_out => scalar($r->headers_out()),
      };

    &IsClientConnected($self); # update now

    $self;
}

sub DeprecatedMemberAccess {
    my($self, $member, $value) = @_;
    $self->{asp}->Out(
		      "\$Response->$member() deprecated.  Please access member ".
		      "directly with \$Response->{$member} notation"
		     );
    $self->{$member} = $value;
}

# defined the deprecated subs now, so we can loose the AUTOLOAD method
# the AUTOLOAD was forcing us to keep the DESTROY around
for my $member ( @Members ) {
    my $subdef = "sub $member { shift->DeprecatedMemberAccess('$member', shift); }";
    eval $subdef;
    if($@) {