view release on metacpan or  search on metacpan

lib/Sysadm/Install.pm  view on Meta::CPAN

###############################################
sub quote {
###############################################
    my($str, $metas) = @_;

    if(defined $metas and $metas eq ":shell") {
        $str =~ s/([\\])/\\$1/g;
        $str =~ s/(['])/'\\''/g;
    } else {
        $str =~ s/([\\'])/\\$1/g;
    }

    if(defined $metas and $metas ne ":shell") {
        $metas =~ s/\]/\\]/g;
        $str =~ s/([$metas])/\\$1/g;
    }

    return "\'$str\'";
}

=pod

=item C<perm_cp($src, $dst, ...)>

Read the C<$src> file's user permissions and modify all
C<$dst> files to reflect the same permissions.

=cut

######################################
sub perm_cp {
######################################
    # Lifted from Ben Okopnik's
    # http://www.linuxgazette.com/issue87/misc/tips/cpmod.pl.txt

    local $Log::Log4perl::caller_depth =
          $Log::Log4perl::caller_depth + 1;

    _confirm "perm_cp @_" or return 1;

    LOGCROAK("usage: perm_cp src dst ...") if @_ < 2;

    my $perms = perm_get($_[0]);
    perm_set($_[1], $perms);
}

=pod

=item C<owner_cp($src, $dst, ...)>

Read the C<$src> file/directory's owner uid and group gid and apply
it to $dst.

For example: copy uid/gid of the containing directory to a file
therein:

    use File::Basename;

    owner_cp( dirname($file), $file );

Usually requires root privileges, just like chown does.

=cut

######################################
sub owner_cp {
######################################
    my($src, @dst) = @_;

    local $Log::Log4perl::caller_depth =
          $Log::Log4perl::caller_depth + 1;

    _confirm "owner_cp @_" or return 1;

    LOGCROAK("usage: owner_cp src dst ...") if @_ < 2;

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

    if(!defined $uid or !defined $gid ) {
        LOGCROAK("stat of $src failed: $!");
        return undef;
    }

    if(!chown $uid, $gid, @dst ) {
        LOGCROAK("chown of ", join(" ", @dst), " failed: $!");
        return undef;
    }

    return 1;
}

=pod

=item C<$perms = perm_get($filename)>

Read the C<$filename>'s user permissions and owner/group. 
Returns an array ref to be
used later when calling C<perm_set($filename, $perms)>.

=cut 

######################################
sub perm_get {
######################################
    my($filename) = @_;

    local $Log::Log4perl::caller_depth =
          $Log::Log4perl::caller_depth + 1;

    my @stats = (stat $filename)[2,4,5] or
        
        LOGCROAK("Cannot stat $filename ($!)");

    INFO "perm_get $filename (@stats)";

    return \@stats;
}

=pod

=item C<perm_set($filename, $perms)>

Set file permissions and owner of C<$filename>
according to C<$perms>, which was previously
acquired by calling C<perm_get($filename)>.

=cut 

######################################
sub perm_set {
######################################
    my($filename, $perms) = @_;

    local $Log::Log4perl::caller_depth =
          $Log::Log4perl::caller_depth + 1;

    _confirm "perm_set $filename (@$perms)" or return 1;

    chown($perms->[1], $perms->[2], $filename) or 
        
        LOGCROAK("Cannot chown $filename ($!)");
    chmod($perms->[0] & 07777,    $filename) or
        
        LOGCROAK("Cannot chmod $filename ($!)");
}

=pod

=item C<sysrun($cmd)>

Run a shell command via C<system()> and die() if it fails. Also 
works with a list of arguments, which are then interpreted as program
name plus arguments, just like C<system()> does it.

=cut

######################################
sub sysrun {
######################################
    my(@cmds) = @_;

    local $Log::Log4perl::caller_depth =
          $Log::Log4perl::caller_depth + 1;

    _confirm "sysrun: @cmds" or return 1;

    LOGCROAK("usage: sysrun cmd ...") if @_ < 1;

    system(@cmds) and 
        LOGCROAK("@cmds failed ($!)");
}

=pod

=item C<hammer($cmd, $arg, ...)>

Run a command in the shell and simulate a user hammering the
ENTER key to accept defaults on prompts.

=cut

######################################
sub hammer {
######################################
    my(@cmds) = @_;

    require Expect;

    local $Log::Log4perl::caller_depth =
          $Log::Log4perl::caller_depth + 1;

        _confirm "Hammer: @cmds" or return 1;

    my $exp = Expect->new();
    $exp->raw_pty(0);

    INFO "spawning: @cmds";
    $exp->spawn(@cmds);

    $exp->send_slow(0.1, "\n") for 1..199;
    $exp->expect(undef);