view release on metacpan or  search on metacpan

lib/Apache/Logmonster/Utility.pm  view on Meta::CPAN

package Apache::Logmonster::Utility;
# ABSTRACT: utility subroutines for sysadmin tasks

use strict;
use warnings;

our $VERSION = '5.36';

use Cwd;
use Carp;
use English qw( -no_match_vars );
use File::Basename;
use File::Copy;
use File::Path;
use File::Spec;
use File::stat;
use Params::Validate qw(:all);
use Scalar::Util qw( openhandle );
use URI;

use lib 'lib';
use vars qw/ $log %std_opts /;

sub new {
    my $class = shift;

# globally scoped hash, populated with defaults as requested by the caller
    %std_opts = (
        'fatal'   => { type => BOOLEAN, optional => 1, default => 1 },
        'debug'   => { type => BOOLEAN, optional => 1, default => 1 },
        'quiet'   => { type => BOOLEAN, optional => 1, default => 0 },
        'test_ok' => { type => BOOLEAN, optional => 1 },
    );

    my %p = validate( @_,
        {  toaster=> { type => OBJECT,  optional => 1 },
            %std_opts,
        }
    );

    my $toaster = $p{toaster};
    my $self = {
        debug => $p{debug},
        fatal => $p{fatal},
    };
    bless $self, $class;

    $log = $self->{log} = $self;

    $log->audit( $class . sprintf( " loaded by %s, %s, %s", caller ) );
    return $self;
}

sub ask {
    my $self = shift;
    my $question = shift;
    my %p = validate(
        @_,
        {   default  => { type => SCALAR|UNDEF, optional => 1 },
            timeout  => { type => SCALAR,  optional => 1 },
            password => { type => BOOLEAN, optional => 1, default => 0 },
            test_ok  => { type => BOOLEAN, optional => 1 },
        }
    );

    my $pass     = $p{password};
    my $default  = $p{default};

    if ( ! $self->is_interactive() ) {
        $log->audit( "not running interactively, can not prompt!");
        return $default;
    }

    return $log->error( "ask called with \'$question\' which looks unsafe." )
        if $question !~ m{\A \p{Any}* \z}xms;

    my $response;

    return $p{test_ok} if defined $p{test_ok};

PROMPT: