<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package TAP::Object;

use strict;
use warnings;

=head1 NAME

TAP::Object - Base class that provides common functionality to all C&lt;TAP::*&gt; modules

=head1 VERSION

Version 3.44

=cut

our $VERSION = '3.44';

=head1 SYNOPSIS

    package TAP::Whatever;

    use strict;

    use base 'TAP::Object';

    # new() implementation by TAP::Object
    sub _initialize {
        my ( $self, @args) = @_;
        # initialize your object
        return $self;
    }

    # ... later ...
    my $obj = TAP::Whatever-&gt;new(@args);

=head1 DESCRIPTION

C&lt;TAP::Object&gt; provides a default constructor and exception model for all
C&lt;TAP::*&gt; classes.  Exceptions are raised using L&lt;Carp&gt;.

=head1 METHODS

=head2 Class Methods

=head3 C&lt;new&gt;

Create a new object.  Any arguments passed to C&lt;new&gt; will be passed on to the
L&lt;/_initialize&gt; method.  Returns a new object.

=cut

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    return $self-&gt;_initialize(@_);
}

=head2 Instance Methods

=head3 C&lt;_initialize&gt;

Initializes a new object.  This method is a stub by default, you should override
it as appropriate.

I&lt;Note:&gt; L&lt;/new&gt; expects you to return C&lt;$self&gt; or raise an exception.  See
L&lt;/_croak&gt;, and L&lt;Carp&gt;.

=cut

sub _initialize {
    return $_[0];
}

=head3 C&lt;_croak&gt;

Raise an exception using C&lt;croak&gt; from L&lt;Carp&gt;, eg:

    $self-&gt;_croak( 'why me?', 'aaarrgh!' );

May also be called as a I&lt;class&gt; method.

    $class-&gt;_croak( 'this works too' );

=cut

sub _croak {
    my $proto = shift;
    require Carp;
    Carp::croak(@_);
    return;
}

=head3 C&lt;_confess&gt;

Raise an exception using C&lt;confess&gt; from L&lt;Carp&gt;, eg:

    $self-&gt;_confess( 'why me?', 'aaarrgh!' );

May also be called as a I&lt;class&gt; method.

    $class-&gt;_confess( 'this works too' );

=cut

sub _confess {
    my $proto = shift;
    require Carp;
    Carp::confess(@_);
    return;
}

=head3 C&lt;_construct&gt;

Create a new instance of the specified class.

=cut

sub _construct {
    my ( $self, $class, @args ) = @_;

    $self-&gt;_croak("Bad module name $class")
      unless $class =~ /^ \w+ (?: :: \w+ ) *$/x;

    unless ( $class-&gt;can('new') ) {
        local $@;
        eval "require $class";
        $self-&gt;_croak("Can't load $class: $@") if $@;
    }

    return $class-&gt;new(@args);
}

=head3 C&lt;mk_methods&gt;

Create simple getter/setters.

 __PACKAGE__-&gt;mk_methods(@method_names);

=cut

sub mk_methods {
    my ( $class, @methods ) = @_;
    for my $method_name (@methods) {
        my $method = "${class}::$method_name";
        no strict 'refs';
        *$method = sub {
            my $self = shift;
            $self-&gt;{$method_name} = shift if @_;
            return $self-&gt;{$method_name};
        };
    }
}

1;

</pre></body></html>