1package TAP::Base; 2 3use strict; 4use vars qw($VERSION @ISA); 5 6use TAP::Object; 7 8@ISA = qw(TAP::Object); 9 10=head1 NAME 11 12TAP::Base - Base class that provides common functionality to L<TAP::Parser> 13and L<TAP::Harness> 14 15=head1 VERSION 16 17Version 3.17 18 19=cut 20 21$VERSION = '3.17'; 22 23use constant GOT_TIME_HIRES => do { 24 eval 'use Time::HiRes qw(time);'; 25 $@ ? 0 : 1; 26}; 27 28=head1 SYNOPSIS 29 30 package TAP::Whatever; 31 32 use TAP::Base; 33 34 use vars qw($VERSION @ISA); 35 @ISA = qw(TAP::Base); 36 37 # ... later ... 38 39 my $thing = TAP::Whatever->new(); 40 41 $thing->callback( event => sub { 42 # do something interesting 43 } ); 44 45=head1 DESCRIPTION 46 47C<TAP::Base> provides callback management. 48 49=head1 METHODS 50 51=head2 Class Methods 52 53=cut 54 55sub _initialize { 56 my ( $self, $arg_for, $ok_callback ) = @_; 57 58 my %ok_map = map { $_ => 1 } @$ok_callback; 59 60 $self->{ok_callbacks} = \%ok_map; 61 62 if ( my $cb = delete $arg_for->{callbacks} ) { 63 while ( my ( $event, $callback ) = each %$cb ) { 64 $self->callback( $event, $callback ); 65 } 66 } 67 68 return $self; 69} 70 71=head3 C<callback> 72 73Install a callback for a named event. 74 75=cut 76 77sub callback { 78 my ( $self, $event, $callback ) = @_; 79 80 my %ok_map = %{ $self->{ok_callbacks} }; 81 82 $self->_croak('No callbacks may be installed') 83 unless %ok_map; 84 85 $self->_croak( "Callback $event is not supported. Valid callbacks are " 86 . join( ', ', sort keys %ok_map ) ) 87 unless exists $ok_map{$event}; 88 89 push @{ $self->{code_for}{$event} }, $callback; 90 91 return; 92} 93 94sub _has_callbacks { 95 my $self = shift; 96 return keys %{ $self->{code_for} } != 0; 97} 98 99sub _callback_for { 100 my ( $self, $event ) = @_; 101 return $self->{code_for}{$event}; 102} 103 104sub _make_callback { 105 my $self = shift; 106 my $event = shift; 107 108 my $cb = $self->_callback_for($event); 109 return unless defined $cb; 110 return map { $_->(@_) } @$cb; 111} 112 113=head3 C<get_time> 114 115Return the current time using Time::HiRes if available. 116 117=cut 118 119sub get_time { return time() } 120 121=head3 C<time_is_hires> 122 123Return true if the time returned by get_time is high resolution (i.e. if Time::HiRes is available). 124 125=cut 126 127sub time_is_hires { return GOT_TIME_HIRES } 128 1291; 130