view release on metacpan or  search on metacpan

PAR.pm  view on Meta::CPAN

	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
    ...
    PerlModule Apache::PAR

  In Apache/mod_perl 1.x environments on Win32 platforms, the following 
  should be used instead:
  
    PerlSetVar PARInclude /path/to/par/archive/directory
    ...
    PerlSetVar PARInclude /path/to/a/par/file.par
    ...
    <PERL>
    use Apache::PAR;
    </PERL>


  Alternative configuration, inside a startup.pl script or PERL section:
    use Apache::PAR qw(
      /path/to/par/archive/directory
      /path/to/a/par/file.par
    );

  Inside a web.conf file:

    Alias /myapp/static/ ##PARFILE##/
    <Location /myapp/static>
      SetHandler perl-script
      PerlHandler Apache::PAR::Static
      PerlSetVar PARStaticDirectoryIndex index.htm
      PerlAddVar PARStaticDirectoryIndex index.html
      PerlSetVar PARStaticDefaultMIME text/html
    </Location>

    Alias /myapp/cgi-perl/ ##PARFILE##/
    <Location /myapp/cgi-perl>
      Options +ExecCGI
      SetHandler perl-script