view release on metacpan or  search on metacpan

lib/TAP/Harness/Metrics.pm  view on Meta::CPAN

	eval "require $module;";
	if($@) { confess($@) }
	my $cb=$module->can($f);
	if(!$cb) { confess("${module}::${f} not available") }
	return $cb;
}

sub new {
	my ($ref,@opt)=@_;
	my $class=ref($ref)||$ref;
	my $self=$class->SUPER::new(@opt);
	while(my ($k,$v)=each(%options)) { $$self{$k}=$v }
	if($$self{type} eq 'module') {
		$$self{modulef}=verifyCallback($$self{module},$$self{f});
		if(my $cfg=$$self{module}->can('configureHarness')) {
			my %config=&$cfg();
			foreach my $k (grep {exists($config{$_})} @configurable) { $options{$k}=$$self{$k}=$config{$k} }
		}
	}
	$$self{parser_class}='TAP::Parser::Metrics';
	return $self;
}

sub make_parser {
	my ($self,@args)=@_;
	my ($parser,$session)=$self->SUPER::make_parser(@args);
	$parser->configure(callback=>sub { $self->save(@_) });
	return ($parser,$session);
}

sub import {
	my ($class,$type,@opt)=@_;
	$type//='file';
	if($type eq 'module') { unshift(@opt,'module') }
	%options=(%options,@opt,type=>$type);
	return 1;

lib/TAP/Parser/Metrics.pm  view on Meta::CPAN

sub configure {
	my ($self,%opt)=@_;
	if($opt{callback}) { $$self{callback}=$opt{callback} }
	return $self;
}

sub new {
	my ($ref,$argref)=@_;
	my $class=ref($ref)||$ref;
	my $self=$class->SUPER::new($argref);
	$$self{$METRICS}={path=>[],log=>[],source=>$$argref{source}};
	return $self;
}

sub log {
	my ($self,$pass,$file,$label,@path)=@_;
	push @{$$self{$METRICS}{log}},{
		file=>$file,
		pass=>$pass,
		path=>[@path],
		label=>$label,
	};
}

sub next {
	my ($self,@args)=@_;
	my $next=$self->SUPER::next(@args);
	if(!$next) {
		if($$self{callback}) { &{$$self{callback}}(@{$$self{$METRICS}{log}}) }
		return $next;
	}
	my $metrics=$$self{$METRICS};
	if(my $raw=$next->raw()) {
		if($raw=~/^(?<indent>\s*)# Subtest:\s+(?<name>.*)$/) { # subtest begin
			my $indent=length($+{indent})/4;
			if($#{$$metrics{path}}>$indent) { splice(@{$$metrics{path}},$indent) }
			push @{$$metrics{path}},$+{name};