view release on metacpan or  search on metacpan

lib/CPANPLUS/YACSmoke/IniFiles.pm  view on Meta::CPAN

If an error occurs while parsing the INI file the @Config::IniFiles::errors
array will contain messages that might help you figure out where the 
problem is in the file.

=cut

# Auxillary function to make deep (aliasing-free) copies of data
# structures.  Ignores blessed objects in tree (could be taught not
# to, if needed)
sub _deepcopy {
  my $ref=shift;

  if (! ref($ref)) { return $ref; }

  local $_;

  if (UNIVERSAL::isa($ref, "ARRAY")) {
          return [map {_deepcopy($_)} @$ref];
  }

  if (UNIVERSAL::isa($ref, "HASH")) {
          my $return={};
          foreach my $k (keys %$ref) {
                  $return->{$k}=_deepcopy($ref->{$k});
          }
          return $return;
  }

  carp "Unhandled data structure in $ref, cannot _deepcopy()";
}

# Internal method, gets the next line, taking proper care of line endings.
sub _nextline {
	my ($self, $fh)=@_;
	local $_;
	if (!exists $self->{line_ends}) {
		# no $self->{line_ends} is a hint set by caller that we are at
		# the first line (kludge kludge).
		{
			local $/=\1;
			my $nextchar;
			do {
				$nextchar=<$fh>;
				return undef if (!defined $nextchar);
				$_ .= $nextchar;
			} until (m/((\015|\012|\025|\n)$)/s);
			$self->{line_ends}=$1;
			if ($nextchar eq "\x0d") {
				# peek at the next char
				$nextchar = <$fh>;
				if ($nextchar eq "\x0a") {
					$self->{line_ends} .= "\x0a";
				} else {
					seek $fh, -1, 1;
				}
			}
		}

		# If there's a UTF BOM (Byte-Order-Mark) in the first
		# character of the first line then remove it before processing
		# (http://www.unicode.org/unicode/faq/utf_bom.html#22)
		s/^//;

		return $_;
	} else {
		local $/=$self->{line_ends};
		return scalar <$fh>;
	}
}

# Internal method, closes or resets the file handle. To be called
# whenever ReadConfig() returns.
sub _rollback {
	my ($self, $fh)=@_;
  # Only close if this is a filename, if it's
  # an open handle, then just roll back to the start
  if( !ref($self->{cf}) ) {
    close($fh);
  } else {
    # Attempt to rollback to beginning, no problem if this fails (e.g. STDIN)
    seek( $fh, 0, 0 );
  } # end if
}


sub ReadConfig {
  my $self = shift;

  my($lineno, $sect);
  my($group, $groupmem);
  my($parm, $val);
  my @cmts;

  @CPANPLUS::YACSmoke::IniFiles::errors = ( );

  # Initialize (and clear out) storage hashes
  $self->{sects}  = [];
  $self->{parms}  = {};
  $self->{group}  = {};
  $self->{v}      = {};
  $self->{sCMT}   = {};
  $self->{pCMT}   = {};
  $self->{EOT}    = {};
  $self->{mysects} = []; # A pair of hashes to remember which params are loaded
  $self->{myparms} = {}; # or set using the API vs. imported - useful for
  # import shadowing, see below, and WriteConfig(-delta=>1)

  if( defined $self->{imported} ) {
      # Run up the import tree to the top, then reload coming
      # back down, maintaining the imported file names and our 
      # file name.
      # This is only needed on a re-load though
	  $self->{imported}->ReadConfig() unless ($self->{firstload});

	  foreach my $field (qw(sects parms group v sCMT pCMT EOT)) {
		  $self->{$field} = _deepcopy($self->{imported}->{$field});
	  }
  } # end if
  
  return 1 if (
    (not exists $self->{cf}) or