view release on metacpan or  search on metacpan

bin/sbozyp  view on Meta::CPAN

sub command_help_msg {
    my ($cmd) = @_;
    my $pod = sbozyp_pod2usage($cmd eq 'main' ? 'OVERVIEW' : 'COMMANDS/'.uc($cmd));
    my @pod = split "\n", $pod; @pod = @pod[1..$#pod];
    $pod[0] =~ s/^ //;
    $_ =~ s/^.{4}// for @pod;
    $pod = join("\n", @pod) . "\n";
    return $pod;
}

            ####################################################
            #                     UTILITIES                    #
            ####################################################

sub sbozyp_system {
    my @cmd = @_;
    my $result = system(@cmd); 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");
    }
    return $status;
}

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 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_gt() 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_gt {
    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 0;
        } elsif ( $v2 eq '-') {
            return 1;
        } elsif ($v1 eq '.' and $v2 eq '.') {
            next;
        } elsif ( $v1 eq '.' ) {
            return 0;
        } elsif ( $v2 eq '.' ) {
            return 1;
        } elsif ($v1 =~ /^\d+$/ and $v2 =~ /^\d+$/) {
            if ($v1 =~ /^0/ || $v2 =~ /^0/) {
                my $cmp = $v1 cmp $v2;
                return 0 if $cmp < 0;
                return 1 if $cmp > 0;
            } else {
                my $cmp = $v1 <=> $v2;
                return 0 if $cmp < 0;
                return 1 if $cmp > 0;
            }
        } else {
            $v1 = uc $v1;
            $v2 = uc $v2;
            my $cmp = $v1 cmp $v2;
            return 0 if $cmp < 0;
            return 1 if $cmp > 0;
        }
    }
    return @v1 > @v2 ? 1 : 0;
}

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");
                }
            }
        }
    }