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