File Coverage

blib/lib/Mail/SPF/Base.pm
Criterion Covered Total %
statement 42 47 89.3
branch 7 14 50.0
condition 2 3 66.6
subroutine 11 12 91.6
pod 2 3 66.6
total 64 79 81.0


line stmt bran cond sub pod time code
1             #
2             # Mail::SPF::Base
3             # Base class for Mail::SPF classes.
4             #
5             # (C) 2005-2012 Julian Mehnle
6             # 2005 Shevek
7             # $Id: Base.pm 57 2012-01-30 08:15:31Z julian $
8             #
9             ##############################################################################
10              
11             package Mail::SPF::Base;
12              
13             =head1 NAME
14              
15             Mail::SPF::Base - Base class for Mail::SPF classes
16              
17             =head1 VERSION
18              
19             version 3.20260331
20              
21             =cut
22              
23 7     7   107479 use warnings;
  7         15  
  7         316  
24 7     7   26 use strict;
  7         6  
  7         135  
25              
26 7     7   2006 use Error ':try';
  7         20302  
  7         49  
27              
28 7     7   3809 use Mail::SPF::Exception;
  7         18  
  7         46  
29              
30 7     7   500 use constant TRUE => (0 == 0);
  7         11  
  7         459  
31 7     7   27 use constant FALSE => not TRUE;
  7         8  
  7         2459  
32              
33             =head1 SYNOPSIS
34              
35             use base 'Mail::SPF::Base';
36              
37             sub new {
38             my ($class, @options) = @_;
39             my $self = $class->SUPER::new(@options);
40             ...
41             return $self;
42             }
43              
44             =head1 DESCRIPTION
45              
46             B is a common base class for all B classes.
47              
48             =head2 Constructor
49              
50             The following constructor is provided:
51              
52             =over
53              
54             =item B: returns I
55              
56             Creates a new object of the class on which the constructor was invoked. The
57             provided options are stored as key/value pairs in the new object.
58              
59             The C constructor may also be called on an object, in which case the
60             object is cloned. Any options provided override those from the old object.
61              
62             There are no common options defined in B.
63              
64             =cut
65              
66             sub new {
67 27     27 1 89 my ($self, %options) = @_;
68 27 100       70 my $new =
69             ref($self) ? # Was new() invoked on a class or an object?
70             { %$self, %options } # Object: clone source object, override fields.
71             : \%options; # Class: create new object.
72 27         74 return bless($new, $self->class);
73             }
74              
75             =back
76              
77             =head2 Class methods
78              
79             The following class methods are provided:
80              
81             =over
82              
83             =item B: returns I
84              
85             Returns the class name of the class or object on which it is invoked.
86              
87             =cut
88              
89             sub class {
90 27     27 0 40 my ($self) = @_;
91 27   66     154 return ref($self) || $self;
92             }
93              
94             =back
95              
96             =head2 Class methods
97              
98             The following class methods are provided:
99              
100             =over
101              
102             =item B: returns I
103              
104             Creates an accessor method in the class on which it is invoked. The accessor
105             has the given name and accesses the object field of the same name. If
106             $readonly is B, the accessor is made read-only.
107              
108             =cut
109              
110             sub make_accessor {
111 92     92 1 183 my ($class, $name, $readonly) = @_;
112 92 50       153 throw Mail::SPF::EClassMethod if ref($class);
113 92         124 my $accessor_name = "${class}::${name}";
114 92         97 my $accessor;
115 92 100       125 if ($readonly) {
116             $accessor = sub {
117 65     65   5759 local *__ANON__ = $accessor_name;
118 65         103 my ($self, @value) = @_;
119 65 50       146 throw Mail::SPF::EInstanceMethod if not ref($self);
120 65 50       97 throw Mail::SPF::EReadOnlyValue("$accessor_name is read-only") if @value;
121 65         1147 return $self->{$name};
122 88         289 };
123             }
124             else {
125             $accessor = sub {
126 0     0   0 local *__ANON__ = $accessor_name;
127 0         0 my ($self, @value) = @_;
128 0 0       0 throw Mail::SPF::EInstanceMethod if not ref($self);
129 0 0       0 $self->{$name} = $value[0] if @value;
130 0         0 return $self->{$name};
131 4         17 };
132             }
133             {
134 7     7   59 no strict 'refs';
  7         10  
  7         603  
  92         144  
135 92         83 *{$accessor_name} = $accessor;
  92         323  
136             }
137 92         193 return $accessor;
138             }
139              
140             =back
141              
142             =head2 Instance methods
143              
144             There are no common instance methods defined in B.
145              
146             =head1 SEE ALSO
147              
148             L
149              
150             For availability, support, and license information, see the README file
151             included with Mail::SPF.
152              
153             =head1 AUTHORS
154              
155             Julian Mehnle , Shevek
156              
157             =cut
158              
159             TRUE;