view release on metacpan or  search on metacpan

lib/App/Yabsm/Tools.pm  view on Meta::CPAN

}

sub nums_denote_valid_date_or_die {

    # Wrapper around &nums_denote_valid_date that Carp::Confess's if it
    # returns false.

    arg_count_or_die(5, 5, @_);

    unless ( nums_denote_valid_date(@_) ) {
        my ($yr, $mon, $day, $hr, $min) = @_;
        confess("yabsm: internal error: '${yr}_${mon}_${day}_$hr:$min' does not denote a valid yr_mon_day_hr:min date");
    }

    return 1;
}

sub system_or_die {

    # Wrapper around system that Carp::Confess's if the system command exits
    # with a non-zero status. Redirects STDOUT and STDERR to /dev/null.

    open my $NULLFD, '>', '/dev/null';
    open my $OLD_STDOUT, '>&', STDOUT;
    open my $OLD_STDERR, '>&', STDERR;
    open STDOUT, '>&', $NULLFD;
    open STDERR, '>&', $NULLFD;

    my $status = system @_;

    open STDOUT, '>&', $OLD_STDOUT;
    open STDERR, '>&', $OLD_STDERR;
    close $NULLFD;
    close $OLD_STDOUT;
    close $OLD_STDERR;

    unless (0 == $status) {
        confess("yabsm: internal error: system command '@_' exited with non-zero status '$status'");
    }

    return 1;
}

sub make_path_or_die {

    # Wrapper around File::Path::make_path() that Carp::Confess's if the path
    # cannot be created. The UID and GID of the $path will be set to that of the
    # deepest existing sub-directory in $path.

    my $path = shift;

    $path =~ /^\//
      or die "yabsm: internal error: '$path' is not an absolute path starting with '/'";

    my $dir = $path;

    until (-d $dir) {
        $dir = dirname($dir);
    }

    my ($uid, $gid) = (stat $dir)[4,5];

    -d $path and return 1;

    make_path($path, {uid => $uid, group => $gid}) and return 1;

    my $username = getpwuid $<;

    die "yabsm: error: could not create path '$path' while running as user '$username'\n";
}

sub i_am_root {

    # Return 1 if current user is root and return 0 otherwise.

    return 0+(0 == $<);
}

sub i_am_root_or_die {

    # Die unless running as the root user.

    arg_count_or_die(0, 0, @_);

    unless (i_am_root()) {
        my $username = getpwuid $<;
        confess("yabsm: internal error: not running as root - running as '$username'");
    }

    return 1;
}

1;