view release on metacpan or  search on metacpan

lib/Provision/Unix/Utility.pm  view on Meta::CPAN

    # Not interactive if output is not to terminal...
    return if not -t $out_handle;

    # If *ARGV is opened, we're interactive if...
    if ( openhandle * ARGV ) {

        # ...it's currently opened to the magic '-' file
        return -t *STDIN if defined $ARGV && $ARGV eq '-';

        # ...it's at end-of-file and the next file is the magic '-' file
        return @ARGV > 0 && $ARGV[0] eq '-' && -t *STDIN if eof *ARGV;

        # ...it's directly attached to the terminal
        return -t *ARGV;
    };

   # If *ARGV isn't opened, it will be interactive if *STDIN is attached
   # to a terminal and either there are no files specified on the command line
   # or if there are files and the first is the magic '-' file
    return -t *STDIN && ( @ARGV == 0 || $ARGV[0] eq '-' );
}

sub is_process_running {
    my ( $self, $process ) = @_;

## no critic ( ProhibitStringyEval )
    eval "require Proc::ProcessTable";
## use critic
    if ( ! $EVAL_ERROR ) {
        my $i = 0;
        my $t = Proc::ProcessTable->new();
        if ( scalar @{ $t->table } ) {
            foreach my $p ( @{ $t->table } ) {
                $i++ if ( $p->cmndline =~ m/$process/i );
            };
            return $i;
        };
    };

    my $ps   = $self->find_bin( 'ps', debug => 0 );

    if    ( lc($OSNAME) =~ /solaris/i ) { $ps .= ' -ef';  }
    elsif ( lc($OSNAME) =~ /irix/i    ) { $ps .= ' -ef';  }
    elsif ( lc($OSNAME) =~ /linux/i   ) { $ps .= ' -efw'; }
    else                                { $ps .= ' axww'; };

    my @procs = `$ps`;
    chomp @procs;
    return scalar grep {/$process/i} @procs;
}

sub is_readable {
    my $self = shift;
    my $file = shift or die "missing file or dir name\n";
    my %p = validate( @_, { %std_opts } );

    my %args = ( debug => $p{debug}, fatal => $p{fatal} );

    -e $file or return $log->error( "$file does not exist.", %args);
    -r $file or return $log->error( "$file is not readable by you ("
            . getpwuid($>)
            . "). You need to fix this, using chown or chmod.", %args);

    return 1;
}

sub is_writable {
    my $self = shift;
    my $file = shift or die "missing file or dir name\n";

    my %p = validate( @_, { %std_opts } );
    my %args = ( debug => $p{debug}, fatal => $p{fatal} );

    my $nl = "\n";
    $nl = "<br>" if ( $ENV{GATEWAY_INTERFACE} );

    if ( !-e $file ) {

        my ( $base, $path, $suffix ) = fileparse($file);

        return $log->error( "is_writable: $path not writable by "
            . getpwuid($>)
            . "$nl$nl", %args) if (-e $path && !-w $path);
        return 1;
    }

    return $log->error( "  $file not writable by " . getpwuid($>) . "$nl$nl", %args ) if ! -w $file;

    $log->audit( "$file is writable" );
    return 1;
}

sub logfile_append {
    my $self = shift;
    my %p = validate(
        @_,
        {   'file'  => { type => SCALAR,   optional => 0, },
            'lines' => { type => ARRAYREF, optional => 0, },
            'prog'  => { type => BOOLEAN,  optional => 1, default => 0, },
            %std_opts,
        },
    );

    my ( $file, $lines ) = ( $p{file}, $p{lines} );
    my %args = ( debug => $p{debug}, fatal => $p{fatal} );

    my ( $dd, $mm, $yy, $lm, $hh, $mn, $ss ) = $self->get_the_date( %args );

    open my $LOG_FILE, '>>', $file 
        or return $log->error( "couldn't open $file: $OS_ERROR", %args);

    print $LOG_FILE "$yy-$mm-$dd $hh:$mn:$ss $p{prog} ";

    my $i;
    foreach (@$lines) { print $LOG_FILE "$_ "; $i++ }

    print $LOG_FILE "\n";
    close $LOG_FILE;

    $log->audit( "logfile_append wrote $i lines to $file", %args );
    return 1;
}

sub mail_toaster {
    my $self = shift;
    $self->install_module( 'Mail::Toaster' );
}

sub mkdir_system {
    my $self = shift;
    my %p = validate(
        @_,
        {   'dir'   => { type => SCALAR,  optional => 0, },
            'mode'  => { type => SCALAR,  optional => 1, },
            'sudo'  => { type => BOOLEAN, optional => 1, default => 0 },
            %std_opts,
        }
    );

    my ( $dir, $mode ) = ( $p{dir}, $p{mode} );
    my %args = ( debug => $p{debug}, fatal => $p{fatal} );

    return $log->audit( "mkdir_system: $dir already exists.") if -d $dir;

    my $mkdir = $self->find_bin( 'mkdir', %args) or return;

    # if we are root, just do it (no sudo nonsense)