/usr/share/perl5/TAP/Base.pm is in libtest-harness-perl 3.36-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | package TAP::Base;
use strict;
use warnings;
use base 'TAP::Object';
=head1 NAME
TAP::Base - Base class that provides common functionality to L<TAP::Parser>
and L<TAP::Harness>
=head1 VERSION
Version 3.36
=cut
our $VERSION = '3.36';
use constant GOT_TIME_HIRES => do {
eval 'use Time::HiRes qw(time);';
$@ ? 0 : 1;
};
=head1 SYNOPSIS
package TAP::Whatever;
use base 'TAP::Base';
# ... later ...
my $thing = TAP::Whatever->new();
$thing->callback( event => sub {
# do something interesting
} );
=head1 DESCRIPTION
C<TAP::Base> provides callback management.
=head1 METHODS
=head2 Class Methods
=cut
sub _initialize {
my ( $self, $arg_for, $ok_callback ) = @_;
my %ok_map = map { $_ => 1 } @$ok_callback;
$self->{ok_callbacks} = \%ok_map;
if ( my $cb = delete $arg_for->{callbacks} ) {
while ( my ( $event, $callback ) = each %$cb ) {
$self->callback( $event, $callback );
}
}
return $self;
}
=head3 C<callback>
Install a callback for a named event.
=cut
sub callback {
my ( $self, $event, $callback ) = @_;
my %ok_map = %{ $self->{ok_callbacks} };
$self->_croak('No callbacks may be installed')
unless %ok_map;
$self->_croak( "Callback $event is not supported. Valid callbacks are "
. join( ', ', sort keys %ok_map ) )
unless exists $ok_map{$event};
push @{ $self->{code_for}{$event} }, $callback;
return;
}
sub _has_callbacks {
my $self = shift;
return keys %{ $self->{code_for} } != 0;
}
sub _callback_for {
my ( $self, $event ) = @_;
return $self->{code_for}{$event};
}
sub _make_callback {
my $self = shift;
my $event = shift;
my $cb = $self->_callback_for($event);
return unless defined $cb;
return map { $_->(@_) } @$cb;
}
=head3 C<get_time>
Return the current time using Time::HiRes if available.
=cut
sub get_time { return time() }
=head3 C<time_is_hires>
Return true if the time returned by get_time is high resolution (i.e. if Time::HiRes is available).
=cut
sub time_is_hires { return GOT_TIME_HIRES }
=head3 C<get_times>
Return array reference of the four-element list of CPU seconds,
as with L<perlfunc/times>.
=cut
sub get_times { return [ times() ] }
1;
|