view release on metacpan or  search on metacpan

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

}

sub file_delete {
    my $self = shift;
    my $file = shift or die "missing file argument";
    my %p = validate( @_,
        {   'sudo'  => { type => BOOLEAN, optional => 1, default => 0 },
            %std_opts,
        }
    );

    my %args = $self->get_std_args( %p );

    return $log->error( "$file does not exist", %args ) if !-e $file;

    if ( -w $file ) {
        $log->audit( "write permission to $file: ok" );

        unlink $file or return $log->error( "failed to delete $file", %args );

        $log->audit( "deleted: $file" );
        return 1;
    }

    if ( !$p{sudo} ) {    # all done
        return -e $file ? undef : 1;
    }

    my $err = "trying with system rm";
    my $rm_command = $self->find_bin( "rm", %args );
    $rm_command .= " -f $file";

    if ( $< != 0 ) {      # we're not running as root
        my $sudo = $self->sudo( %args );
        $rm_command = "$sudo $rm_command";
        $err .= " (sudo)";
    }

    $self->syscmd( $rm_command, %args )
        or return $log->error( $err, %args );

    return -e $file ? 0 : 1;
}

sub file_is_newer {
    my $self = shift;
    my %p = validate( @_,
        {   f1  => { type => SCALAR },
            f2  => { type => SCALAR },
            %std_opts,
        }
    );

    my ( $file1, $file2 ) = ( $p{f1}, $p{f2} );

    # get file attributes via stat
    # (dev,ino,mode,nlink,uid,gid,rdev,size,atime,mtime,ctime,blksize,blocks)

    $log->audit( "checking age of $file1 and $file2" );

    my $stat1 = stat($file1)->mtime;
    my $stat2 = stat($file2)->mtime;

    $log->audit( "timestamps are $stat1 and $stat2");

    return 1 if ( $stat2 > $stat1 );
    return;

    # I could just:
    #
    # if ( stat($f1)[9] > stat($f2)[9] )
    #
    # but that forces the reader to read the man page for stat
    # to see what's happening
}

sub file_read {
    my $self = shift;
    my $file = shift or return $log->error("missing filename in request");
    my %p = validate(
        @_,
        {   'max_lines'  => { type => SCALAR, optional => 1 },
            'max_length' => { type => SCALAR, optional => 1 },
            %std_opts
        }
    );

    my ( $max_lines, $max_length ) = ( $p{max_lines}, $p{max_length} );
    my %args = $self->get_std_args( %p );

    return $log->error( "$file does not exist!", %args) if !-e $file;
    return $log->error( "$file is not readable", %args ) if !-r $file;

    open my $FILE, '<', $file or
        return $log->error( "could not open $file: $OS_ERROR", %args );

    my ( $line, @lines );

    if ( ! $max_lines) {
        chomp( @lines = <$FILE> );
        close $FILE;
        return @lines;
# TODO: make max_length work with slurp mode, without doing something ugly like
# reading in the entire line and then truncating it.
    };

    my $i = 0;
    while ( $i < $max_lines ) {
        if ($max_length) { $line = substr <$FILE>, 0, $max_length; }
        else             { $line = <$FILE>; };
        last if ! $line;
        last if eof $FILE;
        push @lines, $line;
        $i++;
    }
    chomp @lines;
    close $FILE;
    return @lines;
}

sub file_mode {
    my $self = shift;
    my %p = validate( @_,
        {   'file'  => { type => SCALAR },
            %std_opts
        }
    );

    my $file = $p{file};
    my %args = $self->get_std_args( %p );

    return $log->error( "file '$file' does not exist!", %args)
        if !-e $file;

    # one way to get file mode (using File::mode)
    #    my $raw_mode = stat($file)->[2];
    ## no critic
    my $mode = sprintf "%04o", stat($file)->[2] & 07777;

    # another way to get it
    #    my $st = stat($file);
    #    my $mode = sprintf "%lo", $st->mode & 07777;

    $log->audit( "file $file has mode: $mode" );
    return $mode;
}

