Apache-Logmonster

 view release on metacpan or  search on metacpan

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

    };

    if ( lc($OSNAME) eq 'linux' ) {
        my $rpm = $info->{rpm} or return $log->error("skipping install of $app b/c rpm not set", fatal => 0);
        my $yum = '/usr/bin/yum';
        return $log->error( "couldn't find yum, skipping install.", fatal => 0)
            if ! -x $yum;
        return system "$yum install $rpm";
    };

    $log->error(" no package support for $OSNAME ");
}

sub install_module {
    my ($self, $module, %info) = @_;

    my $debug = defined $info{debug} ? $info{debug} : 1;

## no critic ( ProhibitStringyEval )
    eval "use $module";
## use critic
    if ( ! $EVAL_ERROR ) {
        $log->audit( "$module is already installed.",debug=>$debug );
    };

    if ( lc($OSNAME) eq 'darwin' ) {
        $self->install_module_darwin( $module ) and return 1;
    }
    elsif ( lc($OSNAME) eq 'freebsd' ) {
        $self->install_module_freebsd( $module, \%info) and return 1;
    }
    elsif ( lc($OSNAME) eq 'linux' ) {
        $self->install_module_linux( $module, \%info) and return 1;
    };

    $self->install_module_cpan( $module );

    ## no critic ( ProhibitStringyEval )
    eval "use $module";
    ## use critic
    if ( ! $EVAL_ERROR ) {
        $log->audit( "$module is installed." );
        return 1;
    };
    return;
}

sub install_module_cpan {
    my $self = shift;
    my ($module, $version) = @_;

    print " from CPAN...";
    require CPAN;

    # some Linux distros break CPAN by auto/preconfiguring it with no URL mirrors.
    # this works around that annoying little habit
    no warnings;
    $CPAN::Config = get_cpan_config();
    use warnings;

    if ( $module eq 'Provision::Unix' && $version ) {
        $module =~ s/\:\:/\-/g;
        $module = "M/MS/MSIMERSON/$module-$version.tar.gz";
    }
    CPAN::Shell->install($module);
}

sub install_module_darwin {
    my $self = shift;
    my $module = shift;

    my $dport = '/opt/local/bin/port';
    return $log->error( "Darwin ports is not installed!", fatal => 0)
        if ! -x $dport;

    my $port = "p5-$module";
    $port =~ s/::/-/g;
    system "sudo $dport install $port" or return 1;
    return;
};

sub install_module_freebsd {
    my $self = shift;
    my ($module, $info) = @_;

    my $portname = $info->{port}; # optional override
    if ( ! $portname ) {
        $portname = "p5-$module";
        $portname =~ s/::/-/g;
    };

    my $r = `/usr/sbin/pkg_info | /usr/bin/grep $portname`;
    return $log->audit( "$module is installed as $r") if $r;

    my $portdir = glob("/usr/ports/*/$portname");

    if ( $portdir && -d $portdir && chdir $portdir ) {
        $log->audit( "installing $module from ports ($portdir)" );
        system "make clean && make install clean";
        return 1;
    }
    return;
}

sub install_module_from_src {
    my $self = shift;
    my %p = validate( @_, {
            module  => { type=>SCALAR,  optional=>0, },
            archive => { type=>SCALAR,  optional=>0, },
            site    => { type=>SCALAR,  optional=>0, },
            url     => { type=>SCALAR,  optional=>0, },
            src     => { type=>SCALAR,  optional=>1, default=>'/usr/local/src' },
            targets => { type=>ARRAYREF,optional=>1, },
            %std_opts,
        },
    );

    my ( $module, $site, $url, $src, $targets )
        = ( $p{module}, $p{site}, $p{url}, $p{src}, $p{targets} );
    my %args = $self->get_std_args( %p );

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

    if ( ! -f $file ) { $file = $self->find_config( $file, %p ); };

    if ( ! $file || ! -r $file ) {
        return $log->error( "could not find config file!", %args);
    };

    my %hash;
    $log->audit( "  read config from $file");

    my @config = $self->file_read( $file );
    foreach ( @config ) {
        next if ! $_;
        chomp;
        next if $_ =~ /^#/;          # skip lines beginning with #
        next if $_ =~ /^[\s+]?$/;    # skip empty lines

        my ( $key, $val ) = $self->parse_line( $_ );

        next if ! $key;
        $hash{$key} = $val;
    }

    return \%hash;
}

