view release on metacpan or  search on metacpan

lib/Apache2/Archive.pm  view on Meta::CPAN

package Apache2::Archive;


use strict;
use Archive::Tar;
use Apache2::Log;
use Apache2::Const;
use Apache2::Util ();
use Apache2::Status;
use Apache2::SubRequest ();

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
	
);
$VERSION = '0.2';


sub handler{
	my $r = shift;
	my $t;
	#$t->{Files};			# Contains info on all the files in the archive
	#$t->{FileInfo};		# contains info on archive file itself
	#$t->{filename};		# Canonical name of the archive file itself
	#$t->{template};		# The template file (one line per array entry)
	#$t->{Tar};				# The Archive::Tar object for the archive
	#$t->{SizeLimit};	# The Maximum tar file size allowed. After opening a file larger
						# that this, the processes will terminate to free memory.
	$t->{Tar} = new Archive::Tar;
	$t->{SizeLimit} = $r->dir_config('SizeLimit');
	
	##
	# Get the template file for later use
	##	

	&getTemplateFile($t,$r->dir_config('Template'));
	
	##
	# Create the Tar object;
	##
	
	
	$t->{filename} = $r->filename;
	unless (-e $t->{filename} && -r $t->{filename}) {
		return Apache2::Const::NOT_FOUND;
	}
	my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)=stat($t->{filename});

	($t->{FileInfo}->{'name'}) = $t->{filename} =~ m!(([^/\\]|\\\/)+)$!;
	$t->{FileInfo}->{'date'} = &getDatestring($mtime, $r->dir_config('Months'));
	$t->{FileInfo}->{'rawsize'} = -s $t->{filename};
	$t->{FileInfo}->{'size'} = &getSizestring($t->{FileInfo}->{'rawsize'});
	$t->{FileInfo}->{'view_location'} = $r->uri . "/display/" . $t->{FileInfo}->{'name'};
	$t->{FileInfo}->{'compressed'} = 1 if $t->{FileInfo}->{'name'} =~ /\.gz$/;
	if (! $t->{Tar}->read($t->{filename}, $t->{FileInfo}->{'compressed'})){
		&error_response($t,$r);
		return Apache2::Const::SERVER_ERROR;
	}
	

	
	@{$t->{Files}} = $t->{Tar}->list_files(['name','mtime','size']);

	&response($t,$r);

	# We check to see if we need to kill ourselves
	
	if ($t->{SizeLimit} >0 && $t->{FileInfo}->{'rawsize'} > ($t->{SizeLimit} * 1024))
	{
	#	my $log = $r->log();
		if (getppid() > 1) # check we aren't the parent process.
		{
	#		$log->warn("Apache2::Archive is ending this process because SizeLimit reached. Just letting you know.");
			$r->child_terminate;
    	}
    }
	return Apache2::Const::OK;
}

sub response{
	my $t = shift;
	my $r = shift;
	
	if ($r->path_info =~ m!^/display/!){
		&display($t,$r);
	}
	else{
		&draw_menu($t,$r);		
	}
}
##
# This extracts the file specified in the path info and dumps it
# to stdout. 
##

sub display {
	my $t = shift;
	my $r = shift;
	my $filename;
	
	## 
	# We need to get both the actual file ($file) and the name without
	# any path ($filename). We use $filename to find out the mime type.
	##
	
	my $file = $r->path_info;
	($filename) = $file =~ m!/([^/]+)$!;