view release on metacpan or  search on metacpan

lib/Doit.pm  view on Meta::CPAN

	}
    }
}

{
    package Doit::Util;
    use Exporter 'import';
    our @EXPORT; BEGIN { @EXPORT = qw(in_directory new_scope_cleanup copy_stat get_sudo_cmd is_in_path get_os_release) }
    $INC{'Doit/Util.pm'} = __FILE__; # XXX hack
    use Doit::Log;

    sub new_scope_cleanup (&) {
	my($code) = @_;
	my $sc = Doit::ScopeCleanups->new;
	$sc->add_scope_cleanup($code);
	$sc;
    }

    sub in_directory (&$) {
	my($code, $dir) = @_;
	my $scope_cleanup;
	if (defined $dir) {
	    require Cwd;
	    my $pwd = Cwd::getcwd();
	    if (!defined $pwd || $pwd eq '') { # XS variant returns undef, PP variant returns '' --- see https://rt.perl.org/Ticket/Display.html?id=132648
		warning "No known current working directory";
	    } else {
		$scope_cleanup = new_scope_cleanup
		    (sub {
			 chdir $pwd or error "Can't chdir to $pwd: $!";
		     });
	    }
	    chdir $dir
		or error "Can't chdir to $dir: $!";
	}
	$code->();
    }

    # $src may be a source file or an arrayref with stat information
    sub copy_stat ($$;@) {
	my($src, $dest, %preserve) = @_;
	my @stat = ref $src eq 'ARRAY' ? @$src : stat($src);
	error "Can't stat $src: $!" if !@stat;

	my $preserve_default   = !%preserve;
	my $preserve_ownership = exists $preserve{ownership} ? delete $preserve{ownership} : $preserve_default;
	my $preserve_mode      = exists $preserve{mode}      ? delete $preserve{mode}      : $preserve_default;
	my $preserve_time      = exists $preserve{time}      ? delete $preserve{time}      : $preserve_default;

	error "Unhandled preserve values: " . join(" ", %preserve) if %preserve;

	if ($preserve_mode) {
	    chmod $stat[2], $dest
		or warning "Can't chmod $dest to " . sprintf("0%o", $stat[2]) . ": $!";
	}
	if ($preserve_ownership) {
	    chown $stat[4], $stat[5], $dest
		or do {
		    my $save_err = $!; # otherwise it's lost in the get... calls
		    warning "Can't chown $dest to " .
			(getpwuid($stat[4]))[0] . "/" .
			(getgrgid($stat[5]))[0] . ": $save_err";
		};
	}
	if ($preserve_time) {
	    utime $stat[8], $stat[9], $dest
		or warning "Can't utime $dest to " .
		scalar(localtime $stat[8]) . "/" .
		scalar(localtime $stat[9]) .
		": $!";
	}
    }

    sub get_sudo_cmd () {
	return () if $> == 0;
	return ('sudo');
    }

    sub is_in_path {
	my($prog) = @_;

	if (!defined &_file_name_is_absolute) {
	    if (eval { require File::Spec; defined &File::Spec::file_name_is_absolute }) {
		*_file_name_is_absolute = \&File::Spec::file_name_is_absolute;
	    } else {
		*_file_name_is_absolute = sub {
		    my $file = shift;
		    my $r;
		    if ($^O eq 'MSWin32') {
			$r = ($file =~ m;^([a-z]:(/|\\)|\\\\|//);i);
		    } else {
			$r = ($file =~ m|^/|);
		    }
		    $r;
		};
	    }
	}

	if (_file_name_is_absolute($prog)) {
	    if ($^O eq 'MSWin32') {
		return $prog       if (-f $prog && -x $prog);
		return "$prog.bat" if (-f "$prog.bat" && -x "$prog.bat");
		return "$prog.com" if (-f "$prog.com" && -x "$prog.com");
		return "$prog.exe" if (-f "$prog.exe" && -x "$prog.exe");
		return "$prog.cmd" if (-f "$prog.cmd" && -x "$prog.cmd");
	    } else {
		return $prog if -f $prog and -x $prog;
	    }
	}
	require Config;
	%Config::Config = %Config::Config if 0; # cease -w
	my $sep = $Config::Config{'path_sep'} || ':';
	foreach (split(/$sep/o, $ENV{PATH})) {
	    if ($^O eq 'MSWin32') {
		# maybe use $ENV{PATHEXT} like maybe_command in ExtUtils/MM_Win32.pm?
		return "$_\\$prog"     if (-f "$_\\$prog" && -x "$_\\$prog");
		return "$_\\$prog.bat" if (-f "$_\\$prog.bat" && -x "$_\\$prog.bat");
		return "$_\\$prog.com" if (-f "$_\\$prog.com" && -x "$_\\$prog.com");
		return "$_\\$prog.exe" if (-f "$_\\$prog.exe" && -x "$_\\$prog.exe");
		return "$_\\$prog.cmd" if (-f "$_\\$prog.cmd" && -x "$_\\$prog.cmd");
	    } else {