view release on metacpan or  search on metacpan

demo/spamscan.pl  view on Meta::CPAN

# read in our passes and failures.
my (@wanted, @spam);
while (<DATA>) {
  if (1../^$/) { push @wanted, $_;}
  else         { push @spam, $_}
}
print "Best score possible is: ", scalar(@spam), "\n";

my $regex = seed_match(); # start off with something quite good
my $best_yet = 0;
my $temp = 1;
while (1) {
  my $child = $regex->clone;           # copy the parent
  $child->mutate($num_mutates);        # change it slightly
  my $rex = $child->regex;
  $rex = qr/$rex/;
  my $score = 0;                       # see if the kid is better
  $score += grep {$_ =~ $rex} @spam;   # we don't want spam
  $score -= grep {$_ =~ $rex} @wanted; # but we do want our mail
  if ($score > $best_yet) {
    $regex = $child;                   # and so progress is made
    $best_yet = $score;
    print "\n* $best_yet ", $regex->regex, "\n";
  }
  print '.' unless ($temp++ % 80);
}

sub seed_match {
  my $regex;
 TWIDDLE: while (1) {
    $regex = Regexgene->new(5);
    my $rg = $regex->regex;
    last TWIDDLE if $spam[rand@spam] =~ $rg;