1package TAP::Object;
2
3use strict;
4use warnings;
5
6=head1 NAME
7
8TAP::Object - Base class that provides common functionality to all C<TAP::*> modules
9
10=head1 VERSION
11
12Version 3.44
13
14=cut
15
16our $VERSION = '3.44';
17
18=head1 SYNOPSIS
19
20    package TAP::Whatever;
21
22    use strict;
23
24    use base 'TAP::Object';
25
26    # new() implementation by TAP::Object
27    sub _initialize {
28        my ( $self, @args) = @_;
29        # initialize your object
30        return $self;
31    }
32
33    # ... later ...
34    my $obj = TAP::Whatever->new(@args);
35
36=head1 DESCRIPTION
37
38C<TAP::Object> provides a default constructor and exception model for all
39C<TAP::*> classes.  Exceptions are raised using L<Carp>.
40
41=head1 METHODS
42
43=head2 Class Methods
44
45=head3 C<new>
46
47Create a new object.  Any arguments passed to C<new> will be passed on to the
48L</_initialize> method.  Returns a new object.
49
50=cut
51
52sub new {
53    my $class = shift;
54    my $self = bless {}, $class;
55    return $self->_initialize(@_);
56}
57
58=head2 Instance Methods
59
60=head3 C<_initialize>
61
62Initializes a new object.  This method is a stub by default, you should override
63it as appropriate.
64
65I<Note:> L</new> expects you to return C<$self> or raise an exception.  See
66L</_croak>, and L<Carp>.
67
68=cut
69
70sub _initialize {
71    return $_[0];
72}
73
74=head3 C<_croak>
75
76Raise an exception using C<croak> from L<Carp>, eg:
77
78    $self->_croak( 'why me?', 'aaarrgh!' );
79
80May also be called as a I<class> method.
81
82    $class->_croak( 'this works too' );
83
84=cut
85
86sub _croak {
87    my $proto = shift;
88    require Carp;
89    Carp::croak(@_);
90    return;
91}
92
93=head3 C<_confess>
94
95Raise an exception using C<confess> from L<Carp>, eg:
96
97    $self->_confess( 'why me?', 'aaarrgh!' );
98
99May also be called as a I<class> method.
100
101    $class->_confess( 'this works too' );
102
103=cut
104
105sub _confess {
106    my $proto = shift;
107    require Carp;
108    Carp::confess(@_);
109    return;
110}
111
112=head3 C<_construct>
113
114Create a new instance of the specified class.
115
116=cut
117
118sub _construct {
119    my ( $self, $class, @args ) = @_;
120
121    $self->_croak("Bad module name $class")
122      unless $class =~ /^ \w+ (?: :: \w+ ) *$/x;
123
124    unless ( $class->can('new') ) {
125        local $@;
126        eval "require $class";
127        $self->_croak("Can't load $class: $@") if $@;
128    }
129
130    return $class->new(@args);
131}
132
133=head3 C<mk_methods>
134
135Create simple getter/setters.
136
137 __PACKAGE__->mk_methods(@method_names);
138
139=cut
140
141sub mk_methods {
142    my ( $class, @methods ) = @_;
143    for my $method_name (@methods) {
144        my $method = "${class}::$method_name";
145        no strict 'refs';
146        *$method = sub {
147            my $self = shift;
148            $self->{$method_name} = shift if @_;
149            return $self->{$method_name};
150        };
151    }
152}
153
1541;
155
156