png results from the CPAN

Apache2-AutoIndex-XSLT







#
# Private helper subroutines
#

sub init_handler {
	my $r = shift;

	# Get query string values - use this manual code instead of
	# Apache2::Request because it uses less memory, and Apache2::Request
	# does not come as standard with mod_perl2 (it's libapreq2 on CPAN)
	my $qstring = {};
	for (split(/[&;]/,($r->args||''))) {
		my ($k,$v) = split('=',$_,2);
		next unless defined $k;
		$v = '' unless defined $v;
		$qstring->{URI::Escape::uri_unescape($k)} =
			URI::Escape::uri_unescape($v);
	}

	# Get the configuration directives
	my $dir_cfg = get_config($r->server, $r->per_dir_config);

	return ($qstring,$dir_cfg);
}


sub dir_xml {
	my ($r,$dir_cfg,$qstring) = @_;
	my $xml = '';

	# Increment listings counter
	$COUNTERS{Listings}++;

	# Get directory to work on
	my $directory = $r->filename;
	$r->filename("$directory/") unless $directory =~ m/\/$/;

	# Open the physical directory on disk to get a list of all items inside.
	# This won't pick up virtual directories aliased in Apache's configs.
	my $dh;
	unless (opendir($dh,$directory)) {
		$r->log_reason(
				sprintf("%s Unable to open directory handle for '%s': %s",
					__PACKAGE__, $directory, $!),
				sprintf('%s (%s)', $r->uri, $directory),
			);
		return Apache2::Const::FORBIDDEN;
	}

	# Send the XML header and top of the index tree
	$xml .= xml_header($r,$dir_cfg);
	$xml .= sprintf("<index path=\"%s\" href=\"%s\" >\n",
				$r->uri, $r->construct_url);
	$xml .= xml_options($r,$qstring,$dir_cfg);
	$xml .= "\t<updir icon=\"/icons/__back.png\" />\n"
				unless $r->uri =~ m,^/?$,;

	# Build a list of attributes for each item in the directory and then
	# print it as an element in the index tree.
	while (my $id = readdir($dh)) {
		next if $id eq '..' || $id eq '.';
		next if grep($id =~ /^$_$/, @{$dir_cfg->{IndexIgnoreRegex}});
		#my $subr = $r->lookup_file($id); # Not used yet

		my $filename = File::Spec->catfile($directory,$id);
		my $type = file_type($r,$id,$filename);
		my $attr = build_attributes($r,$dir_cfg,$id,$filename,$type);

		$xml .= sprintf("\t<%s %s />\n", $type, join(' ',
					map { sprintf("\n\t\t%s=\"%s\"",$_,$attr->{$_})
							if defined $_ && defined $attr->{$_} }
						keys(%{$attr})
				));

		$COUNTERS{Files}++ if $type eq 'file';
		$COUNTERS{Directories}++ if $type eq 'dir';
	}

	# Close the index tree, directory handle and return
	$xml .= "</index>\n";
	closedir($dh);

	return $xml;
}


sub xml_options {
	my ($r,$qstring,$dir_cfg) = @_;
	my $xml = '';

	my $format = "\t\t<option name=\"%s\" value=\"%s\" />\n";
	$xml .= "\t<options>\n";

	# Query string options
	for my $option (qw(C O F V P)) {
		$xml .= sprintf($format,$option,$qstring->{$option})
			if defined $qstring->{$option} &&
				$qstring->{$option} =~ /\S+/;
	}

	# Apache configuration directives
	for my $d (keys %DIRECTIVES) {
		for my $value ((
			!exists($dir_cfg->{$d}) ? ()
								: ref($dir_cfg->{$d}) eq 'ARRAY'
								? @{$dir_cfg->{$d}}
								: ($dir_cfg->{$d})
				)) {
			# Don't bother printing stuff that we only have
			# some confusing internal complex data structure for
			$xml .= sprintf($format,$d,$value) unless ref($value);
		}
	}

	$xml .= "\t</options>\n";
	return $xml;
}


sub icon_by_extension {
	my ($r,$id,$ext,$dir_cfg) = @_;

	my $alt = '';
	my $icon =
		$ext && -f File::Spec->catfile($r->document_root,'icons',lc("$ext.png")) 
			? '/icons/'.lc("$ext.png")
			: $dir_cfg->{DefaultIcon} || '';

	while (my ($re,$v) = each %{$dir_cfg->{AddIconRegex}}) {
		if ($id =~ /$re$/) {
			($alt,$icon) = @{$v};
		}
	}

	return ($alt,$icon);
}


