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.20250505
20              
21             =cut
22              
23 7     7   143126 use warnings;
  7         18  
  7         386  
24 7     7   38 use strict;
  7         14  
  7         197  
25              
26 7     7   2835 use Error ':try';
  7         28629  
  7         73  
27              
28 7     7   5263 use Mail::SPF::Exception;
  7         24  
  7         59  
29              
30 7     7   664 use constant TRUE => (0 == 0);
  7         15  
  7         694  
31 7     7   41 use constant FALSE => not TRUE;
  7         13  
  7         3509  
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 94 my ($self, %options) = @_;
68 27 100       102 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         138 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 84 my ($self) = @_;
91 27   66     199 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 263 my ($class, $name, $readonly) = @_;
112 92 50       227 throw Mail::SPF::EClassMethod if ref($class);
113 92         175 my $accessor_name = "${class}::${name}";
114 92         124 my $accessor;
115 92 100       183 if ($readonly) {
116             $accessor = sub {
117 65     65   9142 local *__ANON__ = $accessor_name;
118 65         165 my ($self, @value) = @_;
119 65 50       182 throw Mail::SPF::EInstanceMethod if not ref($self);
120 65 50       143 throw Mail::SPF::EReadOnlyValue("$accessor_name is read-only") if @value;
121 65         1794 return $self->{$name};
122 88         518 };
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         26 };
132             }
133             {
134 7     7   59 no strict 'refs';
  7         13  
  7         841  
  92         156  
135 92         146 *{$accessor_name} = $accessor;
  92         490  
136             }
137 92         288 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;