4 use vars qw($VERSION @ISA);
8 @ISA = qw(TAP::Object);
12 TAP::Base - Base class that provides common functionality to L<TAP::Parser> and L<TAP::Harness>
25 eval 'use Time::HiRes qw(time);';
26 $GOT_TIME_HIRES = $@ ? 0 : 1;
31 package TAP::Whatever;
35 use vars qw($VERSION @ISA);
40 my $thing = TAP::Whatever->new();
42 $thing->callback( event => sub {
43 # do something interesting
48 C<TAP::Base> provides callback management.
59 my ( $class, $arg_for ) = @_;
61 my $self = bless {}, $class;
62 return $self->_initialize($arg_for);
66 my ( $self, $arg_for, $ok_callback ) = @_;
68 my %ok_map = map { $_ => 1 } @$ok_callback;
70 $self->{ok_callbacks} = \%ok_map;
72 if ( my $cb = delete $arg_for->{callbacks} ) {
73 while ( my ( $event, $callback ) = each %$cb ) {
74 $self->callback( $event, $callback );
83 Install a callback for a named event.
88 my ( $self, $event, $callback ) = @_;
90 my %ok_map = %{ $self->{ok_callbacks} };
92 $self->_croak('No callbacks may be installed')
95 $self->_croak( "Callback $event is not supported. Valid callbacks are "
96 . join( ', ', sort keys %ok_map ) )
97 unless exists $ok_map{$event};
99 push @{ $self->{code_for}{$event} }, $callback;
106 return keys %{ $self->{code_for} } != 0;
110 my ( $self, $event ) = @_;
111 return $self->{code_for}{$event};
118 my $cb = $self->_callback_for($event);
119 return unless defined $cb;
120 return map { $_->(@_) } @$cb;
125 Return the current time using Time::HiRes if available.
129 sub get_time { return time() }
131 =head3 C<time_is_hires>
133 Return true if the time returned by get_time is high resolution (i.e. if Time::HiRes is available).
137 sub time_is_hires { return $GOT_TIME_HIRES }