sub build_attributes {
	my ($r,$dir_cfg,$id,$filename,$type) = @_;
	return {} if $type eq 'updir';

	my $attr = stat_file($r,$filename);

	if ($type eq 'file') {
		($attr->{ext}) = $id =~ /\.([a-z0-9_]+)$/i;
		($attr->{alt},$attr->{icon}) = icon_by_extension($r,$id,$attr->{ext},$dir_cfg);

	} elsif ($type eq 'dir') {
		$attr->{alt} = 'DIR';
		$attr->{icon} = '/icons/__dir.png';
		if ($dir_cfg->{AddIconRegex}->{'^^DIRECTORY^^'}) {
			($attr->{alt},$attr->{icon}) =
				@{$dir_cfg->{AddIconRegex}->{'^^DIRECTORY^^'}};
		}

	} elsif ($type eq 'updir') {
		$attr->{icon} = '/icons/__back.png';
	}

	unless ($type eq 'updir') {
		#$attr->{id} = $id; # This serves no real purpose anymor
		$attr->{href} = URI::Escape::uri_escape($id);
		$attr->{href} .= '/' if $type eq 'dir';
		$attr->{title} = XML::Quote::xml_quote($id);

		$attr->{desc} = $type eq 'dir'
				? 'File Folder'
				: defined $attr->{ext}
					? sprintf('%s File',uc($attr->{ext}))
					: 'File';

		if (exists $dir_cfg->{AddDescription}->{$r->uri.URI::Escape::uri_escape($id)}) {
			$attr->{desc} = $dir_cfg->{AddDescription}->{$r->uri.URI::Escape::uri_escape($id)};
		} elsif (defined $FILETYPES{lc($attr->{ext})}->{DisplayName}) {
			$attr->{desc} = $FILETYPES{lc($attr->{ext})}->{DisplayName};
		}

		$attr->{desc} = XML::Quote::xml_quote($attr->{desc});
	}

	return $attr;
}


sub file_type {
	my ($r,$id,$file) = @_;
	return -d $file && $id eq '..' ? 'updir' : -d $file ? 'dir' : 'file';
}


