-
Notifications
You must be signed in to change notification settings - Fork 1
/
Test.pm
89 lines (74 loc) · 2.07 KB
/
Test.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
package Csistck::Test;
use 5.010;
use strict;
use warnings;
use base 'Exporter';
use Csistck::Oper;
use Csistck::Test::Return;
use Scalar::Util qw/blessed/;
sub new {
my $class = shift;
my $target = shift;
bless {
desc => "Unidentified test",
target => $target,
on_repair => undef,
@_
}, $class;
}
sub desc { shift->{desc}; }
sub target { shift->{target}; }
sub on_repair {
my $func = shift->{on_repair};
return $func if (ref $func eq 'CODE');
}
# This is used to wrap processes
sub execute {
my ($self, $mode) = @_;
# We will exit with pass here, as to not throw an error. It is not the fault
# of the user if the test has no check or repair operation
my $func = sub {};
unless ($self->can($mode)) {
return $self->fail('Test missing mode');
# TODO make this better error
};
given ($mode) {
when ("check") { $func = sub { $self->check } if ($self->can('check')); }
when ("repair") { $func = sub { $self->repair } if ($self->can('repair')); }
when ("diff") { $func = sub { $self->diff } if ($self->can('diff')); }
}
Csistck::Oper::info($self->desc);
my $ret = eval { &{$func}; };
# Catch errors
if ($@) {
my $error = $@;
$error =~ s/ at [A-Za-z0-9\/\_\-\.]+ line [0-9]+.\n//;
Csistck::Oper::error(sprintf("%s: %s", $self->desc, $error));
return $self->fail($error);
}
# Return should be an object from now on. If not blessed, assume ret value
if (blessed($ret) and $ret->isa('Csistck::Test::Return')) {
if ($ret->resp) {
Csistck::Oper::info($ret->msg);
}
else {
Csistck::Oper::error($ret->msg);
}
return $ret;
}
else {
return $self->ret($ret, "Test response");
}
}
# Return test response
sub ret {
my ($self, $resp, $msg) = @_;
return Csistck::Test::Return->new(
desc => $self->desc,
resp => $resp,
msg => $msg
);
}
sub fail { shift->ret(0, @_); }
sub pass { shift->ret(1, @_); }
1;