view release on metacpan or  search on metacpan

lib/DataStore/CAS/FS/Exporter.pm  view on Meta::CPAN

			$self->utf8_filenames? utf8::encode($sysname) : utf8::downgrade($sysname)
				if utf8::is_utf8($sysname);
			$self->_extract_recursive($src->path($_), File::Spec->catdir($real_path, $sysname))
		}
	}
	$self->_apply_metadata($dirent, $real_path);
}

sub _create_dirent {
	my ($self, $entry, $path)= @_;
	my $t= $entry->type;
	if ($t eq 'file') {
		open(my $dest_fh, '>:raw', $path)
			or $self->_handle_creation_error("open($path): $!");
		return $dest_fh;
	} elsif ($t eq 'dir') {
		mkdir $path
			or $self->_handle_creation_error("mkdir($path): $!");
	} elsif ($t eq 'symlink') {
		symlink $entry->ref, $path
			or $self->_handle_creation_error("symlink($path): $!");
	} elsif ($t eq 'blockdev' || $t eq 'chardev') {
		my ($major, $minor)= split /,/, $entry->ref;
		defined $major && length $major && defined $minor && length $minor
			or die "mknod($path): Invalid device notation \"".$entry->ref."\"\n";
		$self->_mknod($self, $path, $entry, $major, $minor);
	} elsif ($t eq 'pipe') {
		$self->_mknod($self, $path, $entry, 0, 0);
	} elsif ($t eq 'socket') {
		require Socket;
		my $sock;
		socket($sock, Socket::PF_UNIX(), Socket::SOCK_STREAM(), 0)
			&& bind($sock, sockaddr_un($path))
			or $self->_handle_creation_error("socket/bind($path): $!");
	} else {
		$self->_handle_creation_error("Unsupported directory entry type \"$t\" for $path");
	}
	return undef;
}

sub _apply_metadata {
	my ($self, $entry, $path)= @_;
	if (defined (my $mode= $entry->unix_mode)) {
		chmod($mode & ~Fcntl::S_IFMT(), $path)
			or $self->_handle_metadata_error("chmod($path): $!");
	}

	my ($uid, $gid)= ($entry->unix_uid, $entry->unix_gid);
	if (defined (my $u= $entry->unix_user)) {
		my $cache= $self->unix_user_cache;
		exists $cache->{$u}? (defined $cache->{$u} and ($uid= $cache->{$u}))
			: defined( $cache->{$u}= getgrnam($u) )? $uid= $cache->{$u}
			: $self->_handle_metadata_error("Can't resolve username '$u'");
	}
	if (defined (my $g= $entry->unix_group)) {
		my $cache= $self->unix_group_cache;
		exists $cache->{$g}? (defined $cache->{$g} and ($gid= $cache->{$g}))
			: defined( $cache->{$g}= getgrnam($g) )? $gid= $cache->{$g}
			: $self->_handle_metadata_error("Can't resolve username '$g'");
	}
	chown( (defined $uid? $uid : -1), (defined $gid? $gid : -1), $path )
		|| $self->_handle_metadata_error("chown($uid, $gid, $path): $!")
		if defined $uid || defined $gid;

	my $mtime= $entry->modify_ts;
	if (defined $mtime) {
		my $atime= $entry->access_ts;
		defined $atime or $atime= $mtime;
		utime($atime, $mtime, $path)
			or $self->_handle_metadata_error("utime($atime, $mtime, $path): $!");
	}
}

sub _handle_metadata_error {
	my ($self, $msg)= @_;
	die $msg."\n" if $self->{flags}{die_on_metadata_error};
	warn $msg."\n";
}

sub _handle_creation_error {
	my ($self, $msg)= @_;
	die $msg."\n" if $self->{flags}{die_on_creation_error};
	warn $msg."\n";
}

sub _mknod {
	my $fn= (try { require Unix::Mknod; 1; } catch { undef })? \&_mknod_perl
		: (`mknod --version` && $? == 0)? \&_mknod_system
		: \&_mknod_unsupported;
	no warnings 'redefine';
	*_mknod= $fn;
	goto $fn;
}

sub _mknod_perl {
	my ($self, $path, $entry, $major, $minor)= @_;
	my $mode= ($entry->type eq 'blockdev')? S_IFBLK|0600
		: ($entry->type eq 'chardev')? S_IFCHR|0600
		: ($entry->type eq 'pipe')? S_IFIFO|0600
		: die "Unsupported type ".$entry->type;
	0 == Unix::Mknod::mknod($path, $mode, Unix::Mknod::makedev($major, $minor))
		or $self->_handle_creation_error("mknod($path, $mode, ".Unix::Mknod::makedev($major, $minor)."): $!");
}

sub _mknod_system {
	my ($self, $path, $dirent, $major, $minor)= @_;
	if ($dirent->type eq 'pipe') {
		system('mkfifo', $path) == 0 || die "exec(mkfifo, $path): $!\n";
		$? == 0 || $self->_handle_creation_error("mkfifo($path) exited ".($? & 127? "on signal ".($? & 127) : "with ".($? >> 8)));
	} else {
		my $t= $dirent->type eq 'blockdev'? 'b' : 'c';
		system('mknod', $path, $t, $major, $minor) == 0 or die "exec(mknod, $path, $t, $major, $minor): $!\n";
		$? == 0 || $self->_handle_creation_error("mknod($path) exited ".($? & 127? "on signal ".($? & 127) : "with ".($? >> 8)));
	}
}

sub _mknod_unsupported {
	my ($self, $path)= @_;
	$self->die_on_unsupported?
		die "mknod($path): Module Unix::Mknod is not installed and mknod(1) is not in the PATH\n"
		: warn "Skipping mknod($path)\n";
}