package Apache::AxKit::Pipeline::Trace;

use strict;
use vars qw/@ISA $VERSION %DEPENDS/;
use Apache;
use AxKit;
use Apache::Request;
use Apache::AxKit::Pipeline;
use Apache::AxKit::Cache;
use File::Basename qw(dirname);

@ISA = 'Apache::AxKit::Pipeline';

$VERSION = 1.0; # this fixes a CPAN.pm bug. Bah!


sub new{
	my $class = shift;
	my $self = $class->SUPER::new( @_ ) ;
	$self->{'interm_prefix'} = undef;
	
	return $self;
}

sub get_dom {
    my $self = shift;
    my $r = shift;
    my $xmldoc = $self->upstream()->get_dom( $r );
	local $XML::LibXML::setTagCompression = 1;
	my $xmlstr = $xmldoc->toString(1) || "<?xml version='1.0'?>\n<empty reason='no data found'/>\n";
	
	$self->write_trace( $r, $xmlstr);	
	return $xmldoc;
}

sub get_bytes_ref{
    my $self = shift;
    my $r = shift;
    my $bytes = $self->upstream()->get_bytes_ref( $r );
	$self->write_trace( $r, ${$bytes});	
	return $bytes;
}

sub get_strref{
    my $self = shift;
    my $r = shift;
	my $str =  $self->upstream()->get_strref( $r );

	my $xmlstr = ${$str} || "<?xml version='1.0'?>\n<empty reason='no data found'/>\n";

	if( $AxKit::Cfg->DebugTidy ) {
		eval {
			require XML::LibXML;
			my $parser = new XML::LibXML();
			$parser->keep_blanks(0);
			local $XML::LibXML::setTagCompression = 1;
			$xmlstr = $parser->parse_string($xmlstr,$r->uri)->toString(1);
		};
	
	    AxKit::Debug(1,"AxDebugTidy unavailable: $@") if $@;
	}

	$self->write_trace( $r, $xmlstr );
	
	return $str;
}


sub write_trace{
	my $self = shift;
	my ($r, $xml) = @_;
	my $fh = Apache->gensym();
	
	my $fn = $self->interm_prefix($r) . $self->stage();
	if(AxKit::open($fh,">$fn")) {
		print $fh $xml;
		close($fh);
	}
}


sub interm_prefix{
	my $self = shift;
	my $r = shift;

	unless($self->{'interm_prefix'}) {
	    my $interm_prefix;
        my $id = $r->notes('AxRequestID');
        $interm_prefix = ($id?$id:$r->uri);
        $interm_prefix =~ s{%}{%25}g;
        $interm_prefix =~ s{/}{%2f}g;
        my $ti = $AxKit::Cfg->TraceIntermediate;
        if (defined $id) {
                $interm_prefix = substr($interm_prefix,-1).'/'.substr($interm_prefix,-3,2).'/'.substr($interm_prefix,0,-3).'/';
                mkdir($ti.'/'.substr($interm_prefix,0,1),0777);
                mkdir($ti.'/'.substr($interm_prefix,0,4),0777);
                mkdir($ti.'/'.$interm_prefix,0777);
        } else {
                $interm_prefix =~ s/[^0-9a-zA-Z.,_|-]/_/g;
                $interm_prefix .= '.';
        }
		$self->{'interm_prefix'} = $ti.'/'.$interm_prefix;
		
		if( ! -d $ti) {
			if( !mkdir($ti, 0777)) {
				AxKit::Debug(1, "Can't create AxTraceIntermediate directory '$ti': $!");
			}
		}
		
	}
	return $self->{'interm_prefix'};
}
    

1;
