view release on metacpan or  search on metacpan

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

############################################################
#
#   $Id: XSLT.pm 1077 2007-12-14 17:44:32Z nicolaw $
#   Apache2::AutoIndex::XSLT - XSLT Based Directory Listings
#
#   Copyright 2006, 2007 Nicola Worthington
#
#   Licensed under the Apache License, Version 2.0 (the "License");
#   you may not use this file except in compliance with the License.
#   You may obtain a copy of the License at
#
#       http://www.apache.org/licenses/LICENSE-2.0
#
#   Unless required by applicable law or agreed to in writing, software
#   distributed under the License is distributed on an "AS IS" BASIS,
#   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   See the License for the specific language governing permissions and
#   limitations under the License.
#
############################################################

package Apache2::AutoIndex::XSLT;
# vim:ts=4:sw=4:tw=78

use 5.6.1;
use strict;
use warnings;
#use warnings FATAL => 'all';

use File::Spec qw();
use Fcntl qw();
use XML::Quote qw();
use URI::Escape qw(); # Try to replace with Apache2::Util or Apache2::URI

# This is libapreq2 - we're parsing the query string manually
# to avoid loading another non-standard module
# use Apache2::Request qw(); 

# These two are required in general
use Apache2::ServerRec qw(); # $r->server
use Apache2::RequestRec qw();
use Apache2::RequestUtil qw(); # $r->document_root

# Used to return various Apache constant response codes
use Apache2::Const -compile => qw(:common :options :config :cmd_how :override :types);

# Used for writing to Apache logs
use Apache2::Log qw();

# Used for parsing Apache configuration directives
use Apache2::Module qw();
use Apache2::CmdParms qw(); # Needed for use with Apache2::Module callbacks

# Used to get the main server Apache2::ServerRec (not the virtual ServerRec)
use Apache2::ServerUtil qw();

# Used for Apache2::Util::ht_time time formatting
use Apache2::Util qw();

use Apache2::URI qw(); # $r->construct_url
use Apache2::Access qw(); # $r->allow_options

#use Apache2::Directive qw();  # Possibly not needed
use Apache2::SubRequest qw(); # Needed for subrequests :)

use Apache2::RequestIO qw(); # Needed for $r->print

# Start here ...
# http://perl.apache.org/docs/2.0/user/config/custom.html
# http://perl.apache.org/docs/2.0/api/Apache2/Module.html
# http://perl.apache.org/docs/2.0/api/Apache2/Const.html
# http://perl.apache.org/docs/2.0/user/porting/compat.html
# http://httpd.apache.org/docs/2.2/mod/mod_autoindex.html
# http://httpd.apache.org/docs/2.2/mod/mod_dir.html
# http://www.modperl.com/book/chapters/ch8.html

use vars qw($VERSION %DIRECTIVES %COUNTERS %FILETYPES);
$VERSION = '0.04' || sprintf('%d.%02d', q$Revision: 531 $ =~ /(\d+)/g);
%COUNTERS = (Listings => 0, Files => 0, Directories => 0, Errors => 0);







#
# Apache response handler
#

sub handler {
	my $r = shift;

	# Only handle directories
	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);

	# Read in the filetypes information
	if (!defined %FILETYPES && defined $dir_cfg->{FileTypesFilename}) {
		FileTypesFilename: for my $FileTypesFilename (
				$dir_cfg->{FileTypesFilename},
				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*$/) {