sub parse_line {
    my $self = shift;
    my $line = shift;
    my %p = validate( @_, {
            strip => { type => BOOLEAN, optional=>1, default=>1 },
        },
    );

    my $strip = $p{strip};

    # this regexp must match and return these patterns
    # localhost1  = localhost, disk, da0, disk_da0
    # hosts   = localhost lab.simerson.net seattle.simerson.net

    my ( $key, $val ) = $line =~ /\A
        \s*      # any amount of leading white space, greedy
        (.*?)    # all characters, non greedy
        \s*      # any amount of white space, greedy
        =
        \s*      # same, except on the other side of the =
        (.*?)
        \s*
        \z/xms;

    # remove any comments
    if ( $strip && $val && $val =~ /#/ ) {

        # removes everything from a # to the right, including
        # any spaces to the left of the # symbol.
        ($val) = $val =~ /(.*?\S)\s*#/;
    }

    return ( $key, $val );
}

sub provision_unix {
    my $self = shift;
    $self->install_module( 'Provision::Unix' );
}

sub regexp_test {
    my $self = shift;
    my %p = validate(
        @_,
        {   'exp'    => { type => SCALAR },
            'string' => { type => SCALAR },
            'pbp'    => { type => BOOLEAN, optional => 1, default => 0 },
            %std_opts,
        },
    );

    my $debug = $p{debug};
    my ( $exp, $string, $pbp ) = ( $p{exp}, $p{string}, $p{pbp} );

    if ($pbp) {
        if ( $string =~ m{($exp)}xms ) {
            print "\t Matched pbp: |$`<$&>$'|\n" if $debug;
            return $1;
        }
        else {
            print "\t No match.\n" if $debug;
            return;
        }
    }

    if ( $string =~ m{($exp)} ) {
        print "\t Matched: |$`<$&>$'|\n" if $debug;
        return $1;
    }

    print "\t No match.\n" if $debug;
    return;
}

sub sources_get {
    my $self = shift;
    my %p = validate(
        @_,
        {   'package' => { type => SCALAR,  optional => 0 },
            site      => { type => SCALAR,  optional => 0 },
            path      => { type => SCALAR,  optional => 1 },
            %std_opts,
        },
    );

    my ( $package, $site, $path ) = ( $p{package}, $p{site}, $p{path} );
    my %args = $self->get_std_args( %p );

    $log->audit( "sources_get: fetching $package from site $site\n\t path: $path");

    my @extensions = qw/ tar.gz tgz tar.bz2 tbz2 /;

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

    foreach my $ext (@extensions) {

        my $tarball = "$package.$ext";

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

   max_length - integer - maximum length of a line
   fatal
   debug

 result:
   0 - failure
   success - returns an array with the files contents, one line per array element


=item file_write

 usage:
   my @lines = "1", "2", "3";  # named array
   $util->file_write ( "/tmp/foo", lines=>\@lines );
        or
   $util->file_write ( "/tmp/foo", lines=>['1','2','3'] );  # anon arrayref

 required arguments:
   file - the file path you want to write to
   lines - an arrayref. Each array element will be a line in the file

 arguments optional:
   fatal
   debug

 result:
   0 - failure
   1 - success


=item files_diff

Determine if the files are different. $type is assumed to be text unless you set it otherwise. For anthing but text files, we do a MD5 checksum on the files to determine if they are different or not.

   $util->files_diff( f1=>$file1,f2=>$file2,type=>'text',debug=>1 );

   if ( $util->files_diff( f1=>"foo", f2=>"bar" ) )
   {
       print "different!\n";
   };

 required arguments:
   f1 - the first file to compare
   f2 - the second file to compare

 arguments optional:
   type - the type of file (text or binary)
   fatal
   debug

 result:
   0 - files are the same
   1 - files are different
  -1 - error.


=item find_bin

Check all the "normal" locations for a binary that should be on the system and returns the full path to the binary.

   $util->find_bin( 'dos2unix', dir=>'/opt/local/bin' );

Example:

   my $apachectl = $util->find_bin( "apachectl", dir=>"/usr/local/sbin" );


 arguments required:
   bin - the name of the program (its filename)

 arguments optional:
   dir - a directory to check first
   fatal
   debug

 results:
   0 - failure
   success will return the full path to the binary.


=item find_config

This sub is called by several others to determine which configuration file to use. The general logic is as follows:

  If the etc dir and file name are provided and the file exists, use it.

If that fails, then go prowling around the drive and look in all the usual places, in order of preference:

  /opt/local/etc/
  /usr/local/etc/
  /etc

Finally, if none of those work, then check the working directory for the named .conf file, or a .conf-dist.

Example:
  my $twconf = $util->find_config ( 'toaster-watcher.conf',
      etcdir => '/usr/local/etc',
    )

 arguments required:
   file - the .conf file to read in

 arguments optional:
   etcdir - the etc directory to prefer
   debug
   fatal

 result:
   0 - failure
   the path to $file


=item get_my_ips

returns an arrayref of IP addresses on local interfaces.

=item is_process_running

Verify if a process is running or not.

   $util->is_process_running($process) ? print "yes" : print "no";