view release on metacpan or  search on metacpan

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

	    $cookie->{Value} = join('&', @dict);
	}
	$data[0] = $server->URLEncode($cookie_name) . "=$cookie->{Value}";
	
	# have to clean the data now of undefined values, but
	# keeping the position is important to stick to the Cookie-Spec
	my @cookie;
	for(0..4) {	
	    next unless $data[$_];
	    push(@cookie, $data[$_]);
	}		
	my $cookie_header = join('; ', @cookie);

	$self->{r}->err_headers_out->add('Set-Cookie', $cookie_header);
	$dbg && $self->{asp}->Debug({cookie_header=>$cookie_header});
    }
}

# with the WriteRef vs. Write abstration, direct calls 
# to write might slow a little, but more common static 
# html calls to WriteRef will be saved the HTML copy
sub Write {
    my $self = shift;
    
    my $dataref;
    if(@_ > 1) {
	$, ||= ''; # non-standard use, so init here
	my $data = join($,, @_);
	$dataref = \$data;
    } else {
#	$_[0] ||= '';
	$dataref = defined($_[0]) ? \$_[0] : \'';
    }

	&WriteRef($self, $dataref);

    1;
}

# \'';

*Apache::ASP::WriteRef = *WriteRef;
sub WriteRef {
    my($self, $dataref) = @_;

    # allows us to end a response, but still execute code in event
    # handlers which might have output like Script_OnStart / Script_OnEnd
    return if $self->{Ended};
#    my $content_out = $self->{out};

    if($self->{CH}) {
	# CgiHeaders may change the reference to the dataref, because
	# dataref is a read-only scalar ref of static data, and CgiHeaders
	# may need to change it
	$dataref = $self->CgiHeaders($dataref);
    }

    # add dataref to buffer
    ${$self->{out}} .= $$dataref;
    
    #Encode::_utf8_on(${$self->{out}});
    
	#Encode::from_to(${$self->{out}}, "utf8", "iso-8859-1");
	
    # do we flush now?  not if we are buffering
    if(! $self->{'Buffer'} && ! $self->{'FormFill'}) {
	# we test for whether anything is in the buffer since
	# this way we can keep reading headers before flushing
	# them out
	&Flush($self);
    }

    1;
}
*write = *Write;

# alias printing to the response object
sub TIEHANDLE { $_[1]; }
*PRINT = *Write;
sub PRINTF {
    my($self, $format, @list) = @_;   
    my $output = sprintf($format, @list);
    $self->WriteRef(\$output);
}

sub CgiHeaders {
    my($self, $dataref) = @_;
    my $content_out = $self->{out};

    # work on the headers while the header hasn't been done
    # and while we don't have anything in the buffer yet
    #
    # also added a test for the content type being text/html or
    # 
    if($self->{CH} && ! $self->{header_done} && ! $$content_out 
       && ($self->{ContentType} =~ /$TextHTMLRegexp/o)) 
      {
	  # -1 to catch the null at the end maybe
	  my @headers = split(/\n/, $$dataref, -1); 
	  
	  # first do status line
	  my $status = $headers[0];
	  if($status =~ m|HTTP/\d\.\d\s*(\d*)|o) {
	      $self->{Status} = $1; 
	      shift @headers;
	  }
	  
	  while(@headers) {
	      my $out = shift @headers;
	      next unless $out; # skip the blank that comes after the last newline
	      
	      if($out =~ /^[^\s]+\: /) { # we are a header
		  unless(defined $self->{header_buffer}) {
		      $self->{header_buffer} .= '';
		  }
		  $self->{header_buffer} .= "$out\n";
	      } else {
		  unshift(@headers, $out);
		  last;
	      }
	  }
	  
	  # take remaining non-headers & set the data to them joined back up