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