view release on metacpan or  search on metacpan

t/Utility.t  view on Meta::CPAN

    );

    # default password prompt
    ok( $r = $util->ask( 'type a secret word',
            password => 1,
            default  => 'secret',
        ),
        'ask, password'
    );
}

# extract_archive
my $gzip = $util->find_bin( "gzip", fatal => 0 );
my $tar  = $util->find_bin( "tar",  fatal => 0 );
my $star  = $util->find_bin( "star",  fatal => 0 );

SKIP: {
    skip "gzip or tar is missing!\n", 6 unless ( -x $gzip and -x $tar and -d $tmp );
    ok( $util->syscmd( "$tar -cf $tmp/test.tar README.md", fatal => 0),
        "tar -cf test.tar"
    );
    ok( $util->syscmd( "$gzip -f $tmp/test.tar", fatal => 0), 'gzip test.tar'
    );

    my $archive = "$tmp/test.tar.gz";
    ok( -e $archive, 'temp archive exists' );

    ok( $util->extract_archive( $archive, fatal => 0 ), 'extract_archive +');
    ok( !$util->extract_archive( "$archive.fizzlefuzz", fatal => 0 ), 'extract_archive -');

    # clean up behind the tests
    ok( $util->file_delete( $archive, fatal => 0 ), 'file_delete' );
}

$util->dump_audit(quiet=>1);
$util->dump_errors( fatal => 0 );

#	TODO: { my $why = "extract_archive, requires a valid archive to expand";
#			this is how to run them but not count them as failures
#			local $TODO = $why if (! -e $archive);
#			this way to skip them entirely and mark as TODO
#			todo_skip $why, 3 if (! -e $archive); #}

# cwd_source_dir
# dir already exists
ok( $util->cwd_source_dir( $tmp ), 'cwd_source_dir' );

# clean up after previous runs
if ( -f "$tmp/foo" ) {
    ok( $util->file_delete( "$tmp/foo", fatal => 0 ), 'file_delete' );
}

# a dir to create
ok( $util->cwd_source_dir( "$tmp/foo" ), 'cwd_source_dir' );
print "\t\t wd: " . cwd . "\n" if $verbose;

# go back to our previous working directory
chdir($cwd) or die;
print "\t\t wd: " . cwd . "\n" if $verbose;

# chown_system
my $sudo_bin = $util->find_bin( 'sudo', fatal => 0 );
if ( $UID == 0 && $sudo_bin && -x $sudo_bin ) {

    # avoid the possiblity of a sudo call in testing
    ok( $util->chown_system( $tmp, user => $<, fatal => 0), 'chown_system');
}

# clean_tmp_dir
TODO: {
    my $why = " - no test written yet";
}
ok( $util->clean_tmp_dir( $tmp ), 'clean_tmp_dir' );

print "\t\t wd: " . cwd . "\n" if $verbose;

# get_mounted_drives
ok( my $drives = $util->get_mounted_drives(), 'get_mounted_drives' );
isa_ok( $drives, 'HASH' );

# example code working with the mounts
#foreach my $drive (keys %$drives) {
#	print "drive: $drive $drives->{$drive}\n";
#}

# file_* tests

TODO: {
    my $why = " - user may not want to run extended tests";

    # this way to run them but not count them as failures
    local $TODO = $why if ( -e '/dev/null' );

#$extra = $util->yes_or_no( question=>"can I run extended tests?", timeout=>5 );
#ok ( $extra, 'yes_or_no' );
}

# file_read
my $rwtest = "$tmp/rw-test";
ok( $util->file_write( $rwtest, lines => ["erase me please"] ), 'file_write');
my @lines = $util->file_read( $rwtest );
ok( @lines == 1, 'file_read' );

# file_append
# a typical invocation
ok( $util->file_write( $rwtest, lines  => ["more junk"], append => 1 ), 'file_append');

# archive_file
# a typical invocation
my $backup = $util->archive_file( $rwtest, fatal => 0 );
ok( -e $backup, 'archive_file' );
ok( $util->file_delete( $backup, fatal => 0 ), 'file_delete' );

ok( !$util->archive_file( $backup, fatal => 0 ), 'archive_file' );

#    eval {
#        # invalid param, will raise an exception
#	    $util->archive_file( $backup, fatal=>0 );
#    };
#	ok( $EVAL_ERROR , "archive_file");

# file_check_[readable|writable]
# typical invocation
ok( $util->is_readable( $rwtest, fatal => 0 ), 'is_readable' );

# a non-existing file (we already deleted it)
ok( !$util->is_readable( $backup, fatal => 0,verbose=>0 ), 'is_readable - negated' );

ok( $util->is_writable( $rwtest, fatal => 0 ), 'is_writable' );

# get_url
SKIP: {
    skip "avoiding network tests", 3 if ( !$network );

    ok( $util->cwd_source_dir( $tmp ), 'cwd_source_dir' );

    my $url = "http://www.mail-toaster.org/etc/maildrop-qmail-domain";
    ok( $util->get_url( $url, fatal=>0 ), 'get_url' );
    ok( $util->get_url( $url, dir => $tmp, fatal=>0 ), 'get_url');
}

chdir($cwd);
print "\t\t  wd: " . Cwd::cwd . "\n" if $verbose;

# 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 & oct('07777');

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

# change the permissions to something slightly unique
if ( lc($OSNAME) ne 'irix' ) {
# this doesn't work on IRIX. IRIX is EOL and nearly extinct
    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