package Apache::DirList;
use strict;
use Apache::Constants ':common';
use Apache::Constants 'REDIRECT';
use Apache::File;
use vars qw/$VERSION/;
use File::Basename;
require DynaLoader;
$VERSION = '0.50';

sub handler {
    my $r=shift;
     my $uri=$r->uri;
    $uri = ( $uri . "/" ) unless ($uri =~ m/\/$/);
    my $path = ($r -> document_root . $uri);
    return DECLINED unless  (opendir(DIRECTORY, $path));
    if (opendir(DIRECTORY, $path)) {
	my $hash = make_dir_hash($path);
	my $indexing_file = find_indexing_file($hash);
	if ($indexing_file =~ /index.html?|index.php/) {
	    my $redirection_url = $uri . $indexing_file;
	    my $server_name = $r->get_server_name;
	    $r->warn("redirecting to http://$server_name$redirection_url");
	    $r->filename($r->document_root . $redirection_url);
	    return OK;
	} else {
	$r->handler("perl-script");
	$r->push_handlers(PerlHandler => \&sub_handler);
	return OK;
    } 
    }
}

sub sub_handler {
    my $r = shift;
     my $uri=$r->uri;
    $uri = ( $uri . "/" ) unless ($uri =~ m/\/$/);
    my $path = ($r -> document_root . $uri);
    return OK if $r->header_only;
    my $hash = make_dir_hash($path);
    my $indexing_file = find_indexing_file($hash);
    if ($indexing_file =~ /index.html?|index.php/) {
	return;
    }
	my $fh = new IO::File;
    if ($indexing_file =~ m/index.conf/) {
	$r->log_error("being sent to object1 => $path");
	my $object1 = Class1->new("$path$indexing_file");
	my $description_hash = $object1->return_hash_object;
	my $final_hash = add_hash_key($hash, $description_hash);
	my $table = make_table($final_hash, $uri);
	my @a = @$table;
	my $tmpfile = "$path" . "decoy.htm";
	$fh->open(">$tmpfile") or $r->log_error("couldn't open $path . \"decoy.htm\"");	
	$fh->print(join('', @a));
	my $server_name = $r->get_server_name;
	$tmpfile =~ s!/var/www!http://$server_name!g;
	$r->warn("redirecting to $tmpfile");
	$r->header_out(Location => "$tmpfile");
	return REDIRECT;
    } else { 
	    my $table = make_table($hash, $uri);
	    my @a = @$table;
	my $tmpfile = "$path" . "decoy.htm";
	$fh->open(">$tmpfile") or $r->log_error("couldn't open $tmpfile");	
	$fh->print(join('', @a));
	$tmpfile =~ s!/var/www!http://www.sirfsup.com!g;
	$r->warn("redirecting to $tmpfile");
	$r->header_out(Location => "$tmpfile");
	return REDIRECT;
	} 
}


sub make_dir_hash {
    my $dir = shift;
    my %self = ();
    if (opendir(DIRECTORY, $dir)) {
	opendir(DIRECTORY, $dir);
	while ( defined (my $entity = readdir(DIRECTORY)) ) {
	    if ($entity =~ m/^[\.|\.\.]/) {next;}
	    $self{$entity} = {};
	    my $filelocation = join ("/", $dir, $entity);
	    if (opendir(SUB_DIRECTORY, $filelocation)){
		$self{$entity} = {dir => 1};
	    }
	}
    }
    return \%self;
}
	

sub find_indexing_file {
	my $HoH = shift;
	my %hash = %$HoH;
	if ( exists ($hash{'index.conf'})) {
		return "index.conf";
	} elsif (exists ($hash{'index.htm'})) {
		return "index.htm";
	} elsif (exists ($hash{'index.php'})) {
		return "index.php";
	} elsif (exists ($hash{'index.html'})) {
		return "index.html";
	} else {
		return;
	}
}


sub print_hash {
	my $indexer = shift;
	my $hash = shift;
	my %HoH = %$hash;
	print "indexing file is $indexer\n";
	for my $entity ( sort keys %HoH) {
	     print "$entity: ";
	     for my $role (sort keys %{ $HoH{$entity}}) {
	          print "           $role=$HoH{$entity}{$role}  ";
	     }
	     print "\n";
	}	
}

# for debugging
sub print_desc_hash {
	my $hash = shift;
	my %HoH = %$hash;
	print "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX";
	for my $key (sort keys %HoH) {
		print "$key => $HoH{$key}\n";
		}
}


sub add_hash_key {
	my $hash = shift; 
	my $object1 = shift;
	my %deref_hash = %$hash;
	my %deref_object1 = %$object1;
	
	for my $file_entity ( sort keys %deref_hash) {
		$deref_hash{$file_entity}{'description'} = $deref_object1{$file_entity};
	}
	return \%deref_hash;
}

