App-rs

 view release on metacpan or  search on metacpan

bin/rs  view on Meta::CPAN

BEGIN {
	for my $c (qw/green cyan yellow magenta red/) {
		no strict 'refs';
		my $f = uc substr $c, 0, 1;
		*$f = sub () { [$c] };
		*{$f x 2} = sub () { ['bold', $c] };
	}
}
sub set {
	my ($f, $m) = @_;
	# chown should be called before chmod to prevent setuid, setgid bit gets reset.
	chown @$m{qw/uid gid/}, $f and chmod $m->{mode} & 07777, $f and utimensat($f, $m->{mtime}) or die "$f: $!";
}
sub equiv {
	my ($p, $q) = @_;
	no warnings 'uninitialized';
	all { $p->{$_} eq $q->{$_} } qw/mode uid gid size mtime hl sl/;
}
sub elf {
	open my $fh, '<', shift or die $!;
	my $b;
	read($fh, $b, 4) == 4 and $b eq "\x7fELF";
}
sub strip {
	my ($f, $m, $root) = @_;
	my $s;
	if (/\.[ao]$/)						{ @$s{qw/strip archive/} = (1, 1) }

bin/rs  view on Meta::CPAN

sub _diff {
	my ($cp, $vp) = @_;
	my ($db, $v) = ($vp->{db}, {});
	opendir(my $dh, $cp->{root} . $vp->{d}) or die $!;
	for (sort readdir $dh) {
		my $ign = $vp->{ign}{$_};
		# ignore leaf only.
		next if /^\.{1,2}$/ or $ign and not ref $ign;
		my ($r, $m) = ($vp->{d} . $_, {});
		my $f = $cp->{root} . $r;
		(my $i, @$m{qw/mode uid gid size mtime/}) = (lstat $f)[1, 2, 4, 5, 7, 9];
		if ($cp->{ih}{$i})	{ $m->{hl} = $cp->{ih}{$i} }
		else			{ $cp->{ih}{$i} = $r }
		my $t = $m->{mode} & S_IFMT;
		if ($t == S_IFDIR)	{ delete $m->{size} }
		elsif ($t == S_IFLNK)	{ $m->{sl} = readlink $f or die $! }
		elsif ($t != S_IFREG)	{ die "unknown type $t of $f." }
		my $st = {};
		if (my $_m = $db->{$_}) {
			my $_t = $_m->{mode} & S_IFMT;
			if ($t == S_IFDIR xor $_t == S_IFDIR)	{ ... }

bin/rs  view on Meta::CPAN

					my $g = $cp->{root} . $q->{hl};
					link $g, $f or die "unable to hard link $f to $g: $!";
				} else {
					wf($f, delete $q->{c});
					set($f, $q);
				}
			} else {
				# That's really nasty...
				symlink my $g = $q->{sl}, $f or die "unable to symlink $f to $q->{sl}: $!.";
				# symlink(7) explicitly says the permission of a symbolic link can't be changed(on Linux).
				lchown($f, @$q{qw/uid gid/}) and utimensat($f, $q->{mtime}) or die "$f: $!";
			}
			# A new hash is required here and above since metadata varies for non-directory.
			my $p = $db->{$_} = {%$q,
					     owner => $db->{$_}{owner}};
			$p->{owner}{current} = $cp->{oid}, $p->{owner}{record}{$cp->{oid}} = $cp->{ts};
		}
	}
}
# merge two patch trees, the first one takes higher priority.
sub merge {

bin/rs  view on Meta::CPAN

						delete $db->{$_};
					}
				}
			}
		}
	}
}
sub runas {
	my $u = shift;
	if ($u ne 'root') {
		my ($uid, $gid) = (getpwnam $u)[2, 3];
		($(, $)) = ($gid, "$gid $gid");
		($<, $>) = ($uid, $uid);
	} else {
		($<, $>) = (0, 0);
		($(, $)) = (0, '0 0');
	}
}
sub _crowded {
	{subr => sub {
		my $o = shift;
		if ($o->{event} eq 'ent') {

rs.xs  view on Meta::CPAN

					cwrite(fd, key, retlen);
					LLAC(v);
				} else {
					TER;
				}
			}
		}
		cwrite(fd, NULL, 0);

bool
lchown(char *f, uid_t uid, gid_t gid)
	POSTCALL:
		RETVAL = !RETVAL;

bool
utimensat(char *f, int t)
	CODE:
		struct timespec	times[2];
		times[0].tv_nsec = UTIME_OMIT;
		times[1].tv_sec = t, times[1].tv_nsec = 0;
		RETVAL = !utimensat(AT_FDCWD, f, times, AT_SYMLINK_NOFOLLOW);

typemap  view on Meta::CPAN

TYPEMAP
uid_t	T_IV
gid_t	T_IV