1package App::Yath::Plugin::TestPlugin;
2use strict;
3use warnings;
4
5use Test2::Harness::Util::HashBase qw/-foo/;
6use Test2::Harness::Util::JSON qw/encode_json/;
7
8use Scalar::Util qw/blessed/;
9
10use parent 'App::Yath::Plugin';
11
12print "TEST PLUGIN: Loaded Plugin\n";
13
14sub duration_data {
15    my $self = shift;
16
17    print "TEST PLUGIN: duration_data\n";
18
19    return {
20        't/integration/plugin/a.tx'    => 'short',
21        't/integration/plugin/b.tx'    => 'medium',
22        't/integration/plugin/c.tx'    => 'medium',
23        't/integration/plugin/d.tx'    => 'medium',
24        't/integration/plugin/test.tx' => 'long',
25    };
26}
27
28sub get_coverage_tests {
29    my $self = shift;
30    my ($settings, $changes) = @_;
31
32    my $stype = ref($settings);
33    my $type = ref($changes);
34    my $count = keys %$changes;
35
36    print "TEST PLUGIN: get_coverage_tests($stype, $type($count))\n";
37
38    return [
39        't/integration/plugin/a.tx',
40        't/integration/plugin/b.tx',
41        't/integration/plugin/c.tx',
42        't/integration/plugin/d.tx',
43        't/integration/plugin/test.tx',
44    ];
45}
46
47sub changed_files {
48    my $self = shift;
49    my ($settings) = @_;
50    my $type = ref($settings);
51
52    print "TEST PLUGIN: changed_files($type)\n";
53
54    return (
55        't/integration/plugin/a.tx',
56        't/integration/plugin/b.tx',
57        't/integration/plugin/c.tx',
58        't/integration/plugin/d.tx',
59        't/integration/plugin/test.tx',
60    );
61}
62
63sub sort_files_2 {
64    my $self = shift;
65    my %params = @_;
66
67    die "self is not an instance! ($self)" unless blessed($self);
68
69    my $settings = $params{settings} or die "NO SETTINGS!";
70    my $files = $params{files};
71
72    my %rank = (
73        test => 1,
74        c    => 2,
75        b    => 3,
76        a    => 4,
77        d    => 5,
78    );
79
80    my @files = sort {
81        my $an = $a->file;
82        my $bn = $b->file;
83        $an =~ s/^.*\W(\w+)\.tx$/$1/;
84        $bn =~ s/^.*\W(\w+)\.tx$/$1/;
85        $rank{$an} <=> $rank{$bn};
86    } @$files;
87
88    return @files;
89};
90
91sub munge_files {
92    my $self = shift;
93    die "self is not an instance! ($self)" unless blessed($self);
94    print "TEST PLUGIN: munge_files\n";
95    return;
96}
97
98sub munge_search {
99    my $self = shift;
100    die "self is not an instance! ($self)" unless blessed($self);
101    my ($search, $default_search) = @_;
102
103    print "TEST PLUGIN: munge_search\n";
104
105    @$search = ();
106
107    my $path = __FILE__;
108    $path =~ s{lib.{1,2}App.{1,2}Yath.{1,2}Plugin.{1,2}TestPlugin\.pm$}{}g;
109
110    @$default_search = ($path);
111
112    return;
113}
114
115sub claim_file {
116    my $self = shift;
117    die "self is not an instance! ($self)" unless blessed($self);
118    my ($file) = @_;
119    print "TEST PLUGIN: claim_file $file\n";
120
121    if ($file =~ /\.tx/) {
122        require Test2::Harness::TestFile;
123        return Test2::Harness::TestFile->new(file => $file);
124    }
125
126    return;
127}
128
129sub inject_run_data {
130    my $self = shift;
131    die "self is not an instance! ($self)" unless blessed($self);
132    my %params = @_;
133    print "TEST PLUGIN: inject_run_data\n";
134
135    my $fields = $params{fields};
136    push @$fields => {name => 'test_plugin', details => 'foo', raw => 'bar', data => 'baz'};
137
138    return;
139}
140
141my $seen = 0;
142sub handle_event {
143    my $self = shift;
144    die "self is not an instance! ($self)" unless blessed($self);
145    my ($event) = @_;
146    print "TEST PLUGIN: handle_event\n" unless $seen++;
147
148    if(my $run = $event->facet_data->{harness_run}) {
149        print "FIELDS: " . encode_json($run->{fields}) . "\n";
150    }
151
152    return;
153}
154
155sub finish {
156    my $self = shift;
157    die "self is not an instance! ($self)" unless blessed($self);
158    my %args = @_;
159
160    print "TEST PLUGIN: finish " . join(', ' => map { "$_ => " . (ref($args{$_}) || $args{$_} // '?') } sort keys %args) . "\n";
161    return;
162}
163
164sub setup {
165    my $self = shift;
166    die "self is not an instance! ($self)" unless blessed($self);
167    my ($settings) = @_;
168    print "TEST PLUGIN: setup " . ref($settings) . "\n";
169
170    $self->shellcall(
171        $settings,
172        'testplug',
173        $^X, '-e', 'print STDERR "STDERR WRITE\n"; print STDOUT "STDOUT WRITE\n";',
174    );
175
176    return;
177}
178
179sub teardown {
180    my $self = shift;
181    die "self is not an instance! ($self)" unless blessed($self);
182    my ($settings) = @_;
183    print "TEST PLUGIN: teardown " . ref($settings) . "\n";
184    return;
185}
186
1871;
188