view release on metacpan or  search on metacpan

lib/Perl/Dist/WiX/Mixin/Support.pm  view on Meta::CPAN

		my $zip = Archive::Zip->new($from);

		if ( not defined $zip ) {
			PDWiX->throw("Could not open archive $from for extraction");
		}

# I can't just do an extractTree here, as I'm trying to
# keep track of what got extracted.
		my @members = $zip->members();

		foreach my $member (@members) {
			my $filename = $member->fileName();
			$filename = _convert_name($filename)
			  ;                        # Converts filename to Windows format.
			my $status = $member->extractToFileNamed($filename);
			if ( $status != AZ_OK ) {
				PDWiX->throw('Error in archive extraction');
			}
			push @filelist, $filename;
		}

	} elsif ( $from =~
		m{ [.] tar [.] gz | [.] tgz [.] | tar [.] bz2 | [.] tbz }msx )
	{
		local $Archive::Tar::CHMOD = 0;
		my @fl = @filelist = Archive::Tar->extract_archive( $from, 1 );
		@filelist = map { catfile( $to, $_ ) } @fl;
		if ( !@filelist ) {
			PDWiX->throw('Error in archive extraction');
		}

	} elsif ( $from =~ m{ [.] tar [.] xz | [.] txz}msx ) {

		# First attempt at trying to use .xz files. TODO: Improve.
		eval {
			require IO::Uncompress::UnXz;
			IO::Uncompress::UnXz->VERSION(2.025);
			1;
		}
		  or PDWiX->throw(
"Tried to extract the file $from without the xz libraries installed."
		  );

		local $Archive::Tar::CHMOD = 0;
		my $xz = IO::Uncompress::UnXz->new( $from, BlockSize => 16_384 );
		my @fl = @filelist = Archive::Tar->extract_archive($xz);
		@filelist = map { catfile( $to, $_ ) } @fl;
		if ( !@filelist ) {
			PDWiX->throw('Error in archive extraction');
		}

	} else {
		PDWiX->throw("Didn't recognize archive type for $from");
	}

	return @filelist;
} ## end sub extract_archive

sub _convert_name {
	my $name     = shift;
	my @paths    = split m{\/}ms, $name;
	my $filename = pop @paths;
	if ( not defined $filename ) {
		$filename = q{};
	}
	my $local_dirs = @paths ? catdir(@paths) : q{};
	my $local_name = catpath( q{}, $local_dirs, $filename );
	$local_name = rel2abs($local_name);
	return $local_name;
} ## end sub _convert_name

sub _extract_filemap { ## no critic(ProhibitUnusedPrivateSubroutines)
	my ( $self, $archive, $filemap, $basedir, $file_only ) = @_;

	my @files;

	if ( $archive =~ m{[.] zip\z}msx ) {

		@files =
		  $self->_extract_filemap_zip( $archive, $filemap, $basedir,
			$file_only );

	} elsif ( $archive =~
		m{[.] tar [.] gz | [.] tgz | [.] tar [.] bz2 | [.] tbz }msx )
	{
		local $Archive::Tar::CHMOD = 0;
		my $tar = Archive::Tar->new($archive);
		for my $file ( $tar->get_files() ) {
			my $f       = $file->full_path();
			my $canon_f = File::Spec::Unix->canonpath($f);
			for my $tgt ( keys %{$filemap} ) {
				my $canon_tgt = File::Spec::Unix->canonpath($tgt);
				my $t;

#<<<
				if ($file_only) {
					next if
					  $canon_f !~ m{\A(?:[^/]+[/])?\Q$canon_tgt\E\z}imsx;
					( $t = $canon_f ) =~ s{\A([^/]+[/])?\Q$canon_tgt\E\z}
										  {$filemap->{$tgt}}imsx;
				} else {
					next if
					  $canon_f !~ m{\A(?:[^/]+[/])?\Q$canon_tgt\E}imsx;
					( $t = $canon_f ) =~ s{\A([^/]+[/])?\Q$canon_tgt\E}
										  {$filemap->{$tgt}}imsx;
				}
#>>>
				my $full_t = catfile( $basedir, $t );
				$self->trace_line( 2, "Extracting $f to $full_t\n" );
				$tar->extract_file( $f, $full_t );
				push @files, $full_t;
			} ## end for my $tgt ( keys %{$filemap...})
		} ## end for my $file ( $tar->get_files...)

	} elsif ( $archive =~ m{ [.] tar [.] xz | [.] txz}msx ) {

		# First attempt at trying to use .xz files. TODO: Improve.
		eval {
			require IO::Uncompress::UnXz;
			IO::Uncompress::UnXz->VERSION(2.025);
			1;