view release on metacpan or  search on metacpan

Hash.pm  view on Meta::CPAN

	} else {
		if (! defined $_[1]) {
			$_[1] = {};
		}
		$removetrailingblanks = $_[1]->{REMOVETRAILINGBLANKS};
		$_[1]->{REMOVETRAILINGBLANKS} = "0";
	}

        $self     = $class->SUPER::new(@_);

	if (! defined $removetrailingblanks) {
		$removetrailingblanks = "1";
	}

	$self->{COMMON}->{CONFIG}->{REMOVETRAILINGBLANKS} = $removetrailingblanks;

	bless ($self, $class);

	if ($self->reparse) {
		if (! defined $self->{COMMON}->{CONFIG}->{KEYREGEXP}) {
			$self->{COMMON}->{CONFIG}->{KEYREGEXP} = "^(\\S+)";
		}
		if (! defined $self->{COMMON}->{CONFIG}->{HASHREGEXP}) {
			$self->{COMMON}->{CONFIG}->{HASHREGEXP} = "\\s+(.*)\$";
		}

		$self->read_hash();

		if (ref($self->{COMMON}->{CONFIG}->{DEFAULT}) eq "HASH") {
			$self->make_defaults();
		}
	
		if (ref($self->{COMMON}->{CONFIG}->{REQUIRE}) eq "ARRAY") {
			$self->check_require();
		}
	}

	$self->{COMMON}->{'_CODE_TYPE'} = "Hash";	

	return $self;
}

#####################################################################
# read_hash
#
# reads the file linewhise into a hash
#
# parameters: 1st -> object
sub read_hash {
	my ($self) = @_;
	my %HASH   = ();	
	my %LINE   = ();
	my %FILE   = ();
	my ($line, $longline);
	my ($key, $value, $hlp);

	# this variables stores the start point of a KEY.
	# since a KEY/VALUE pair will no parsed until the next KEY or EOF
	# is found, this variables are needed to store the point where
	# the first KEY was found (for error reporting,...)
	my (    $lineno,     $file,     $line_cursor);
	my ($longlineno, $longfile, $longline_cursor);

	$longline = "";
	$longlineno = 0;
	$longfile = "unknown";
	$longline_cursor =0;
	while (defined ($line = $self->getline()) || (defined $longline && $longline ne "")) {
		if ( ! defined $line || $line =~ m/$self->{COMMON}->{CONFIG}->{KEYREGEXP}/s ) {
			$lineno = $self->getline_number;
			$file   = $self->getline_file;
			$line_cursor = $self->getline_cursor;
			if ($longline =~ m/$self->{COMMON}->{CONFIG}->{KEYREGEXP}$self->{COMMON}->{CONFIG}->{HASHREGEXP}/s) {	
				$key   = $1;
				if (defined $self->{COMMON}->{CONFIG}->{CASEINSENSITIVE}) {
					$key   =~ tr /A-Z/a-z/;
				}
				$value = $2;
				if (defined $HASH{$key}) {
					if ($self->{COMMON}->{CONFIG}->{ALLOWREDEFINE}){
						$HASH{$key} = $value;
					} else {
						# generate error
						$self->setline_error("Key <$key> already defined", $longline_cursor);
					}
				} else {
					$HASH{$key} = $value;
				}	
		
				# get complete include path
				push @{$LINE{$key}}, $longlineno;
				push @{$FILE{$key}}, $longfile;
				while (defined ($hlp = $self->getline_number)) {
					push @{$LINE{$key}}, $hlp; 
					push @{$FILE{$key}},$self->getline_file;
				}
			}
			if ($self->{COMMON}->{CONFIG}->{REMOVETRAILINGBLANKS} &&
			    defined $line) {
		                $line =~ s/^\s*//;
		                $line =~ s/\s*\n/\n/;
			}
			if (defined $self->{COMMON}->{CONFIG}->{SUBSTITUTENEWLINE} &&
			    defined $line) {
				$line =~ s/\n/$self->{COMMON}->{CONFIG}->{SUBSTITUTENEWLINE}/;
			}
			$longline = $line;
			$longlineno = $lineno;
			$longfile = $file;
			$longline_cursor = $line_cursor;
		} else {
			if ($self->{COMMON}->{CONFIG}->{REMOVETRAILINGBLANKS} &&
			    defined $line) {
		                $line =~ s/^\s*//;
		                $line =~ s/\s*\n/\n/;
			}
			if (defined $self->{COMMON}->{CONFIG}->{SUBSTITUTENEWLINE} &&
			    defined $line) {
				$line =~ s/\n/$self->{COMMON}->{CONFIG}->{SUBSTITUTENEWLINE}/;
			}
			# multi line, or error 
			$longline .= $line;
		}
	}

	$self->{COMMON}->{"Hash.pm"}->{HASH} = \%HASH;
	$self->{COMMON}->{"Hash.pm"}->{LINE} = \%LINE;
	$self->{COMMON}->{"Hash.pm"}->{FILE} = \%FILE;
}

#####################################################################
# make_defaults
#
# inserts the DEFUALT values into the local stored data
#
# parameters: 1st -> object
sub make_defaults {
	my ($self) = @_;
	my $key;

	foreach $key (keys (%{$self->{COMMON}->{CONFIG}->{DEFAULT}})) {
		if (defined $self->{COMMON}->{CONFIG}->{CASEINSENSITIVE}) {
			$key   =~ tr /A-Z/a-z/;
		}
		if (! defined $self->{COMMON}->{"Hash.pm"}->{HASH}->{$key}) {
			$self->{COMMON}->{"Hash.pm"}->{HASH}->{$key} = 
				$self->{COMMON}->{CONFIG}->{DEFAULT}->{$key};
			$self->{COMMON}->{"Hash.pm"}->{FILE}->{$key} = 
				['DEFAULT'];
			$self->{COMMON}->{"Hash.pm"}->{LINE}->{$key} = [0];
		}
	}

}

#####################################################################
# check_require
#
# checks for the required keys
#
# parameters: 1st -> object
sub check_require {
	my ($self) = @_;
	my $key;

	foreach $key (@{$self->{COMMON}->{CONFIG}->{REQUIRE}}) {
		if (defined $self->{COMMON}->{CONFIG}->{CASEINSENSITIVE}) {
			$key   =~ tr /A-Z/a-z/;
		}
		if (! defined $self->{COMMON}->{"Hash.pm"}->{HASH}->{$key}) {