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