view release on metacpan or  search on metacpan

t/Utility.t  view on Meta::CPAN

# chown
my $uid = getpwuid($UID);
my $gid = getgrgid($GID);
my $root = 'root';
my $grep = $util->find_bin( 'grep' );
my $wheel = `$grep wheel /etc/group` ? 'wheel' : 'root';

SKIP: {
    skip "the temp file for file_ch* is missing!", 4 if ( !-f $rwtest );

    # this one should work
    ok( $util->chown( $rwtest,
            uid   => $uid,
            gid   => $gid,
            sudo  => 0,
            fatal => 0
        ),
        'chown uid'
    );

    if ( $UID == 0 ) {
        ok( $util->chown( $rwtest,
                uid   => $root,
                gid   => $wheel,
                sudo  => 0,
                fatal => 0,
            ),
            'chown user'
        );
    }

    # try a user/group that does not exist
    ok( !$util->chown( $rwtest,
            uid   => 'frobnob6i',
            gid   => 'frobnob6i',
            sudo  => 0,
            fatal => 0
        ),
        'chown nonexisting uid'
    );

    # try a user/group that I may not have permission to
    if ( $UID != 0 && lc($OSNAME) ne 'irix') {
        ok( !$util->chown( $rwtest,
                uid   => $root,
                gid   => $wheel,
                sudo  => 0,
                fatal => 0
            ),
            'chown no perms'
        );
    }
}

# 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',
            fatal       => 0,
        ),
        'chmod'
    );

# file_mode
    my $result_mode = $util->file_mode( file => $rwtest );
    cmp_ok( $result_mode, '==', 700, 'file_mode' );

#$util->syscmd( "ls -al $rwtest" );

# and then set them back
    ok( $util->chmod(
            file_or_dir => $rwtest,
            mode        => $before,
            fatal => 0,
        ),
        'chmod'
    );
};

#$util->syscmd( "ls -al $rwtest" );

# file_write
ok( $util->file_write( $rwtest, lines => ["17"], fatal => 0 ), 'file_write');

#$ENV{PATH} = ""; print `/bin/cat $rwtest`;
#print `/bin/cat $rwtest` . "\n";

# files_diff
# we need two files to work with
$backup = $util->archive_file( $rwtest );

# these two files are identical, so we should get 0 back from files_diff
ok( !$util->files_diff( f1 => $rwtest, f2 => $backup ), 'files_diff' );

# now we change one of the files, and this time they should be different
ok( $util->file_write( $rwtest,
        lines  => ["more junk"],
        append => 1
    ),
    'file_write'
);
ok( $util->files_diff( f1 => $rwtest, f2 => $backup ), 'files_diff' );

# make it use md5 checksums to compare
$backup = $util->archive_file( $rwtest );
ok( !$util->files_diff(
        f1    => $rwtest,
        f2    => $backup,
        type  => 'binary'
    ),
    'files_diff'
);

# now we change one of the files, and this time they should be different
sleep 1;
ok( $util->file_write( $rwtest,
        lines  => ["extra junk"],
        append => 1
    ),
    'file_write'
);
ok( $util->files_diff(
        f1    => $rwtest,
        f2    => $backup,
        type  => 'binary'
    ),
    'files_diff'
);

# file_is_newer
#

# find_bin
# a typical invocation
my $rm = $util->find_bin( "rm", fatal => 0 );
ok( $rm && -x $rm, 'find_bin' );

t/Utility.t  view on Meta::CPAN

        package => "mt",
        site    => "mt",
        url     => "dl",
        fatal   => 0,
        test_ok => 0
    ),
    'install_from_source'
);

# is_process_running
my $process_that_exists 
    = lc($OSNAME) eq 'darwin' ? 'launchd' 
    : lc($OSNAME) eq 'freebsd' ? 'cron'  
    : 'init';      # init does not run in a freebsd jail

ok( $util->is_process_running($process_that_exists), "is_process_running, $process_that_exists" )
   ; # or diag system "/bin/ps -ef && /bin/ps ax";
ok( !$util->is_process_running("nonexistent"), "is_process_running, nonexistent" );

# is_tainted

# logfile_append

$mod = "Date::Format";
if ( eval "require $mod" ) {
    ok( $util->logfile_append(
            file  => $rwtest,
            prog  => $0,
            lines => ['running tests'],
        ),
        'logfile_append'
    );

    #print `/bin/cat $rwtest` . "\n";

    ok( $util->logfile_append(
            file  => $rwtest,
            prog  => $0,
            lines => [ 'test1', 'test2' ],
        ),
        'logfile_append'
    );

    #print `/bin/cat $rwtest` . "\n";

    ok( $util->logfile_append(
            file  => $rwtest,
            prog  => $0,
            lines => [ 'test1', 'test2' ],
        ),
        'logfile_append'
    );
}

# mailtoaster
#

# mkdir_system
my $mkdir = "$tmp/bar";
ok( $util->mkdir_system( dir => $mkdir ), 'mkdir_system' );
ok( $util->chmod( file_or_dir => $mkdir, mode => '0744', fatal => 0 ),
    'chmod' );
ok( rmdir($mkdir), 'mkdir_system' );

# path_parse
my $pr = "/usr/bin";
my $bi = "awk";
ok( my ( $up1dir, $userdir ) = $util->path_parse("$pr/$bi"), 'path_parse' );
ok( $pr eq $up1dir,  'path_parse' );
ok( $bi eq $userdir, 'path_parse' );

$log->dump_audit(quiet=>1);
$log->{last_error} = scalar @{$log->{errors}};

# check_pidfile
# will fail because the file is too new
ok( !$util->check_pidfile( $rwtest, fatal => 0,debug=>0 ), 'check_pidfile' )
    or $log->dump_audit();

# will fail because the file is a directory
ok( !$util->check_pidfile( $tmp, fatal => 0,debug=>0 ), 'check_pidfile' )
    or $log->dump_audit();

# proper invocation
ok( $util->check_pidfile( "${rwtest}.pid", fatal => 0 ), 'check_pidfile')
    or $log->error();

# verify the contents of the file contains our PID
my ($pid) = $util->file_read( "${rwtest}.pid", fatal => 0 );
ok( $PROCESS_ID == $pid, 'check_pidfile' );

# regext_test
ok( $util->regexp_test(
        exp    => 'toast',
        string => 'mailtoaster rocks',
        debug  => 0,
    ),
    'regexp_test'
);



# parse_line 
my ( $foo, $bar ) = $util->parse_line( ' localhost1 = localhost, disk, da0, disk_da0 ' );
ok( $foo eq "localhost1", 'parse_line lead & trailing whitespace' );
ok( $bar eq "localhost, disk, da0, disk_da0", 'parse_line lead & trailing whitespace' );

( $foo, $bar ) = $util->parse_line( 'localhost1=localhost, disk, da0, disk_da0' );
ok( $foo eq "localhost1", 'parse_line no whitespace' );
ok( $bar eq "localhost, disk, da0, disk_da0", 'parse_line no whitespace' );

( $foo, $bar ) = $util->parse_line( ' htmldir = /usr/local/www/toaster ' );
ok( $foo && $bar, 'parse_line' );

( $foo, $bar )
    = $util->parse_line( ' hosts   = localhost lab.simerson.net seattle.simerson.net ' );
    ok( $foo eq "hosts", 'parse_line' );
    ok( $bar eq "localhost lab.simerson.net seattle.simerson.net", 'parse_line' );


# parse_config
# this fails because the filename is wrong