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