view release on metacpan or  search on metacpan

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

sub ErrorDocument {
    my($self, $error_code, $uri) = @_;
    $self->{'r'}->custom_response($error_code, $uri); 
}

sub SessionQueryParse {
    my $self = shift;

    # OPTIMIZE MATCH: a is first in the sort, so this is fairly well optimized, 
    # putting img up at the front doesn't seem to make a different in the speed
    my $tags_grep = join('|', sort keys %LinkTags); 
    my $new_content = ''; # we are going to rebuild this content
    my $content_ref = $self->{out};
    my $asp = $self->{asp};    
    $asp->{dbg} && $asp->Debug("parsing session id into url query strings");

    # update quoted links in script location.href settings too
    # if not quoted, then maybe script expressions
    $$content_ref =~ 
      s/(\<script.*?\>[^\<]*location\.href\s*\=[\"\'])([^\"\']+?)([\"\'])
	/$1.&SessionQueryParseURL($self, $2).$3
	  /isgex;
    
    while(1) {
	# my emacs perl mode doesn't like ${$doc->{content}}
	last unless ($$content_ref =~ s/
		     ^(.*?)               # html head 
		     \<                   # start
		     \s*($tags_grep)\s+  # tag itself
		     ([^>]+)              # descriptors    
		     \>                   # end
		     //isxo
		     );
	
	my($head, $tag, $temp_attribs) = ($1, lc($2), $3);
	my $element = "<$2 $temp_attribs>";	
	my %attribs;
	
	while($temp_attribs =~ s/^\s*([^\s=]+)\s*\=?//so) {
	    my $key = lc $1;
	    my $value;
	    if($temp_attribs =~ s/^\s*\"([^\"]*)\"\s*//so) {
		$value = $1;
	    } elsif ($temp_attribs =~ s/^\s*\'([^\']*)\'\s*//so) {
		# apparently browsers support single quoting values
		$value = $1;
	    } elsif($temp_attribs =~ s/^\s*([^\s]*)\s*//so) {
		# sometimes there are mal-formed URL's
		$value = $1;
		$value =~ s/\"//sgo;
	    }
	    $attribs{$key} = $value;
	}
	
	# GET URL from tag attribs finally
	my $rel_url = $attribs{$LinkTags{$tag}};
#	$asp->Debug($rel_url, $element, \%attribs);
	if(defined $rel_url) {
	    my $new_url = &SessionQueryParseURL($self, $rel_url);
	    # escape all special characters so they are not interpreted
	    if($new_url ne $rel_url) {
		$rel_url =~ s/([\W])/\\$1/sg;
		$element =~ s|($LinkTags{$tag}\s*\=\s*[\"\']?)$rel_url|$1$new_url|isg;
#		$asp->Debug("parsed new element $element");
	    }
	}
	
	$new_content .= $head . $element;
    }
    
#    $asp->Debug($$content_ref);
    $new_content .= $$content_ref;
    $$content_ref = $new_content;
    1;
}

sub SessionQueryParseURL {
    my($self, $rel_url) = @_;
    my $asp = $self->{asp};    
    my $match = $asp->{session_url_parse_match};

    if(
       # if we have match expression, try it
       ($match && $rel_url =~ /$match/)
       # then if server path, check matches cookie space 
       || ($rel_url =~ m|^/| and $rel_url =~ m|^$asp->{cookie_path}|)
       # then do all local paths, matching NOT some URI PROTO
       || ($rel_url !~ m|^[^\?\/]+?:|)
      )
      {
	  my($query, $new_url, $frag);
	  if($rel_url =~ /^([^\?]+)(\?([^\#]*))?(\#.*)?$/) {
              $new_url = $1;
              $query = defined $3 ? $3 : '';
	      $frag = $4;
	  } else {
	      $new_url = $rel_url;
	      $query = '';
	  }

	  # for the split, we do not need to handle other entity references besides &amp;
	  # because &, =, and ; should be the only special characters in the query string
	  # and the only of these characters that are represented by an entity reference
	  # is & as &amp; ... the rest of the special characters that might be encoded 
	  # in a URL should be URI escaped
	  # --jc 2/10/2003
	  my @new_query_parts;
	  map {
	      (! /^$Apache::ASP::SessionCookieName\=/) && push(@new_query_parts, $_);
	  }
	    split(/&amp;|&/, $query);

	  my $new_query = join('&amp;', 
			       @new_query_parts,
			       $Apache::ASP::SessionCookieName.'='.$asp->{session_id}
			      );
	  $new_url .= '?'.$new_query;
	  if($frag) {
	      $new_url .= $frag;
	  }
	  $asp->{dbg} && $asp->Debug("parsed session into $new_url");
	  $new_url;
      } else {
	  $rel_url;
      }
}

*config = *Apache::ASP::config;

1;