# # Mail::SPF::v2::Record # Sender ID ("spf2.0") record class. # # (C) 2005-2012 Julian Mehnle # 2005 Shevek # $Id: Record.pm 57 2012-01-30 08:15:31Z julian $ # ############################################################################## package Mail::SPF::v2::Record; =head1 NAME Mail::SPF::v2::Record - Sender ID ("spf2.0") record class =cut use warnings; use strict; use base 'Mail::SPF::Record'; use constant TRUE => (0 == 0); use constant FALSE => not TRUE; use constant mech_classes => { all => 'Mail::SPF::Mech::All', ip4 => 'Mail::SPF::Mech::IP4', ip6 => 'Mail::SPF::Mech::IP6', a => 'Mail::SPF::Mech::A', mx => 'Mail::SPF::Mech::MX', ptr => 'Mail::SPF::Mech::PTR', 'exists' => 'Mail::SPF::Mech::Exists', include => 'Mail::SPF::Mech::Include' }; use constant mod_classes => { redirect => 'Mail::SPF::Mod::Redirect', 'exp' => 'Mail::SPF::Mod::Exp' }; eval("require $_") foreach values(%{mech_classes()}), values(%{mod_classes()}); use constant valid_scope => qr/^(?: mfrom | pra )$/x; use constant version_tag_pattern => qr{ spf(2\.0) / ( (?: mfrom | pra ) (?: , (?: mfrom | pra ) )* ) (?= \x20 | $ ) }ix; =head1 SYNOPSIS See L. =head1 DESCRIPTION An object of class B represents a B (C) record. =head2 Constructors The following constructors are provided: =over =item B: returns I Creates a new Sender ID ("spf2.0") record object. %options is a list of key/value pairs representing any of the following options: =over =item B =item B =item B See L. =item B I. See L. The B<'mfrom'> and B<'pra'> scopes are supported. There is no default. =back =cut sub new { my ($self, %options) = @_; $self = $self->SUPER::new(%options); if (not defined($self->{parse_text})) { # No parsing is intended, so scopes should have been specified: my $scopes = $self->{scopes} || []; @$scopes > 0 or throw Mail::SPF::EInvalidScope('No scopes for spf2.0 record'); foreach my $scope (@$scopes) { $scope =~ $self->valid_scope or throw Mail::SPF::EInvalidScope("Invalid scope '$scope' for spf2.0 record"); } } return $self; } =item B: returns I; throws I, I, I Creates a new Sender ID ("spf2.0") record object by parsing the string and any options given. =back =head2 Class methods The following class methods are provided: =over =item B: returns I Returns a regular expression that matches a version tag of B<'spf2.0/'> plus a comma-separated list of any of the B<'mfrom'> and B<'pra'> scopes. The following are valid version tags: spf2.0/mfrom spf2.0/pra spf2.0/mfrom,pra spf2.0/pra,mfrom =item B =item B See L. =back =head2 Instance methods The following instance methods are provided: =over =cut sub parse_version_tag { my ($self) = @_; if ($self->{parse_text} =~ s/^${\$self->version_tag_pattern}(?:\x20+|$)//) { my $scopes = $self->{scopes} = [ split(/,/, $2) ]; @$scopes > 0 or throw Mail::SPF::EInvalidScope('No scopes for spf2.0 record'); foreach my $scope (@$scopes) { $scope =~ $self->valid_scope or throw Mail::SPF::EInvalidScope("Invalid scope '$scope' for spf2.0 record"); } } else { throw Mail::SPF::EInvalidRecordVersion( "Not a 'spf2.0' record: '" . $self->text . "'"); } return; } =item B =item B =item B =item B =item B =item B =item B See L. =item B: returns I Returns B<'spf2.0/'> plus a comma-separated list of the scopes of the record. See L for a list of possible return values. =cut sub version_tag { my ($self) = @_; return 'spf2.0' if not ref($self) # called as class method or not defined($self->{scopes}) # no scopes parsed or not @{$self->{scopes}}; # no scopes specified in record return 'spf2.0/' . join(',', @{$self->{scopes}}); } =back =head1 SEE ALSO L, L, L, L, L L For availability, support, and license information, see the README file included with Mail::SPF. =head1 AUTHORS Julian Mehnle , Shevek =cut TRUE;