view release on metacpan or  search on metacpan

t/02parser.t  view on Meta::CPAN

  if ($directive eq 'documentroot' or $directive eq 'serverroot') {
    return $filename;
  }

  my @elements = split(m#/#, $filename);
  $elements[-1];
}

# This is the option to pass to the constructor to transform the
# Go through each httpd\d+.conf file and parse it.  Compare the result
# with the precomputed answer.
for (my $i=0; $i<@conf_files; ++$i) {
  my $conf_file = $conf_files[$i];

  # Only test the include transformation on httpd05.conf.
  my $c;
  my $opts_ref;
  if ($conf_file eq 'httpd05.conf') {
    $opts_ref = {post_transform_path_sub => \&post_transform_path};
  } elsif ($conf_file eq 'httpd07.conf') {
    $opts_ref = {post_transform_path_sub => [\&post_transform_munge, 1, 2]};
  }
  if ($opts_ref) {
    $c = EmptySubclass->new($opts_ref);
  } else {
    $c = EmptySubclass->new;
  }
  isa_ok($c, 'EmptySubclass');

  # Set the undocumented variable that instructs parse_file to
  # continue processing configuration files even when filenames given
  # to the AccessConfig, Include and ResourceConfig directives are
  # missing.  This lets the test suite test the normal aspects of all
  # the directives without worrying about a missing file halting the
  # tests early.
  $c->{_include_file_ignore_missing_file} = 1;
  ok($c->parse_file($conf_file), "loaded '$conf_file'");
  delete $c->{_include_file_ignore_missing_file};

  # Check the number of LoadModule's in each configuration file.  This
  # array is indexed by the number of configuration file.
  my @load_modules = (0, 37, 0, 37, 18, 0, 1, 37);
  is($c->find_down_directive_names('LoadModule'),
     $load_modules[$i],
     "found $load_modules[$i] LoadModule's in the whole file");

  # Check that the search for siblings of a particular node works.
  # Since some LoadModule's are inside <IfDefine> contexts, then this
  # will not find all of the LoadModules.
  @load_modules = (0, 26, 0, 26, 18, 0, 1, 26);
  is($c->find_siblings_directive_names('LoadModule'),
     $load_modules[$i],
     "found $load_modules[$i] LoadModule's at the top level");

  # This does a similar search but providing the start node.
  is($c->find_siblings_directive_names(($c->root->daughters)[-1],
                                       'LoadModule'),
     $load_modules[$i],
     "found $load_modules[$i] LoadModule's one level down");

  # Data::Dumper does not sort the hash keys so different versions of
  # Perl generate the same object but different Data::Dumper::Dumper
  # outputs.  To work around this, recursively descend into the object
  # and print the output ourselves.  Also, the errstr object variable
  # will sometimes be set and contain operating system specific error
  # messages which will not compare identically with the error
  # messages in the answer files, so modify them by removing the
  # operating system specific part.
  $c->{errstr} =~ s/:[^:]*$/: operating system specific error message/;
  my @result = $c->dump($c);

  # Read the answer file.
  my $answer_file =  $conf_file;
  $answer_file    =~ s/\.conf$/\.answer/;

  my $open_file = open(ANSWER, $answer_file);
  ok($open_file, "opened `$answer_file' for reading");
 SKIP: {
    skip "Cannot open $answer_file: $!", 1 unless $open_file;
    my @answer = <ANSWER>;
    @answer    = map { $_ =~ s/\r?\n$//; $_ } @answer;
    close(ANSWER);

    my $ok = eq_array(\@answer, \@result);
    ok($ok, "internal structure is ok");

    unless ($ok) {
      if (open(ANSWER, ">$answer_file.tmp")) {
        print ANSWER join("\n", @result), "\n";
        close(ANSWER);
      }
    }
  }
}