#!/usr/bin/perl package Test::TAP::Model::File::Consolidated; use base qw/Test::TAP::Model::File/; use strict; use warnings; use List::Util (); sub new { my $pkg = shift; bless { subfiles => [ @_ ]}, $pkg; } sub concat_aggr { my $self = shift; my $method = shift; wantarray ? (map { $_->$method } $self->subfiles) : List::Util::sum(map { scalar $_->$method } $self->subfiles); } sub boolean_aggr { my $self = shift; my $method = shift; $_->$method || return for ($self->subfiles); return 1; } BEGIN { # these subs are aggregated # the rest are inherited, because they apply to the aggregate versions for my $subname (qw/ planned cases actual_cases ok_tests nok_tests todo_tests skipped_tests unexpectedly_succeeded_tests /) { no strict 'refs'; *{$subname} = sub { $_[0]->concat_aggr($subname) }; } for my $subname (qw/ ok skipped bailed_out /) { no strict 'refs'; *{$subname} = sub { $_[0]->boolean_aggr($subname) }; } } sub name { my $self = shift; # currently broken, until _transpose_arrays is fixed $self->first_file->name; } sub subfiles { my $self = shift; @{$self->{subfiles}}; } sub subfiles_ref { my $self = shift; [ $self->subfiles ]; } sub subfile_count { my $self = shift; scalar $self->subfiles; } sub subfile_count_plus_one { my $self = shift; $self->subfile_count + 1; } sub multiple_files { my $self = shift; $self->subfile_count > 1; } sub first_file { my $self = shift; ($self->subfiles)[0]; } sub consistent { my $self = shift; my ($head, @tail) = $self->subfiles; foreach my $tail (@tail) { return undef unless $head == $tail; } 1; } __PACKAGE__; __END__ =pod =head1 NAME Test::TAP::Model::File::Consolidated - =head1 SYNOPSIS use Test::TAP::Model::File::Consolidated; =head1 DESCRIPTION =cut