sub make_table {
    my $hash_ref = shift;
    my %hash = %$hash_ref;
    my $v_path = shift;  # uris come with a preceding slash
    my (@cells, $file_name);
    push(@cells, qq(<html><head></head>\n));
	push(@cells,qq(<body>\n));
	push(@cells, qq(<center><h2>directory listing for http://www.sirfsup.com$v_path </h2></center><center><table width="100%"><tr><td align="left" width="25%">filename</td><td align="left">description</td><tr><td colspan=2><hr></td></tr><tr>));
    for $file_name (sort keys %hash) {
	if (exists ($hash{$file_name}{"dir"})) {
	    if ($v_path) {
		push(@cells, qq(<tr><td> <img src="/icons/dir.gif" alt="dir">&nbsp;&nbsp;&nbsp;</src><a href="http://www.sirfsup.com$v_path$file_name">$file_name</a></td><td>));
              }	else {
		push(@cells, qq(<tr><td><img src="/icons/dir.gif" alt="dir">&nbsp;&nbsp;&nbsp;</src> <a href="http://www.sirfsup.com$file_name">$file_name</a></td><td>));
	}
	} else {
	if ( $file_name =~ m/decoy.htm/) {}
	elsif ( $file_name =~ m/index.conf/) {}
	elsif( $file_name =~ m/template.htm/) {}
	else {
	    if ($v_path) {
		push(@cells, qq(<tr><td><img src="/icons/text.gif" alt="file">&nbsp;&nbsp;&nbsp;</src><a href="http://www.sirfsup.com$v_path$file_name">$file_name</a></td><td>\n));
              }	else {
		push(@cells, qq(<tr><td><img src="/icons/text.gif" alt="file">&nbsp;&nbsp;&nbsp;</src><a href="http://www.sirfsup.com$file_name">$file_name</a></td><td>\n));
	    }
		if (exists ($hash{$file_name}{'description'})) {
			push(@cells, qq($hash{$file_name}{description}</td></tr>\n));
		} else {
			push(@cells, qq(</td></tr>\n));
		}
		push(@cells, qw());
	  } }
    }
    push(@cells, qq(</td></tr></table></body></html>));
    return \@cells;
}

1;

# adapted from the eagle book
package Class1;
use IO::File;
use File::Basename;
sub new  {
    shift;
    my $file = shift;
    my @directory_listing;
    my $fh = new IO::File;
    $fh->open("<$file") or die "Cannot open $file";
    while (<$fh>) {
	chomp;
	s/^\s+//; s/\s+$//;	#fold leading and trailing white spaces
	if (/^#/ || /^$/) {	#skip comments and empty lines
	}
	if (m/.*/) {
	    push(@directory_listing,$_ );
	} 
    }
    my @loop_array = @directory_listing;
    my (%self);
     for (my $i=0;$i<=$#directory_listing;$i++) {
	my $line  = shift(@loop_array);
	my($url, $label) = split /=/, $line, 2;
	$self{$url} = $label;
    }
    return bless{'hash'=>\%self};
}

sub return_hash_object {return $_[0]->{'hash'};}

1;

__END__

=head1 NAME

B<Apache::FileOrganizer> - Apache mod_perl PerlHandler for displaying a description with all files using a simple "index.conf" file in the same directory for which you wish to provide a listing.

=head1 SYNOPSIS

You must be using mod_perl and Apache-1.3.x. 

For the correct work your apache configuration would contain the following PerlTransHandler directive look like these:

  # in httpd.conf (or any other apache configuration file)
  
        PerlTransHandler   Apache::FileOrganizer

It is possible to nest that inside a virtual host directive, so the virtual sites will not be affected by it.  

You should also not install the c code for it's mod_dir module, as they are contradictory, I don't know what would happen there.  

=head1 DESCRIPTION

This is a PerlTransHandler module, so you will not need to chain it to provide headers and footers.  

This has not been ported to Apache2.  

This will not be ported in fact.  OpenInteract provides more functionality in the behind-the-scenes area, and I plan instead of working on packages for that distribution.  The fault of this code is its inability to move the description when you move the file to another directory.  With the OpenInteract code, it will be possible to use the database to store urls which invoke handlers, etc.  

A sample "index.conf" is like this:

createdb.txt=results of asuccessful installation to stdout
installed_pkgs.txt=results of oi_manage install_packages command
openinteract.htm=details installation of openinteract
Fruit.pm=the sample handler after cutting out comments

there is no space between createdb.txt and the first letter of the file.  The syntax of this file is to put the filename on the left and the description on the right, followed by an equals sign.  Output in browser will look like mod_dir.c's but it will contain the right-side in the description column of the directory listing.

The index will ignore files named decoy.htm, index.conf, and template.htm.  YOu can add your files in that same spot if you want them to be "invisible."  Possible additions are anything with a .conf ending.

The directory listing is output to the disk, so to use the handler the web server will need write permissions on that directory.

=head1 CONFIGURATION DIRECTIVES

none


=head1 SEE ALSO

perl(1), mod_perl(3), Apache(3)

=head1 THANKS

Roman Kosenko for a module submission template.
The eagle book for its 'class1' code used in the file.  
Chris Winters for writing clean(er) code.

=head1 AUTHOR

Joseph Speigle

=head2 Contact info

E-mail:	joe@jklh.us

Home page: http://www.sirfsup.com

=head2 Copyright

Copyright (c) 2003 Joseph Speigle
All rights reserved.  This package is free software; 
you can redistribute it and/or modify it under the same 
terms as Perl itself.

