view release on metacpan or  search on metacpan

lib/Apache/ConfigParser.pm  view on Meta::CPAN

    # in the basename and generates a list from that.  Duplicate this
    # code here.
    my ($dirname,
        $separator,
        $basename) = $path =~ m#(.*)([/\\])+([^\2]*)$#;
    unless (defined $separator and length $separator) {
      $self->{errstr} = "'$file_or_dir_name' line $line_number " .
                        "'$directive $path': cannot split path into " .
                        "dirname and basename";
      return;
    }
    if (path_has_apache_style_glob($dirname)) {
      $self->{errstr} = "'$file_or_dir_name' line $line_number " .
                        "'$directive $path': dirname '$dirname' is a glob";
      return;
    }
    unless (path_has_apache_style_glob($basename)) {
      $self->{errstr} = "'$file_or_dir_name' line $line_number " .
                        "'$directive $path': basename '$basename' is " .
                        "not a glob";
      return;
    }
    unless (opendir(DIR, $dirname)) {
      $self->{errstr} = "'$file_or_dir_name' line $line_number " .
                        "'$directive $path': opendir '$dirname' " .
                        "failed: $!";
      # Check if missing file or directory errors should be ignored.
      # This checks an undocumented object variable which is normally
      # only used by the test suite to test the normal aspects of all
      # the directives without worrying about a missing file or
      # directory halting the tests early.
      if ($self->{_include_file_ignore_missing_file}) {
        # If the directory cannot be opened, then there are no
        # configuration files that could be opened for the directive,
        # so leave the method now, but with a successful return code.
        return 1;
      } else {
        return;
      }
    }

    # The glob code Apache uses is fnmatch(3).
    foreach my $n (sort readdir(DIR)) {
      next if $n eq '.';
      next if $n eq '..';
      if (fnmatch($basename, $n)) {
        push(@paths, "$dirname/$n");
      }
    }
    unless (closedir(DIR)) {
      $self->{errstr} = "'$file_or_dir_name' line $line_number " .
                        "'$directive $path': closedir '$dirname' " .
                        "failed: $!";
      return;
    }
  } else {
    @paths = ($path);
  }

  foreach my $p (@paths) {
    my @stat = stat($p);
    unless (@stat) {
      $self->{errstr} = "'$file_or_dir_name' line $line_number " .
                        "'$directive $path': stat of '$path' failed: $!";
      # Check if missing file or directory errors should be ignored.
      # This checks an undocumented object variable which is normally
      # only used by the test suite to test the normal aspects of all
      # the directives without worrying about a missing file or
      # directory halting the tests early.
      if ($self->{_include_file_ignore_missing_file}) {
        next;
      } else {
        return;
      }
    }

    # Parse this if it is a directory or points to a file.
    if (-d _ or -f _) {
      unless ($self->parse_file($p)) {
        return;
      }
    } else {
      $self->{errstr} = "'$file_or_dir_name' line $line_number " .
                        "'$directive $path': cannot open non-file and " .
                        "non-directory '$p'";
      return;
    }
  }

  return 1;
}

=item $c->parse_file($filename)

This method takes a filename and adds it to the already loaded
configuration file inside the object.  If a previous Apache
configuration file was loaded either with new or parse_file and the
configuration file did not close all of its contexts, such as
<VirtualHost>, then the new configuration directives and contexts in
C<$filename> will be added to the existing context.

If there is a failure in parsing any portion of the configuration
file, then this method returns undef and C<< $c->errstr >> will contain a
string explaining the error.

=cut

sub parse_file {
  unless (@_ == 2) {
    confess "$0: Apache::ConfigParser::parse_file $INCORRECT_NUMBER_OF_ARGS";
  }

  my ($self, $file_or_dir_name) = @_;

  my @stat = stat($file_or_dir_name);
  unless (@stat) {
    $self->{errstr} = "cannot stat '$file_or_dir_name': $!";
    return;
  }

  # If this is a real directory, than descend into it now.
  if (-d _) {
    unless (opendir(DIR, $file_or_dir_name)) {
      $self->{errstr} = "cannot opendir '$file_or_dir_name': $!";
      return;
    }
    my @entries = sort grep { $_ !~ /^\.{1,2}$/ } readdir(DIR);
    unless (closedir(DIR)) {
      $self->{errstr} = "closedir '$file_or_dir_name' failed: $!";
      return;
    }

    my $ok = 1;
    foreach my $entry (@entries) {
      $ok = $self->parse_file("$file_or_dir_name/$entry") && $ok;
      next;
    }

    if ($ok) {
      return $self;
    } else {
      return;
    }
  }

  # Create a new file handle to open this file and open it.
  my $fd = gensym;
  unless (open($fd, $file_or_dir_name)) {
    $self->{errstr} = "cannot open '$file_or_dir_name' for reading: $!";
    return;
  }

  # Change the mode to binary to mode to handle the line continuation
  # match [^\\]\\[\r]\n.  Since binary files may be copied from
  # Windows to Unix, look for this exact match instead of relying upon
  # the operating system to convert \r\n to \n.
  binmode($fd);

  # This holds the contents of any previous lines that are continued
  # using \ at the end of the line.  Also keep track of the line
  # number starting a continued line for warnings.
  my $continued_line = '';
  my $line_number    = undef;

  # Scan the configuration file.  Use the file format specified at
  #
  # http://httpd.apache.org/docs/configuring.html#syntax
  #
  # In addition, use the semantics from the function ap_cfg_getline
  # in util.c
  # 1) Leading whitespace is first skipped.
  # 2) Configuration files are then parsed for line continuation.  The
  #    line continuation is [^\\]\\[\r]\n.
  # 3) If a line continues onto the next line then the line is not
  #    scanned for comments, the comment becomes part of the