view release on metacpan or  search on metacpan

PAR.pm  view on Meta::CPAN

				next;
			}
			my $unpackdir = $class->unpack_par($file, $tempdir);
			unless(defined($unpackdir)) {
				print STDERR "Unable to unpack $file.  Skipping.\n";
				next;
			}
			$conf =~ s/##UNPACKDIR##/$unpackdir/g;
			$UNPACK_LIST{$file} = $unpackdir;
			# TODO: Use UNPACK_LIST in handler, etc to reload changed content.
		}


		unless ($mod_perl::VERSION < 1.99) {
			$err = Apache->server->add_config([split /\n/, $conf]);
		} else
		{
			Apache->httpd_conf($conf);
		}
		die $err if $err;
	}

	map {$PARFILE_LIST{$_} = 1;} @pars;

}

sub unpack_par {
	my $class = shift;
	my($par, $tmpdir) = @_;

	require File::Spec;
	require File::Path;
	require Digest::MD5;

	warn "[PAR] unpacking '$par'\n" if DEBUG;
	my $zip = Archive::Zip->new;
	my $rv = $zip->read($par);
	unless($rv == AZ_OK) {
		 print STDERR "Unable to read ZIP file '$par': error code $rv";
		 return undef;
	}

	$tmpdir ||= File::Spec->tmpdir;
	unless($tmpdir) {
		 print STDERR "no temp directory specified";
		 return undef;
	}
	
	unless(-d $tmpdir) {
		 print STDERR "temp dir '$tmpdir' does not exist or is not a directory";
		 return undef;
	}

	my $tmppar = File::Spec->catdir($tmpdir, 'par', (File::Spec->splitpath($par))[1,2]);
	# Instead of using full path, this will append MD5
	# my $fh;
	# unless(open $fh, '<', $par) {
	# 	 print STDERR "unable to read '$par': $!";
	# 	 return undef;
	# }
	# binmode($fh);
	# my $md5    = Digest::MD5->new->addfile($fh)->hexdigest;
	# my $tmppar = File::Spec->catdir($tmpdir, 'par', $md5);
	# close($fh);

	warn "[PAR] unpack dir is '$tmppar'\n" if DEBUG;

    # mtime check for if MD5 approach isn't used
	if (-d $tmppar) {
		if (DEBUG) {
			warn "[PAR] archive has been unpacked previously\n";
			warn "[PAR] directory age: ", -M $tmppar, "\n";
			warn "[PAR] archive age: ", -M $par, "\n";
		}
		return $tmppar if (stat($tmppar))[9] > (stat($par))[9];
		warn "[PAR] removing old unpack dir '$tmppar'" if DEBUG;
		File::Path::rmtree $tmppar;
	}
 
	# XXX Add signature check here

	# unpack the files
	foreach my $member ($zip->members) {
		# $member->fileName is always in Unix format
		# See also Archive::Zip::_asLocalName()
		my $file = File::Spec->catfile($tmppar, split('/', $member->fileName));
		warn "[PAR] extracting '$file'\n" if DEBUG;
		my $rv = $member->extractToFileNamed($file);
		unless($rv == AZ_OK) {
			 print STDERR "Error extracting '$file' from '$par': error code: $rv";
			 return undef;
		}
		if ($member->fileAttributeFormat == 3) { # unix permissions
			my $perms = $member->unixFileAttributes & 0xFFF;
			unless(chmod $perms, $file) {
				 print STDERR "chmod $perms, $file failed: $!";
				 return undef;
			}
		}
	}

	return $tmppar;
}

import(__PACKAGE__,@pardir,@parfiles,@parloc);

1;
__END__

=head1 NAME

Apache::PAR - Perl extension for including Perl ARchive files in a mod_perl (1.x or 2.x) 
environment.

=head1 SYNOPSIS

  Inside Apache configuration:
    PerlSetVar PARInclude /path/to/par/archive/directory
    ...
    PerlAddVar PARInclude /path/to/a/par/file.par
    ...