view release on metacpan or  search on metacpan

bin/sbozyp  view on Meta::CPAN

        my $repo_root = $CONFIG{REPO_ROOT};
        $repo_root =~ s,/+,/,g; $repo_root =~ s,/+$,,;
        $repo_root.'/'.$CONFIG{REPO_NAME}.'/';
    };
    return $repo_dir;
}

sub repo_is_cloned {
    return -d repo_dir().'.git' ? 1 : 0;
}

sub clone_repo {
    my $repo_dir = repo_dir();
    sbozyp_mkdir($repo_dir);
    if (repo_is_cloned()) {
        sbozyp_rmdir_rec($repo_dir);
        sbozyp_mkdir($repo_dir);
    }
    my $repo_git_branch = repo_git_branch();
    my $repo_git_url = repo_git_url();
    with_stdout_to_stderr(sub {
        sbozyp_system('git', 'clone', '--progress', '--single-branch', '--branch', $repo_git_branch, '--no-tags', $repo_git_url, $repo_dir);
    });
}

sub sync_repo {
    my $repo_dir = repo_dir();
    if (repo_is_cloned()) {
        my $repo_git_branch = repo_git_branch();
        with_stdout_to_stderr(sub {
            sbozyp_system('git', '-C', $repo_dir, 'fetch', '--progress', '--verbose');
            sbozyp_system('git', '-C', $repo_dir, 'reset', '--hard', '--quiet', "origin/$repo_git_branch");
        });
    } else {
        sbozyp_die("cannot sync non-existent git repository at '$repo_dir'");
    }
}

            ####################################################
            #               CONFIGURATION & HELP               #
            ####################################################

sub parse_config_file {
    my ($config_file) = @_;
    my $fh = sbozyp_open('<', $config_file);
    while (<$fh>) {
        chomp;
        my $line_copy = $_; # save $_ so we can create a nice error message if things go wrong
        s/#.*//;            # no comments
        s/^\s+//;           # no leading whitespace
        s/\s+$//;           # no trailing whitespace
        s/\/+$//;           # no trailing /'s
        next unless length; # is there anything left?
        my ($k, $v) = split /\s*=\s*/, $_, 2;
        $k !~ /^\s*$/ && $v !~ /^\s*$/ or sbozyp_die("could not parse line $. '$line_copy': '$config_file'");
        $CONFIG{$k} = $v;
    }
}

sub sbozyp_getopts {
    my $err_prefix = (caller(1))[3] =~ /main_([a-z]+)$/ ? "$1: " : '';
    my $getopt_err;
    local $SIG{__WARN__} = sub { chomp($getopt_err = lcfirst $_[0]) };
    GetOptionsFromArray(@_) or sbozyp_die($err_prefix.$getopt_err);
}

sub sbozyp_pod2usage {
    my ($sections) = @_;
    my $fh = sbozyp_open('>', \my $pod);
    pod2usage(
        -input    => __FILE__,
        -output   => $fh,
        -exitval  => 'NOEXIT',
        -verbose  => 99,
        -sections => $sections
    );
    return $pod;
}

sub command_usage {
    my ($cmd) = @_;
    my $pod = sbozyp_pod2usage($cmd eq 'main' ? 'OVERVIEW' : 'COMMANDS/'.uc($cmd));
    my $usage = ($pod =~ /(Usage:[^\n]+)/s)[0];
    return "$usage\n";
}

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 sbozyp_qx {
    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");