1package Test::Util;
2
3use Test::Util::Base -Base;
4use Carp qw( confess );
5use IPC::Run3;
6#use Data::Dumper::Simple;
7
8our @EXPORT = qw(
9    test_shell_command run_shell
10    split_arg join_list
11    process_pre process_post
12    process_found process_not_found
13);
14
15sub process_pre ($) {
16    my $block = shift;
17    my $code = $block->pre;
18    return if not $code;
19    {
20        package main;
21        eval $code;
22    }
23    confess "error in `pre' section: $@" if $@;
24}
25
26sub process_post ($) {
27    my $block = shift;
28    my $code = $block->post;
29    return if not $code;
30    {
31        package main;
32        eval $code;
33    }
34    confess "error in `post' section: $@" if $@;
35}
36
37sub process_found ($) {
38    my $block = shift;
39    my $buf = $block->found;
40    return if not $buf;
41    my @files = split /\s+/s, $buf;
42    for my $file (@files) {
43        Test::More::ok(
44            (-f $file),
45            "File $file should be found - ".$block->name
46        );
47    }
48}
49
50sub process_not_found ($) {
51    my $block = shift;
52    my $buf = $block->not_found;
53    return if not $buf;
54    my @files = split /\s+/s, $buf;
55    for my $file (@files) {
56        Test::More::ok(
57            !(-f $file),
58            "File $file should NOT be found - ".$block->name
59        );
60    }
61}
62
63sub compare ($$$) {
64    my ($got, $expected, $desc) = @_;
65    return if not defined $expected;
66    if ($desc =~ /\w+_like/) {
67        Test::More::like($got, qr/^$expected$/ms, $desc);
68    } else {
69        Test::More::is($got, $expected, $desc);
70    }
71}
72
73sub join_list (@) {
74    my @args = @_;
75    for (@args) {
76        if (ref $_ eq 'ARRAY') {
77            $_ = join('', @$_);
78        }
79    }
80    return wantarray ? @args : $args[0];
81}
82
83sub test_shell_command ($$@) {
84    my $block    = shift;
85    my $cmd      = shift;
86    my %filters  = @_;
87    return if not defined $cmd;
88
89    my ($stdout, $stderr);
90    run3($cmd, \undef, \$stdout, \$stderr);
91    my $errcode = $?;
92    $errcode >>= 8;
93    my $success = ($errcode == 0);
94
95    my $errcode2 = $block->error_code;
96    if ($errcode2 and $errcode2 =~ /\d+/) {
97        $errcode2 = $&;
98    }
99
100    my $success2 = $block->success;
101    if ($success2 and $success2 =~ /\w+/) {
102        $success2 = lc($&);
103    }
104
105    my $name = $block->name;
106
107    while (my ($key, $val) = each %filters) {
108        #warn "$key $val";
109        if ($key eq 'stdout') {
110            $stdout = $val->($stdout);
111        } elsif ($key eq 'stderr') {
112            $stderr = $val->($stderr);
113        }
114    }
115
116    #warn "!!!~~~~ $stdout";
117    #warn "!!!~~~~ ", $block->stdout;
118    #use Test::Differences;
119    #eq_or_diff $stdout, $block->stdout;
120    compare $stdout, $block->stdout, "stdout - $name";
121    compare $stdout, $block->stdout_like, "stdout_like - $name";
122    compare $stderr, $block->stderr, "stderr - $name";
123    compare $stderr, $block->stderr_like, "stderr_like - $name";
124    compare $errcode, $errcode2, "error_code - $name";
125    compare (
126        $success ? 'true' : 'false',
127        $success2,
128        "success - $name",
129    );
130    if (not defined $block->stderr() and
131            not defined $block->stderr_like() and
132            $stderr) {
133        warn $stderr;
134    }
135}
136
137# returns ($error_code, $stdout, $stderr)
138sub run_shell (@) {
139    my ($cmd, $verbose) = @_;
140    #$IPC::Cmd::USE_IPC_RUN = 1;
141
142    #confess Dumper($cmd);
143    my ($stdout, $stderr);
144    run3($cmd, \undef, \$stdout, \$stderr);
145    my $errcode = $?;
146
147    #warn "HERE!";
148    #warn "^^^ Output: $res[2][0]";
149    return ($errcode, $stdout, $stderr);
150}
151
1521;
153