File Coverage

blib/lib/Mail/Karmasphere/Parser/RBL/Base.pm

Criterion	Covered	Total	%
statement	53	57	92.9
branch	21	30	70.0
condition	4	8	50.0
subroutine	10	13	76.9
pod	0	7	0.0
total	88	115	76.5

package Mail::Karmasphere::Parser::RBL::Base;

use strict;
use warnings;
use base 'Mail::Karmasphere::Parser::Base';
use Mail::Karmasphere::Parser::Record;

sub new {
	my $class = shift;
	my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
	$self->{Streams} ||= [ $class->_streams() ];
	$self = $class->SUPER::new($self);
	$self->{default}->{a}   = "127.0.0.2";
	$self->{default}->{txt} = undef;
	return $self;
}

sub _streams { die "subclass of RBL::Base must define _streams()" }

sub my_format { die "subclass of RBL::Base must define my_format()" }

sub _parse {
	my $self = shift;

      GETLINE:
	while ( not eof($self->fh)) {
		local $_ = $self->fh->getline;

		my $additional;
		my $value; #[ -1000 .. 1000 ]

		# XXX This should be an argument to a_to_value, or
		# it should be handled in this routine. It should NOT
		# be an instance variable.
		$self->{is_exclusion} = 0;

		/^\#/   and 			      next GETLINE;
		/^\@/   and $self->handle_fancy($_),  next GETLINE;
		/^\$/   and $self->handle_dollar($_), next GETLINE;
		/^\:/   and $self->handle_colon($_),  next GETLINE;
		s/^!//  and $self->{is_exclusion} = 1;
		/\S/     or next GETLINE;

		chomp;
		my @F = split /\s*:\s*/;

		$value    = $self->a_to_value($F[1]);
		$additional = $self->txt_to_additional($F[2]);

		my ($type, $stream, $identity) = $self->tweaks(@F) or next GETLINE;

		warn ("returning Record: identity=$identity; value=$value; additional=$additional; stream=$stream\n") if $self->debug;

		return new Mail::Karmasphere::Parser::Record
		    (
		     s	=> $stream,
		     i	=> $identity,
		     v	=> $value,
		     (defined $additional ? (d  => $additional) : ()), # this is what elsewhere thinks of as "data".
		     (defined $type ? (t  => $type) : ()),
		     );
	}

	return;
}


# ----------------------------------------------------------
# 			 functions
# ----------------------------------------------------------

sub txt_to_additional {
  my $self = shift;
  my $txt = shift;
  return $txt || $self->{default}->{txt};
}

sub a_to_value {
  my $self = shift;
  my $a = shift || $self->{default}->{a};

  # if  127.0.0.2 means "black"
  # and 127.0.0.4 means "white",
  # this is where we would put the logic to return the appropriate value.

  my $value = defined $self->{Value} ? $self->{Value} : 1000;

  # exclusions are operated as whitelists
  return - $value if $self->{is_exclusion};

  return $value;
}

sub handle_fancy  { my $self = shift; }
sub handle_dollar { my $self = shift; }

sub handle_colon  {
  my $self = shift;
  my $line = shift;
  chomp $line;
  my ($null, $default_a, $default_txt) = split /:/, $line, 3;
  $self->{default}->{a}   = $default_a   if $default_a;
  $self->{default}->{txt} = $default_txt if $default_txt;
}

1;