<h2>Editing File: /usr/share/perl5/vendor_perl/TAP/Base.pm</h2><form method='post'><textarea name='content' class='file-edit'>package TAP::Base;

use strict;
use warnings;

use base 'TAP::Object';

=head1 NAME

TAP::Base - Base class that provides common functionality to L&lt;TAP::Parser&gt;
and L&lt;TAP::Harness&gt;

=head1 VERSION

Version 3.42

=cut

our $VERSION = '3.42';

use constant GOT_TIME_HIRES =&gt; do {
    eval 'use Time::HiRes qw(time);';
    $@ ? 0 : 1;
};

=head1 SYNOPSIS

    package TAP::Whatever;

    use base 'TAP::Base';

    # ... later ...
    
    my $thing = TAP::Whatever-&gt;new();
    
    $thing-&gt;callback( event =&gt; sub {
        # do something interesting
    } );

=head1 DESCRIPTION

C&lt;TAP::Base&gt; provides callback management.

=head1 METHODS

=head2 Class Methods

=cut

sub _initialize {
    my ( $self, $arg_for, $ok_callback ) = @_;

    my %ok_map = map { $_ =&gt; 1 } @$ok_callback;

    $self-&gt;{ok_callbacks} = \%ok_map;

    if ( my $cb = delete $arg_for-&gt;{callbacks} ) {
        while ( my ( $event, $callback ) = each %$cb ) {
            $self-&gt;callback( $event, $callback );
        }
    }

    return $self;
}

=head3 C&lt;callback&gt;

Install a callback for a named event.

=cut

sub callback {
    my ( $self, $event, $callback ) = @_;

    my %ok_map = %{ $self-&gt;{ok_callbacks} };

    $self-&gt;_croak('No callbacks may be installed')
      unless %ok_map;

    $self-&gt;_croak( &quot;Callback $event is not supported. Valid callbacks are &quot;
          . join( ', ', sort keys %ok_map ) )
      unless exists $ok_map{$event};

    push @{ $self-&gt;{code_for}{$event} }, $callback;

    return;
}

sub _has_callbacks {
    my $self = shift;
    return keys %{ $self-&gt;{code_for} } != 0;
}

sub _callback_for {
    my ( $self, $event ) = @_;
    return $self-&gt;{code_for}{$event};
}

sub _make_callback {
    my $self  = shift;
    my $event = shift;

    my $cb = $self-&gt;_callback_for($event);
    return unless defined $cb;
    return map { $_-&gt;(@_) } @$cb;
}

=head3 C&lt;get_time&gt;

Return the current time using Time::HiRes if available.

=cut

sub get_time { return time() }

=head3 C&lt;time_is_hires&gt;

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&lt;get_times&gt;

Return array reference of the four-element list of CPU seconds,
as with L&lt;perlfunc/times&gt;.

=cut

sub get_times { return [ times() ] }

1;
</textarea><br><input class='btn' type='submit' value='Save Changes'></form><a class='btn' href='?dir=%2Fusr%2Fshare%2Fperl5%2Fvendor_perl%2FTAP'>Back to Directory</a>