sub xml_header {
	my ($r,$dir_cfg) = @_;
	my $xml = '';

	my $xslt = $dir_cfg->{IndexStyleSheet} || '';
	my $type = $xslt =~ /\.css/ ? 'text/css' : 'text/xsl';

	$xml .= qq{<?xml version="1.0"?>\n};
	$xml .= qq{<?xml-stylesheet type="$type" href="$xslt"?>\n} if $xslt;
	$xml .= qq{$_\n} for (
			'<!DOCTYPE index [',
			'  <!ELEMENT index (options?, updir?, (file | dir)*)>',
			'  <!ATTLIST index href      CDATA #REQUIRED',
			'                  path      CDATA #REQUIRED>',
			'  <!ELEMENT options (option*)>',
			'  <!ELEMENT option EMPTY>',
			'  <!ATTLIST option name     CDATA #REQUIRED',
			'                   value    CDATA #IMPLIED>',
			'  <!ELEMENT updir EMPTY>',
			'  <!ATTLIST updir icon      CDATA #IMPLIED>',
			'  <!ELEMENT file  EMPTY>',
			'  <!ATTLIST file  href      CDATA #REQUIRED',
			'                  title     CDATA #REQUIRED',
			'                  desc      CDATA #IMPLIED',
			'                  owner     CDATA #IMPLIED',
			'                  group     CDATA #IMPLIED',
			'                  uid       CDATA #REQUIRED',

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

sub SERVER_MERGE { merge(@_); }
sub DIR_MERGE { merge(@_); }

sub set_val {
	my ($key, $self, $parms, $arg) = @_;
	$self->{$key} = $arg;
	unless ($parms->path) {
		my $srv_cfg = Apache2::Module::get_config($self,$parms->server);
		$srv_cfg->{$key} = $arg;
	}
}
  
sub push_val {
	my ($key, $self, $parms, @args) = @_;
	push @{ $self->{$key} }, @args;
	unless ($parms->path) {
		my $srv_cfg = Apache2::Module::get_config($self,$parms->server);
		push @{ $srv_cfg->{$key} }, @args;
	}
}

sub add_to_key {
	my ($key, $self, $parms, $key2, @args) = @_;
	if (exists $self->{$key}->{$key2}) {
		$self->{$key}->{$key2} = [($self->{$key}->{$key2})]
			if !ref($self->{$key}->{$key2});
		push @{$self->{$key}->{$key2}}, @args;
	} else {
		if (@args > 1) { $self->{$key}->{$key2} = \@args; }
		else { $self->{$key}->{$key2} = $args[0]; }
	}
	unless ($parms->path) {
		my $srv_cfg = Apache2::Module::get_config($self,$parms->server);
		if (exists $srv_cfg->{$key}->{$key2}) {
			$srv_cfg->{$key}->{$key2} = [($srv_cfg->{$key}->{$key2})]
				if !ref($srv_cfg->{$key}->{$key2});
			push @{$srv_cfg->{$key}->{$key2}}, @args;
		} else {
			if (@args > 1) { $srv_cfg->{$key}->{$key2} = \@args; }
			else { $srv_cfg->{$key}->{$key2} = $args[0]; }
		}
	}
}

sub push_val_on_key {
	my ($key, $self, $parms, $key2, @args) = @_;
	push @{ $self->{$key}->{$key2} }, @args;
	unless ($parms->path) {
		my $srv_cfg = Apache2::Module::get_config($self,$parms->server);
		push @{ $srv_cfg->{$key}->{$key2} }, @args;
	}
}

sub defaults {
	my ($class, $parms) = @_;
	return bless {
			HeaderName => 'HEADER',
			ReadmeName => 'FOOTER',
			DirectoryIndex => [qw(index.html index.shtml)],
			IndexStyleSheet => '/index.xslt',
			DefaultIcon => '/icons/__unknown.png',
			IndexIgnore => [()],
			FileTypesFilename => 'filetypes.dat',
		}, $class;
}

# http://perl.apache.org/docs/2.0/user/config/custom.html#Examples

sub merge {
	my ($base, $add) = @_;
	my %mrg = ();
	for my $key (keys %$base, keys %$add) {
		next if exists $mrg{$key};
		if ($key eq 'MyPlus') {
			$mrg{$key} = ($base->{$key}||0) + ($add->{$key}||0);
		} elsif ($key eq 'MyList') {
			push @{ $mrg{$key} },
			@{ $base->{$key}||[] }, @{ $add->{$key}||[] };
		} elsif ($key eq 'MyAppend') {
			$mrg{$key} = join " ", grep defined, $base->{$key},
			$add->{$key};
		} else {
			# override mode
			$mrg{$key} = $base->{$key} if exists $base->{$key};
			$mrg{$key} = $add->{$key}  if exists $add->{$key};
		}
	}
	return bless \%mrg, ref($base);
}
  
1;






=pod

=head1 NAME

Apache2::AutoIndex::XSLT - XSLT Based Directory Listings

=head1 SYNOPSIS

 PerlLoadModule Apache2::AutoIndex::XSLT
 <Location />
     SetHandler perl-script
     PerlResponseHandler Apache2::AutoIndex::XSLT
     Options +Indexes
     IndexStyleSheet /index.xslt
     DefaultIcon /icons/__unknown.png
     IndexIgnore .*
     IndexIgnore index.xslt
     IndexIgnore robots.txt
     IndexIgnore sitemap.gz
 </Location>

=head1 DESCRIPTION

This module is designed as a drop in mod_perl2 replacement for the mod_dir and
mod_index modules. It uses user configurable XSLT stylesheets to generate the
directory listings.

THIS CODE IS INCOMPLETE -- THIS IS A DEVELOPMENT RELEASE!

=head1 CONFIGURATION

This module attempts to emulate as much as the functionality from the Apache
mod_dir and mod_index modules as possible. Some of this is performed directly
by the Apache::AutoIndex::XSLT module itself, and some through a combination
of the I<options> elements presented in the output XML and the XSLT stylesheet.
As a result, some of these configuration directives will do little or nothing
at all if the XSLT stylesheet used does not use them.

=head2 FileTypesFilename

     FileTypesFilename

=head2 RenderXSLT

     RenderXSLT On

=head2 RenderXSLTEnvVar

    SetEnvIf Remote_Addr . RenderXSLT=On
    BrowserMatch "Firefox/(2.0|1.5|1.0.[234567])" !RenderXSLT
    BrowserMatch "MSIE [67].0" !RenderXSLT
    BrowserMatch "Netscape/8" !RenderXSLT
    BrowserMatch "Opera/9" !RenderXSLT
    RenderXSLTEnvVar RenderXSLT

=head2 AddAlt

     AddAlt "PDF file" *.pdf
     AddAlt Compressed *.gz *.zip *.Z

I<AddAlt> provides the alternate text to display for a file, instead of an
icon. File is a file extension, partial filename,
wild-card expression or full filename for files to describe. If String
contains any whitespace, you have to enclose it in quotes (" or '). This
alternate text is displayed if the client is image-incapable, has image
loading disabled, or fails to retrieve the icon.

=head2 AddAltByEncoding

     AddAltByEncoding gzip x-gzip

I<AddAltByEncoding> provides the alternate text to display for a file, instead
of an icon. MIME-encoding is a valid content-encoding,
such as x-compress. If String contains any whitespace, you have to enclose it
in quotes (" or '). This alternate text is displayed if the client is
image-incapable, has image loading disabled, or fails to retrieve the icon.

=head2 AddAltByType

     AddAltByType 'plain text' text/plain

I<AddAltByType> sets the alternate text to display for a file, instead of an
icon. MIME-type is a valid content-type, such as
text/html. If String contains any whitespace, you have to enclose it in quotes
(" or '). This alternate text is displayed if the client is image-incapable,
has image loading disabled, or fails to retrieve the icon.

=head2 AddDescription

     AddDescription "The planet Mars" /web/pics/mars.png

This sets the description to display for a file. File is
a file extension, partial filename, wild-card expression or full filename for
files to describe. String is enclosed in double quotes (").

=head2 AddIcon

     AddIcon (IMG,/icons/image.xbm) .gif .jpg .xbm
     AddIcon /icons/dir.xbm ^^DIRECTORY^^
     AddIcon /icons/backup.xbm *~

This sets the icon to display next to a file ending in name. Icon is either a
(%-escaped) relative URL to the icon, or of
the format  (alttext,url) where alttext  is the text tag given for an icon for
non-graphical browsers.

Name is either ^^DIRECTORY^^ for directories, ^^BLANKICON^^ for blank lines
(to format the list correctly), a file extension, a wildcard expression, a
partial filename or a complete filename.

I<AddIconByType> should be used in preference to I<AddIcon>, when possible.

=head2 AddIconByEncoding

     AddIconByEncoding /icons/compress.xbm x-compress

This sets the icon to display next to files. Icon is
either a (%-escaped) relative URL to the icon, or of the format (alttext,url)
where alttext is the text tag given for an icon for non-graphical browsers.

MIME-encoding is a wildcard expression matching required the content-encoding.

=head2 AddIconByType

     AddIconByType (IMG,/icons/image.xbm) image/*

This sets the icon to display next to files of type MIME-type.
Icon is either a (%-escaped) relative URL to the icon, or of
the format (alttext,url)  where alttext is the text tag given for an icon for
non-graphical browsers.

MIME-type is a wildcard expression matching required the mime types.

=head2 DefaultIcon

     DefaultIcon /icons/__unknown.png

The I<DefaultIcon> directive sets the icon to display for files when no
specific icon is known. Url-path is a (%-escaped)
relative URL to the icon.

=head2 HeaderName

=head2 IndexIgnore

     IndexIgnore README .htindex *.bak *~

The I<IndexIgnore> directive adds to the list of files to hide when listing a
directory. File is a shell-style wildcard expression or full filename. Multiple
I<IndexIgnore> directives add to the list, rather than the replacing the list
of ignored files. By default, the list contains . (the current directory).

=head2 IndexOptions

     IndexOptions +DescriptionWidth=* +FancyIndexing +FoldersFirst +HTMLTable
     IndexOptions +IconsAreLinks +IconHeight=16 +IconWidth=16 +IgnoreCase
     IndexOptions +IgnoreClient +NameWidth=* +ScanHTMLTitles +ShowForbidden
     IndexOptions +SuppressColumnSorting +SuppressDescription
     IndexOptions +SuppressHTMLPreamble +SuppressIcon +SuppressLastModified
     IndexOptions +SuppressRules +SuppressSize +TrackModified +VersionSort
     IndexOptions +XHTML

The I<IndexOptions> directive specifies the behavior of the directory indexing.

See L<http://httpd.apache.org/docs/2.2/mod/mod_autoindex.html#indexoptions>.

=head2 IndexOrderDefault

     IndexOrderDefault Ascending Name

The I<IndexOrderDefault> directive is used in combination with the
I<FancyIndexing> index option. By default, fancyindexed directory listings are
displayed in ascending order by filename; the I<IndexOrderDefault> allows you
to change this initial display order.

I<IndexOrderDefault> takes two arguments. The first must be either Ascending or
Descending, indicating the direction of the sort. The second argument must be
one of the keywords Name, Date, Size, or Description, and identifies the
primary key. The secondary key is always the ascending filename.

You can force a directory listing to only be displayed in a particular order by
combining this directive with the I<SuppressColumnSorting> index option; this
will prevent the client from requesting the directory listing in a different
order.

=head2 IndexStyleSheet

     IndexStyleSheet "/css/style.css" 

The I<IndexStyleSheet> directive sets the name of the file that will be used as
the CSS for the index listing. 

=head2 ReadmeName

     ReadmeName FOOTER.html

( run in 1.598 second using v1.01-cache-2.11-cpan-df04353d9ac )