view release on metacpan or  search on metacpan

contrib/perftest-awl  view on Meta::CPAN

has '_module_name' => ( is => 'ro', isa => 'Str', lazy => 1,
	default => sub {
		my $self = shift;
		return( $self->module_prefix.$self->module );
	}
);

has '_addrlist' => ( is => 'ro', isa => 'Mail::SpamAssassin::PersistentAddrList', lazy => 1,
	default => sub {
		my $self = shift;
		my $code = "require ".$self->_module_name;
		eval $code;
		if( $@ ) {
			die('could not load AWL AddrList module '.$@);
		}
		my $module = $self->_module_name;
		my $list = "$module"->new;
		return( $list );
	},
);

has '_sa' => (
	is => 'ro', lazy => 1,
	default => sub {
		my $self = shift;
		my $sa = Mail::SpamAssassin->new;
		$sa->init(1);
		return $sa;
	},
);

has 'processes' => (
	is => 'ro', isa => 'Int', default => 5,
	documentation => 'number of parallel processes to use',
	cmd_aliases => 'p',
	traits => [ 'Getopt' ],
);

has 'num_entries' => (
	is => 'ro', isa => 'Int', default => 10000,
	documentation => 'number of entries to add scores',
	cmd_aliases => 'n',
	traits => [ 'Getopt' ],
);

has 'repeat' => (
	is => 'ro', isa => 'Int', default => 10,
	documentation => 'how often to repeat the test',
	cmd_aliases => 'r',
	traits => [ 'Getopt' ],
);

has 'score' => (
	is => 'ro', isa => 'Int', default => 1,
	documentation => 'score added to each entry',
	cmd_aliases => 's',
	traits => [ 'Getopt' ],
);

has '_addr' => ( is => 'ro', isa => 'ArrayRef[Str]', lazy => 1,
	default => sub {
		my $self = shift;
		my @e;
		for( my $i = 0 ; $i < $self->num_entries ; $i++ ) {
			push( @e, 'preftest-awl-'.$i)
		}
		return \@e;
	},
);

has '_queue' => (
	is => 'ro', isa => 'IPC::QWorker', lazy => 1,
	default => sub {
		my $self = shift;
		my $q = IPC::QWorker->new;
		print "starting ".$self->processes." workers...\n";
		$q->create_workers( $self->processes,
			_init => sub {
				my $ctx = shift;
				$ctx->{'checker'} = $self->_addrlist->new_checker($self->_sa);
				return;
			},
			'add_score' => sub {
				my $ctx = shift;
				my $addr = shift;
				my $entry = $ctx->{'checker'}->get_addr_entry( $addr );
				$ctx->{'checker'}->add_score($entry, $self->score );
				return;
			},
			'cleanup' => sub {
				my $ctx = shift;
				my $addr = shift;
				my $entry = $ctx->{'checker'}->get_addr_entry( $addr );
				$ctx->{'checker'}->remove_entry($entry);
			},
		);
		return $q;
	},
);

sub add_all_scores {
	my $self = shift;
	
	foreach my $addr ( @{$self->_addr} ) {
		$self->_queue->push_queue( IPC::QWorker::WorkUnit->new(
			cmd => 'add_score',
			params => $addr,
		) );
	}

	my $start_add = [gettimeofday];
	print "updating scores..";

	$self->_queue->process_queue;
	$self->_queue->flush_queue;

	my $finished_add = [gettimeofday];
	print ". ".$self->_interval_stats( $self->num_entries, $start_add, $finished_add)."\n";

	return;