view release on metacpan or  search on metacpan

lib/Apache2/AutoIndex/XSLT.pm  view on Meta::CPAN

				File::Spec->catfile($r->document_root,$dir_cfg->{FileTypesFilename}),
				File::Spec->catfile(Apache2::ServerUtil->server_root,'conf',$dir_cfg->{FileTypesFilename}),
				File::Spec->catfile(Apache2::ServerUtil->server_root,$dir_cfg->{FileTypesFilename})
			) {
			my $ext = '';
			if (open(FH,'<',$FileTypesFilename)) {
				while (local $_ = <FH>) {
					if (my ($k,$v) = $_ =~ /^\s*(\S+)\s*:\s*(\S.*?)\s*$/) {
						if ($k =~ /ext(ension)?/i) {
							$v =~ s/^\.//;
							$ext = $v || '';
						} elsif ($v) {
							$FILETYPES{lc($ext)}->{$k} = $v;
						}
					}
				}
				close(FH);
				last FileTypesFilename;
			}
		}
	}

	# Dump the configuration out to screen
	if (defined $qstring->{CONFIG}) {
		$r->content_type('text/plain');
		$r->print(dump_apache_configuration($r));
		return Apache2::Const::OK;
	}

	# Make sure we're at a URL with a trailing slash
	if ($dir_cfg->{DirectorySlash} && $r->uri !~ m,/$,) {# || $r->path_info){
		$r->headers_out->add(Location => sprintf('%s/%s',
				$r->uri,
				($r->args ? '?'.$r->args : '')
			));
		return Apache2::Const::REDIRECT;
	}

	# Return a directory listing if we're allowed to
	if ($r->allow_options & Apache2::Const::OPT_INDEXES) {

		# Should we render the XSLT or not?
		my $render = 0;
		if ($dir_cfg->{RenderXSLT} ||
			(!exists $dir_cfg->{RenderXSLT} && 
			defined $dir_cfg->{RenderXSLTEnvVar} &&
			defined $ENV{$dir_cfg->{RenderXSLTEnvVar}} &&
			$ENV{$dir_cfg->{RenderXSLTEnvVar}} =~ /^\s*(On|1|Yes|True)\s*$/i)
				) {
			eval {
				require XML::LibXSLT;
				require XML::LibXML;
				$render = 1;
			};
			$r->log_error('Failed to load XML::LibXML or XML::LibXSLT modules: ', $@) if $@;
		}

		# Send the appropriate content type
		my $content_type = $render
					? 'text/html'
					: 'text/xml; charset="utf-8"';
		$r->content_type($content_type);
		return Apache2::Const::OK if $r->header_only;

		# The dir_xml subroutine will actually print and output
		# all the XML DTD and XML, returning an OK if everything
		# was successful.
		my $rtn = Apache2::Const::SERVER_ERROR;
		my $xml;
		eval {
			$xml = dir_xml($r,$dir_cfg,$qstring);
			unless ($render) {
				$r->print($xml);
			} else {
				my $parser = XML::LibXML->new();
				my $source = $parser->parse_string($xml);

				my $subr = $r->lookup_uri($dir_cfg->{IndexStyleSheet});
				my $xslt = XML::LibXSLT->new();
				my $style_doc = $parser->parse_file($subr->filename);

				my $stylesheet = $xslt->parse_stylesheet($style_doc);
				my $results = $stylesheet->transform($source);
				$r->print($stylesheet->output_string($results));
			}
			$rtn = Apache2::Const::OK;
		};
		if (!defined $xml || $@) {
			$COUNTERS{Errors}++;
			warn $@, $r->print($@);
		};
		return $rtn;

	# Otherwise he's not the messiah, he's a very naughty boy
	} else {
		$r->log_reason(
				sprintf('%s Directory index forbidden by rule', __PACKAGE__),
				sprintf('%s (%s)', $r->uri, $r->filename),
			);
		return Apache2::Const::FORBIDDEN;
	}
}


sub transhandler {
	my $r = shift;

	# Only handle directories
	return Apache2::Const::DECLINED unless $r->uri =~ /\/$/;
	return Apache2::Const::DECLINED unless $r->content_type &&
			$r->content_type eq Apache2::Const::DIR_MAGIC_TYPE;

	# Parse query string and get config
	my ($qstring,$dir_cfg) = init_handler($r);

	foreach (@{$dir_cfg->{DirectoryIndex}}){
		my $subr = $r->lookup_uri($r->uri . $_);
		last if $subr->path_info;
		if (stat $subr->finfo){
			$r->uri($subr->uri);
			last;