Apache-Logmonster

 view release on metacpan or  search on metacpan

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

        }
    );

    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(
        @_,

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

        }
    );

    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(

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

            $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);

t/Utility.t  view on Meta::CPAN

}

# tests system_chown because sudo is set, might cause testers to freak out
#	ok ($util->chown( $rwtest, uid=>$uid, gid=>$gid, sudo=>1, fatal=>0 ), 'chown');
#	ok ( ! $util->chown( $rwtest, uid=>'frobnob6i', gid=>'frobnob6i', sudo=>1, fatal=>0 ), 'chown');
#	ok ( ! $util->chown( $rwtest, uid=>$root, gid=>$wheel, sudo=>1,fatal=>0), 'chown');

# chmod
# get the permissions of the file in octal file mode
use File::stat;
my $st = stat($rwtest) or warn "No $tmp: $!\n";
my $before = sprintf "%lo", $st->mode & 07777;

#$util->syscmd( "ls -al $rwtest" );   # use ls -al to view perms

# change the permissions to something slightly unique
if ( lc($OSNAME) ne 'irix' ) {
# not sure why this doesn't work on IRIX, and since IRIX is EOL and nearly 
# extinct, I'm not too motivated to find out why.
    ok( $util->chmod(
            file_or_dir => $rwtest,   mode        => '0700',