view release on metacpan or  search on metacpan

bin/rs  view on Meta::CPAN

#!/usr/bin/env perl

#   Copyright © 2018 Yang Bo
#
#   This file is part of RSLinux.
#
#   RSLinux is free software: you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation, either version 3 of the License, or
#   (at your option) any later version.
#
#   RSLinux is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with RSLinux.  If not, see <http://www.gnu.org/licenses/>.

use App::rs 'sane',
    iautoload => ['App::rs',
		  ['Term::ANSIColor', [qw/colored c/]],
		  [qw/Cwd abs_path getcwd/],
		  [qw/File::Path make_path/],
		  ['List::Util', map { "&$_" } qw/reduce all first none/],
		  ['Fcntl', map { "&$_" } qw/S_IFMT S_IFLNK S_IFREG S_IFDIR/],
		  [qw/Config %Config/]];

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) }
	elsif ((/\.so/ or $m->{mode} & 0111) and elf($f))	{ $s->{strip} = 1 }
	if ($s->{strip}) {
		xsh(0, 'strip', $s->{archive} ? '--strip-unneeded' : (), $f);
		say "strip on $f, st: $?.";
		if (not $?) {
			set($f, $m);
			$m->{size} = (stat $f)[7];
		}
	}
}
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)	{ ... }
			elsif ($t == S_IFDIR)			{ $st->{dir} = 1 }
			else					{ $st->{mod} = 1 if not equiv($m, $_m) }
		} else {
			$st->{ne} = 1;
		}
		if (%$st) {
			if ($t == S_IFDIR) {
				add(my $p = $db->{$_} ||= {c => {}}, %$m);