view release on metacpan or  search on metacpan

build/mkrules  view on Meta::CPAN

my $entries_for_rule_name = { };

# $COMMENTS is a "catch-all" "name", for lines that appear after the last line
# that refers to a rule by name.  Those lines are not published by themselves;
# they'll be published to all pubfiles found in the file.
#
# It's assumed they are comments, because they generally are, but could be all
# sorts of unparseable lines.
my $COMMENTS = '!comments!';

# another "fake name" for lines that should always be published.  They'll
# be published to the non-sandbox file.
my $ALWAYS_PUBLISH = '!always_publish!';

read_all_rules($needs_compile);
read_rules_from_output_dir();
compile_output_files();
lint_output_files();
write_output_files();

# mkrules.t relies on the script exiting cleanly Bug #7302 and Bug #7692
exit if ($ENV{'TEST_ACTIVE'}) ;

die "$fail_message" if ( $fail_message =~ m/./) ;
exit;

# ---------------------------------------------------------------------------

sub lint_output_files {
  foreach my $file (keys %{$files_to_lint}) {
    my $text = join("\n", "file start $file", $output_file_text->{$file}, "file end $file");
    if (lint_rule_text($text) != 0) {
      warn "\nERROR: LINT FAILED, suppressing output: $file\n\n";
      $fail_message =  $fail_message . "ERROR: LINT FAILED, suppressing output: $file\n";

      # don't suppress entirely, otherwise 'make distcheck'/'disttest'
      # will fail since the MANIFEST-listed output files will be 
      # empty.

      # delete $output_file_text->{$file};
      $output_file_text->{$file} = '';
    }
  }
}

sub lint_rule_text {
  my ($text) = @_;

  # ensure we turn off slow/optional stuff for linting, but keep the essentials
  my $pretext = q{
    loadplugin Mail::SpamAssassin::Plugin::Check
    loadplugin Mail::SpamAssassin::Plugin::URIDNSBL
    util_rb_tld com # skip "need to run sa-update" warn
    use_bayes 0
  };

  my $mailsa = Mail::SpamAssassin->new({
      rules_filename => "./rules",
      # debug => 1,
      local_tests_only => 1,
      dont_copy_prefs => 1,
      config_text => $pretext.$text
  });

  my $errors = 0;
  $mailsa->{lint_callback} = sub {
    my %opts = @_;

    return if ($opts{msg} =~ /
          (?:score\sset\sfor\snon-existent|description\sexists)
      /x);

    warn "lint: $opts{msg}";
    if ($opts{iserror}) {
      $errors++;
    }
  };

  $mailsa->lint_rules();
  $mailsa->finish();
  return $errors;       # 0 means good
}

sub src_wanted {
  my $path = $File::Find::name;

  # record stat times of directories, too, to catch file additions/removals
  # in the source tree
  my @st = stat $path;
  if ($st[9] && $st[9] > $newest_src_mtime) {
    $newest_src_mtime = $st[9];
  }

  # only files from now on, though
  return if (!-f $path);
  
  # limit what will be copied from sandboxes
  return if ($path =~ /\bsandbox\b/ && !/(?:\d.*\.cf|\.pm)$/i);

  # don't use generated scores; they can be out of sync with what is currently
  # in the sandboxes or the most current active.list file at any given time
  return if ($path =~ /\bscores\b/);

  # a bit of sanity please - no svn metadata ;)
  return if ($path =~ /\.svn/);

  my $dir = $path;
  $dir =~ s/^${current_src}[\/\\\:]//s;
  $dir =~ s/([^\/\\\:]+)$//;
  my $filename = $1;


  my $f = "$current_src/$dir$filename";
  my $t;
  $t = "$opt_out/$filename";

  $needs_compile->{$f} = {
          f => $f,
          t => $t,
          dir => $dir,
          filename => $filename