Apache-AutoIndex
view release on metacpan or search on metacpan
AutoIndex.pm view on Meta::CPAN
$subr = $r->lookup_uri($r->dir_config("IndexHtmlFoot"));
$subr->run;
}
print "</BODY></HTML>";
return OK
}
sub read_dir {
my ($r, $dirhandle) = @_;
my $cfg = Apache::ModuleConfig->get($r);
my @listing;
my %list;
my @accept;
if($cfg->{options} & THUMBNAILS){
#Decode the content-encoding accept field of the client
foreach (split(',\s*',$r->header_in('Accept'))){
push @accept, $_ if m:^image/:;
}
}
while (my $file = readdir $dirhandle) {
if ($file eq '..')
{
push @listing, $file;
next;
}
foreach (@{$cfg->{ignore}}) {
if ($file =~ m/^$_$/){
$file = '.';
last;
}
}
next if $file eq '.';
push @listing, $file;
}
foreach my $file (@listing){
my $subr = $r->lookup_file($file);
stat $subr->finfo;
$list{$file}{size} = -s _;
if (-d _){
$list{$file}{size} = -1;
$list{$file}{sizenice} = '-';
}
else {
$list{$file}{sizenice} = size_string($list{$file}{size});
$list{$file}{sizenice} =~ s/\s*//;
}
$list{$file}{mod} = (stat _)[9];
$list{$file}{modnice} = ht_time($list{$file}{mod}, "%d-%b-%Y %H:%M", 0);
$list{$file}{modnice} =~ s/\s/ /g;
$list{$file}{mode} = write_mod((stat _)[2]);
$list{$file}{type} = $subr->content_type;
if(($list{$file}{type} =~ m:^image/:) && ($cfg->{options} & THUMBNAILS ) && Apache->module("Image::Magick"))
{
if ($config->{cache_ok}){
($list{$file}{icon},$list{$file}{width},$list{$file}{height}) = get_thumbnail($r, $file, $list{$file}{mod}, $list{$file}{type}, @accept);
}
}
$list{$file}{height} ||= $cfg->{icon_height};
$list{$file}{width} ||= $cfg->{icon_width};
#icons size might be calculated on the fly and cached...
my $icon = Apache::Icon->new($subr);
$list{$file}{icon} ||= $icon->find;
if (-d _) {
$list{$file}{icon} ||= $icon->default('^^DIRECTORY^^');
$list{$file}{alt} = "DIR";
}
$list{$file}{icon} ||= $icon->default;
$list{$file}{alt} ||= $icon->alt;
$list{$file}{alt} ||= "???";
foreach (keys %{$cfg->{desc}}){
$list{$file}{desc} = $cfg->{desc}{$_} if $subr->filename =~ /$_/;
}
if ($list{$file}{type} eq "text/html" and ($cfg->{options} & SCAN_HTML_TITLES) and not $list{$file}{desc}){
use HTML::HeadParser;
my $parser = HTML::HeadParser->new;
open FILE, $subr->filename;
while (<FILE>){
last unless $parser->parse($_);
}
$list{$file}{desc} = $parser->header('Title');
close FILE;
}
$list{$file}{desc} ||= " ";
}
return \%list;
}
sub transhandler {
my $r = shift;
return DECLINED unless $r->uri =~ /\/$/;
#This is not 100% right at this stage.
#This has to happend at this stage so there is no need to use internal_redirect or a subr
#But Location/Directory configuration isn't accessible yet... In the TODO
my $cfg = Apache::ModuleConfig->get($r);
foreach (@{$cfg->{indexfile}}){
my $subr = $r->lookup_uri($r->uri . $_);
last if ($subr->path_info);
if (stat $subr->finfo){
$nIndex++;
$r->uri($subr->uri);
last;
}
}
return DECLINED;
}
AutoIndex.pm view on Meta::CPAN
my $query = $r->args;
$query = "?" . $query if $query;
$r->header_out(Location => "$uri/$query");
$nRedir++;
return REDIRECT;
}
if($r->allow_options & OPT_INDEXES) {
$r->send_http_header("text/html");
return OK if $r->header_only;
return dir_index($r);
} else {
$r->log_reason( __PACKAGE__ . " Directory index forbidden by rule", $r->uri . " (" . $r->filename . ")");
return FORBIDDEN;
}
}
sub do_sort {
my ($list, $query, $default) = @_;
my @names = sort keys %$list;
shift @names; #removes '..'
#handle default sorting
unless ($query->{N} || $query->{S} || $query->{D} || $query->{M})
{
$default =~ /(.)(.)/;
$query->{$1} = $2;
}
if ($query->{N}) {
@names = sort @names if $query->{N} eq "D";
@names = reverse sort @names if $query->{N} eq "A";
} elsif ($query->{S}) {
@names = sort { $list->{$b}{size} <=> $list->{$a}{size} } @names if $query->{S} eq "D";
@names = sort { $list->{$a}{size} <=> $list->{$b}{size} } @names if $query->{S} eq "A";
} elsif ($query->{M}) {
@names = sort { $list->{$b}{mod} <=> $list->{$a}{mod} } @names if $query->{M} eq "D";
@names = sort { $list->{$a}{mod} <=> $list->{$b}{mod} } @names if $query->{M} eq "A";
} elsif ($query->{D}) {
@names = sort { $list->{$b}{desc} cmp $list->{$a}{desc} } @names if $query->{D} eq "D";
@names = sort { $list->{$a}{desc} cmp $list->{$b}{desc} } @names if $query->{D} eq "A";
}
unshift @names, '..'; #puts back '..' on top of the pile
return \@names;
}
sub get_thumbnail {
my ($r, $filename, $mod, $content, @accept) = @_;
my $accept = join('|', @accept);
my $dir = $r->filename;
#these should sound better.
my $cachedir = $config->{cache_dir};
my $xresize;
my $yresize;
my $img = Image::Magick->new;
my($imgx, $imgy, $img_size, $img_type) = split(',', $img->Ping($dir . $filename));
#Is the image OK?
return "/icons/broken.gif" unless ($imgx && $imgy);
if (($content =~ /$content/) && ($img_type =~ /JPE?G|GIF|PNG/i)){
#We know that what we'll generate will be seen.
if ($dir =~ /$cachedir\/$/){
#Avoiding recursive thumbnails from Hell
return $filename, $imgx, $imgy
}
#The image is way too big to try to process...
return undef if $img_size > $config->{thumb_max_size};
if (defined $config->{thumb_scale_width} || defined $config->{thumb_scale_height})
{
#Factor scaling
$xresize = $config->{thumb_scale_width} * $imgx if defined $config->{thumb_scale_width};
$yresize = $config->{thumb_scale_height} * $imgy if defined $config->{thumb_scale_height};
}
elsif(defined $config->{thumb_width} || defined $config->{thumb_height}){
#Absolute scaling
$xresize = $config->{thumb_width} if defined $config->{thumb_width};
$yresize = $config->{thumb_height} if defined $config->{thumb_height};
}
#preserve ratio if we can
$xresize ||= $yresize * ($imgx/$imgy);
$yresize ||= $xresize * ($imgy/$imgx);
#default if values are missing.
$xresize ||= DEFAULT_ICON_WIDTH;
$yresize ||= DEFAULT_ICON_HEIGHT;
#round off for picky browsers
$xresize = int($xresize);
$yresize = int($yresize);
#Image is too small to actually resize. Simply resize with the WIDTH and HEIGHT attributes of the IMG tag
return ($filename, $xresize , $yresize) if $img_size < $config->{thumb_min_size};
if ($config->{changed} || $mod > (stat "$dir$cachedir/$filename")[9]){
#We should actually resize the image
if ($img->Read($dir . $filename)){
#Image is broken
return "/icons/broken.gif";
}
$nThumb++;
$img->Sample(width=>$xresize, height=>$yresize);
$img->Write("$dir$cachedir/$filename");
}
return "$cachedir/$filename", $xresize , $yresize;
}
return undef;
}
sub place_doc {
my ($r, $cfg, $type) = @_;
foreach (@{$cfg->{$type}}) {
my $subr = $r->lookup_uri($r->uri . $_);
AutoIndex.pm view on Meta::CPAN
$new{readme} = [ @{$current->{readme}}, @{$parent->{readme}} ];
$new{header} = [ @{$current->{header}}, @{$parent->{header}} ];
$new{ignore} = [ @{$current->{ignore}}, @{$parent->{ignore}} ];
$new{indexfile} = [ @{$current->{indexfile}}, @{$parent->{indexfile}} ];
$new{desc} = {% {$current->{desc}}}; #Keep descriptions local
if ($current->{options} & NO_OPTIONS){
#None override all directives
$new{options} = NO_OPTIONS;
}
else {
if ($current->{options} == 0) {
#Options are all incremental, so combine them with parent's values
$new{options_add} = ( $parent->{options_add} | $current->{options_add}) & ~$current->{options_del};
$new{options_del} = ( $parent->{options_del} | $current->{options_del}) ;
$new{options} = $parent->{options} & ~NO_OPTIONS;
}
else {
#Options weren't all incremental, so forget about inheritance, simply override
$new{options} = $current->{options};
}
$new{options} |= $new{options_add};
$new{options} &= ~ $new{options_del};
}
return bless \%new, ref($parent);
}
sub status {
my ($r, $q) = @_;
my @s;
my $cfg = Apache::ModuleConfig->get($r);
push (@s, "<B>" , __PACKAGE__ , " (ver $VERSION) statistics</B><BR>");
push (@s , "Done " . $nDir . " listings so far<BR>");
push (@s , "Done " . $nRedir . " redirects so far<BR>");
push (@s , "Done " . $nIndex. " indexes so far<BR>");
push (@s , "Done " . $nThumb. " thumbnails so far<BR>");
use Data::Dumper;
my $string = Dumper $cfg;
push (@s, $string);
return \@s;
}
1;
__END__
=head1 NAME
Apache::AutoIndex - Perl replacment for mod_autoindex and mod_dir Apache module
=head1 SYNOPSIS
PerlModule Apache::Icon
PerlModule Apache::AutoIndex
(PerlModule Image::Magick) optionnal
PerlTransHandler Apache::AutoIndex::transhandler
PerlHandler Apache::AutoIndex
=head1 DESCRIPTION
This module can replace completely mod_dir and mod_autoindex
standard directory handling modules shipped with apache.
It can currently live right on top of those modules, but I suggest
simply making a new httpd without these modules compiled-in.
To start using it on your site right away, simply preload
Apache::Icon and Apache::AutoIndex either with:
PerlModule Apache::Icon
PerlModule Apache::AutoIndex
in your httpd.conf file or with:
use Apache::Icon ();
use Apache::AutoIndex;
in your require.pl file.
Then it's simply adding
PerlTransHandler Apache::Autoindex::transhandler
PerlHandler Apache::AutoIndex
somewhere in your httpd.conf but outside any Location/Directory containers.
=head2 VIRTUAL HOSTS
If used in a server using virtual hosts, since mod_perl doesn't have configuration merging routine for virtual hosts, you'll have to put the PerlHandler and PerlTransHandler directives in each and every <VHOST></VHOST>
section you wish to use Apache::AutoIndex with.
=head1 DIRECTIVES
It uses all of the Configuration Directives defined by mod_dir and mod_autoindex.
Since the documentation about all those directives can be found
on the apache website at:
http://www.apache.org/docs/mod/mod_autoindex.html
http://www.apache.org/docs/mod/mod_dir.html
I will only list modification that might have occured in this
perl version.
=head2 SUPPORTED DIRECTIVES
=over
=item *
AddDescription
=item *
DirectoryIndex
AutoIndex.pm view on Meta::CPAN
This is an expression that should producea complete <BODY> tag when eval'ed. One
example could be :
PerlSetVar IndexHtmlBody '<BODY BACKGROUND=\"$ENV{BACKGROUND}\">'
=item * PerlSetVar IndexHtmlTable value
This is a string that will be inserted inside the table tag of the listing like
so : <TABLE $value>
=item * PerlSetVar IndexHtmlHead value
This should be the url (absolute/relative) of a ressource that would be inserted right
after the <BODY> tag and before anything else is written.
=item * PerlSetVar IndexHtmlFoot value
This should be the url (absolute/relative) of a ressource that would be inserted right
before the </BODY> tag and after everything else is written.
=item * PerlSetVar IndexDebug [0|1]
If set to 1, the listing displayed will print usefull (well, to me)
debugging information appended to the bottom. The default is 0.
=back
=head2 UNSUPPORTED DIRECTIVES
=over
=item * - Hopefully none :-)
=back
=head1 THUMBNAILS
Since version 0.07, generation of thumbnails is possible. This means that listing a
directory that contains images can be listed with little reduced thumbnails beside each
image name instead of the standard 'image' icon.
To enable this you simply need to preload Image::Macick in Apache. The IndexOption option
Thumbnails controls thumbnails generation for specific directories like any other IndexOption
directive.
=head2 USAGE
The way thumbnails are generated/produced can be configured in many ways, but here is a general
overview of the procedure.
For each directory containing pictures, there will be a .thumbnails directory in it that will
hold the thumbnails. Each time the directory is accessed, and if thumbnail generation is
active, small thumbnails will be produced, shown beside each image name, instaed of the normal
, generic, image icon.
That can be done in 2 ways. In the case the image is pretty small, no actual thumbnail will
be created. Instead the image will be resized with the HEIGHT and WIDTH attributes of the IMG
tag.
If the image is big enough, it is resized with Image::Magick and saved in the .thumbnails directory
for the next requests.
Change in the configuration of the indexing options will correctly refresh the thumbnails stored.
Also if an original image is modified, the thumbnail will be modified accordingly. Still, the
browser might screw things up if it preserves the cached images.
The behaviour of the Thumbnail generating code can be customized with these PerlSetVar variables:
=head2 DIRECTIVES
=over
=item * IndexCacheDir dir
This is the name of the directory in wich generated thumbnails will be created. Make sure the
user under wich the webserver runs has read and write privileges. Defaults to .thumbnails
=item * IndexCreateDir 0|1
Specifies that when a cache directory isn't found, should an attempt to create it be done.
Defaults to 1(true), meaning if possible, missing cache directories will be created.
=item * ThumbMaxFilesize bytes
This value fixes the size of an image at wich thumbnail processing isn't even attempted.
Since trying to process a few very big images could bring a server down to it's knees.
Defaults to 500,000
=item * ThumbMinFilesize bytes
This value fixes the size of an image at wich thumbnail processing isn't actually done.
Since trying to process already very small images could would be an overkill, the image is
simply resized withe the size attributes of the IMG tag. Defaults to 5,000.
=item * ThumbMaxWidth pixels
This value fixes the x-size of an image at wich thumbnail processing isn't actually done.
Since trying to process already very small images could would be an overkill, the image is
simply resized withe the size attributes of the IMG tag. Defaults to 4 times the default
icon width.
=item * ThumbMaxHeight pixels
This value fixes the y-size of an image at wich thumbnail processing isn't actually done.
Since trying to process already very small images could would be an overkill, the image is
simply resized withe the size attributes of the IMG tag. Defaults to 4 times the default
icon height
=item * ThumbScaleWidth scaling-factor
This value fixes an x-scaling factor between 0 and 1 to resize the images with. The image ratio will be
preserved only if there is no scaling factor for the other axis of the image.
=item * ThumbScaleHeight scaling-factor
This value fixes an y-scaling factor between 0 and 1 to resize the images with. The image ratio will be
preserved only if there is no scaling factor for the other axis of the image.
=item * ThumbWidth pixels
This value fixes a fixed x-dimension to resize the image with. The image ratio will be
preserved only if there is no fixed scaling factor for the other axis of the image. This has no
effect if a scaling factor is defined.
=item * ThumbHeight pixels
This value fixes a fixed x-dimension to resize the image with. The image ratio will be
preserved only if there is no fixed scaling factor for the other axis of the image. This has no
effect if a scaling factor is defined.
=back
=head1 TODO
The transhandler problem should be fixed.
Some minor changes to the thumbnails options will still have the thumbnails re-generated. This
should be avoided by checking the attributes of the already existing thumbnail.
Some form of garbage collection should be performed or cache directories will fill up.
Find new things to add...
=head1 SEE ALSO
perl(1), L<Apache>(3), L<Apache::Icon>(3), L<Image::Magick>(3) .
=head1 SUPPORT
Please send any questions or comments to the Apache modperl
mailing list <modperl@apache.org> or to me at <gozer@ectoplasm.dyndns.com>
=head1 NOTES
This code was made possible by :
=over
=item Doug MacEachern
<dougm@pobox.com> Creator of Apache::Icon, and of course, mod_perl.
=item Rob McCool
who produced the final mod_autoindex.c I copied, hrm.., well, translated to perl.
=item The mod_perl mailing-list
at <modperl@apache.org> for all your mod_perl related problems.
=back
=head1 AUTHOR
Philippe M. Chiasson <gozer@ectoplasm.dyndns.com>
=head1 COPYRIGHT
Copyright (c) 1999 Philippe M. Chiasson. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut
( run in 1.040 second using v1.01-cache-2.11-cpan-39bf76dae61 )