Update Test-Harness to CPAN version 3.39
[perl.git] / cpan / Test-Harness / lib / TAP / Object.pm
1 package TAP::Object;
2
3 use strict;
4 use warnings;
5
6 =head1 NAME
7
8 TAP::Object - Base class that provides common functionality to all C<TAP::*> modules
9
10 =head1 VERSION
11
12 Version 3.39
13
14 =cut
15
16 our $VERSION = '3.39';
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
38 C<TAP::Object> provides a default constructor and exception model for all
39 C<TAP::*> classes.  Exceptions are raised using L<Carp>.
40
41 =head1 METHODS
42
43 =head2 Class Methods
44
45 =head3 C<new>
46
47 Create a new object.  Any arguments passed to C<new> will be passed on to the
48 L</_initialize> method.  Returns a new object.
49
50 =cut
51
52 sub 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
62 Initializes a new object.  This method is a stub by default, you should override
63 it as appropriate.
64
65 I<Note:> L</new> expects you to return C<$self> or raise an exception.  See
66 L</_croak>, and L<Carp>.
67
68 =cut
69
70 sub _initialize {
71     return $_[0];
72 }
73
74 =head3 C<_croak>
75
76 Raise an exception using C<croak> from L<Carp>, eg:
77
78     $self->_croak( 'why me?', 'aaarrgh!' );
79
80 May also be called as a I<class> method.
81
82     $class->_croak( 'this works too' );
83
84 =cut
85
86 sub _croak {
87     my $proto = shift;
88     require Carp;
89     Carp::croak(@_);
90     return;
91 }
92
93 =head3 C<_confess>
94
95 Raise an exception using C<confess> from L<Carp>, eg:
96
97     $self->_confess( 'why me?', 'aaarrgh!' );
98
99 May also be called as a I<class> method.
100
101     $class->_confess( 'this works too' );
102
103 =cut
104
105 sub _confess {
106     my $proto = shift;
107     require Carp;
108     Carp::confess(@_);
109     return;
110 }
111
112 =head3 C<_construct>
113
114 Create a new instance of the specified class.
115
116 =cut
117
118 sub _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
135 Create simple getter/setters.
136
137  __PACKAGE__->mk_methods(@method_names);
138
139 =cut
140
141 sub 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
154 1;
155