sub file_write {
    my $self = shift;
    my $file = shift or return $log->error("missing filename in request");
    my %p = validate(
        @_,
        {   'lines'  => { type => ARRAYREF },
            'append' => { type => BOOLEAN, optional => 1, default => 0 },
            'mode'  => { type => SCALAR,  optional => 1 },
            %std_opts
        }
    );

    my $append = $p{append};
    my $lines  = $p{lines};
    my %args = $self->get_std_args( %p );

    return $log->error( "oops, $file is a directory", %args) if -d $file;
    return $log->error( "oops, $file is not writable", %args )
        if ( ! $self->is_writable( $file, %args) );

    my $m = "wrote";
    my $write_mode = '>';    # (over)write

    if ( $append ) {
        $m = "appended";
        $write_mode = '>>';
        if ( -f $file ) {
            copy $file, "$file.tmp" or return $log->error(
                "couldn't create $file.tmp for safe append", %args );
        };
    };

    open my $HANDLE, $write_mode, "$file.tmp"
        or return $log->error( "file_write: couldn't open $file: $!", %args );

    my $c = 0;
    foreach ( @$lines ) { chomp; print $HANDLE "$_\n"; $c++ };
    close $HANDLE or return $log->error( "couldn't close $file: $!", %args );

    $log->audit( "file_write: $m $c lines to $file", %args );

    move( "$file.tmp", $file )
        or return $log->error("  unable to update $file", %args);

    # set file permissions mode if requested
    $self->chmod( file => $file, mode => $p{mode}, %args )
        or return if $p{mode};

    return 1;
}

sub files_diff {
    my $self = shift;
    my %p = validate(

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

            if $mode;
        return -d $dir ? 1 : 0;
    }

    $log->audit( "trying mkdir -p $dir" );

    # no root and no sudo, just try and see what happens
    $self->syscmd( "$mkdir -p $dir", %args ) or return;

    $self->chmod( dir => $dir, mode => $mode, %args) if $mode;

    return $log->audit( "mkdir_system created $dir" ) if -d $dir;
    return $log->error( '', %args );
}

sub path_parse {

    # code left here for reference, use File::Basename instead
    my ( $self, $dir ) = @_;

    # if it ends with a /, chop if off
    if ( $dir =~ q{/$} ) { chop $dir }

    # get the position of the last / in the path
    my $rindex = rindex( $dir, "/" );

    # grabs everything up to the last /
    my $updir = substr( $dir, 0, $rindex );
    $rindex++;

    # matches from the last / char +1 to the end of string
    my $curdir = substr( $dir, $rindex );

    return $updir, $curdir;
}

sub check_pidfile {
    my $self = shift;
    my $file = shift;
    my %p = validate( @_, { %std_opts } );
    my %args = $self->get_std_args( %p );

    return $log->error( "missing filename", %args) if ! $file;
    return $log->error( "$file is not a regular file", %args)
        if ( -e $file && !-f $file );

    # test if file & enclosing directory is writable, revert to /tmp if not
    $self->is_writable( $file, %args)
        or do {
            my ( $base, $path, $suffix ) = fileparse($file);
            $log->audit( "NOTICE: using /tmp for file, $path is not writable!", %args);
            $file = "/tmp/$base";
        };

    # if it does not exist
    if ( !-e $file ) {
        $log->audit( "writing process id $PROCESS_ID to $file...");
        $self->file_write( $file, lines => [$PROCESS_ID], %args) and return $file;
    };

    my $age = time() - stat($file)->mtime;

    if ( $age < 1200 ) {    # less than 20 minutes old
        return $log->error( "check_pidfile: $file is " . $age / 60
            . " minutes old and might still be running. If it is not running,"
            . " please remove the file (rm $file).", %args);
    }
    elsif ( $age < 3600 ) {    # 1 hour
        return $log->error( "check_pidfile: $file is " . $age / 60
            . " minutes old and might still be running. If it is not running,"
            . " please remove the pidfile. (rm $file)", %args);
    }
    else {
        $log->audit( "check_pidfile: $file is $age seconds old, ignoring.", %args);
    }

    return $file;
}

sub parse_config {
    my $self = shift;
    my $file = shift or die "missing file name";
    my %p = validate( @_, {
            etcdir => { type=>SCALAR,  optional=>1, },
            %std_opts,
        },
    );

    my %args = $self->get_std_args( %p );

    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 },
        },