view release on metacpan or  search on metacpan

bin/sbozyp  view on Meta::CPAN

    my @cmd = @_;
    open(my $fh, '-|', @cmd) or sbozyp_die("could not run command '@cmd': $!");
    my @output = <$fh>;
    close $fh;
    my $result = $?; my $status = $result >> 8; my $signal = $result & 127;
    if (0 != $status) {
        sbozyp_die("the following system command exited with status $status: @cmd");
    } elsif (0 != $signal) {
        sbozyp_die("the following system command was killed by signal $signal: @cmd");
    }
    if (wantarray) {
        chomp @output;
        return @output;
    } else {
        my $output = join('', @output);
        chomp $output;
        return $output;
    }
}

sub with_stdout_to_stderr {
    my ($sub) = @_;
    open(my $orig_stdout, '>&', \*STDOUT) or sbozyp_die("failed to dup STDOUT: $!");
    open(STDOUT, '>&=', \*STDERR) or sbozyp_die("failed to redirect STDOUT to STDERR: $!");
    my $ret = $sub->();
    open(STDOUT, '>&=', $orig_stdout) or sbozyp_die("failed to restore STDOUT: $!");
    return $ret;
}

sub with_cwd {
    my ($dir, $sub) = @_;
    my $orig_cwd = Cwd::getcwd();
    sbozyp_chdir($dir);
    my $ret = eval { $sub->() }; my $err = $@;
    sbozyp_chdir($orig_cwd);
    if ($err) { $! = 1; die $err };
    return $ret;
}

sub arch {
    state $arch = (POSIX::uname())[4];
    return $arch;
}

sub i_am_root {
    return 0 == $> ? 1 : 0;
}

sub i_am_root_or_die {
    my ($msg) = @_;
    sbozyp_die($msg // 'must be root') unless i_am_root();
}

sub is_path_arg {
    my ($arg) = @_;
    return defined $arg && ($arg eq '.' || $arg eq '..' || $arg =~ m{^(?:\./|\.\./|/)}) ? 1 : 0;
}

sub decode_url { # https://stackoverflow.com/a/4510561/13603478
    my ($url) = @_;
    my $decoded = $url =~ s/%([A-Fa-f\d]{2})/chr hex $1/egr;
    return $decoded;
}

# The internal algorithm of version_cmp() is copy and pasted directly from the
# Sort::Versions CPAN module's versioncmp() function. We copy and paste this
# here instead of depending on Sort::Versions as we don't wish for sbozyp to
# have any dependencies. Note that sbotools also uses Sort::Versions for version
# comparisons.
sub version_cmp {
    my ($v1, $v2) = @_;
    my @v1 = ($v1 =~ /([-.]|\d+|[^-.\d]+)/g);
    my @v2 = ($v2 =~ /([-.]|\d+|[^-.\d]+)/g);
    while (@v1 and @v2) {
        $v1 = shift @v1;
        $v2 = shift @v2;
        if ($v1 eq '-' and $v2 eq '-') {
            next;
        } elsif ( $v1 eq '-' ) {
            return -1;
        } elsif ( $v2 eq '-') {
            return 1;
        } elsif ($v1 eq '.' and $v2 eq '.') {
            next;
        } elsif ( $v1 eq '.' ) {
            return -1;
        } elsif ( $v2 eq '.' ) {
            return 1;
        } elsif ($v1 =~ /^\d+$/ and $v2 =~ /^\d+$/) {
            if ($v1 =~ /^0/ || $v2 =~ /^0/) {
                my $cmp = $v1 cmp $v2;
                return $cmp if $cmp;
            } else {
                my $cmp = $v1 <=> $v2;
                return $cmp if $cmp;
            }
        } else {
            $v1 = uc $v1;
            $v2 = uc $v2;
            my $cmp = $v1 cmp $v2;
            return $cmp if $cmp;
        }
    }
    return @v1 <=> @v2;
}

sub version_build_gt {
    my ($version1, $build1, $version2, $build2) = @_;
    my $cmp = version_cmp($version1, $version2);
    return $cmp > 0 || ($cmp == 0 && $build1 > $build2);
}

sub sbozyp_mkdir {
    my @dirs = @_;
    for my $dir (@dirs) {
        unless (-d $dir) {
            make_path($dir, {error => \my $err});
            if ($err) {
                for my $diag (@$err) {
                    my (undef, $err_msg) = %$diag;
                    sbozyp_die("could not mkdir '$dir': $err_msg");
                }