CONFIG
view release on metacpan or search on metacpan
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;
$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}/;
}
# this hash holds a reference for every open file.
# the key is the ABSOLUTE filename.
# the data structure referenced by the value is called COMMON because
# it holds the information which have all instances in common.
# NOTE: this variable has got a class (no an object) scope!
#
# every object has got a referenc to the correspondenting COMMON structure
# called $self->{COMMON}
# note: one common structure may referenced by more then one object
#
# and every object has got a private structure to hold the cursors
# this structure is referenced by $self->{CURSORS}
#####################################################################
# new
#
# constructor
#
# parameters: 1st -> class
# 2nd -> scalar holding filename
$self->{COMMON}->{_CODE_TYPE} = 'Plain';
$self->parse_file;
}
sub check_for_include($$$) {
my ($self, $line, $linenr) = @_;
my ($before, $filename, $after);
my ($file, $pwd, $error, $src_line, $src_file);
my $cursor;
my $hlp;
$cursor = $#{$self->{COMMON}->{LINESFILE}}+1;
if ($line =~ m/(.*?)$self->{COMMON}->{CONFIG}->{INCLUDE}(.*)/) {
$before = $1;
$filename = $2;
$after = $3;
# make absolute path
if ($filename !~ /^\//) {
$pwd = getcwd;
$filename = $pwd ."/". $filename;
}
if (! in_list($filename, $self->{INCLUDEPATH})) {
$file = CONFIG::Plain->new($filename,
$self->{COMMON}->{CONFIG},
$self->{INCLUDEPATH});
# global errors
while (defined($error = $file->getline_error)) {
push @{$self->{COMMON}->{LINEERROR}->
[$cursor]},
$error;
}
while (defined ($src_line = $file->getline())) {
$self->{COMMON}->{LINESFILE}->[$cursor] =
$src_line;
# errors to this line
while (defined ($error = $file->getline_error)){
push @{$self->{COMMON}->{LINEERROR}->
[$cursor]}, $error;
}
while (defined ($src_file = $file->getline_file)) {
push @{$self->{COMMON}->{FILELINE}->
[$cursor]}, $src_file;
push @{$self->{COMMON}->{FILELINE}->
[$cursor]}, $self->{COMMON}->{FILENAME};
push @{$self->{COMMON}->{INPUTLINE}->
[$cursor]}, $file->getline_number;
push @{$self->{COMMON}->{INPUTLINE}->
[$cursor]}, $linenr;
}
$cursor++;
}
$line = $before . $after;
} else {
# CYCLIC include!!
push @{$self->{COMMON}->{LINEERROR}->
[$cursor]},
"Cyclic include ignored";
$line = $before . $after;
}
} else {
# no include -> normal operation
}
push @{$self->{COMMON}->{LINESFILE}}, $line;
push @{$self->{COMMON}->{INPUTLINE}->[$cursor]}, $linenr;
push @{$self->{COMMON}->{FILELINE}->[$cursor]}, $self->{COMMON}->{FILENAME};
$self->{COMMON}->{PLAINFILE} .= $line;
}
#####################################
# overload this function..:)
#
sub parse_file {
my ($self) = @_;
}
[$self->{CURSORS}->{getline}];
$self->{CURSORS}->{getline}++;
}
$self->{CURSORS}->{getline_error} = 0;
$self->{CURSORS}->{getline_number} = 0;
$self->{CURSORS}->{getline_file} = 0;
return $line;
}
#####################################################################
# getline_cursor
#
# returns the internal linecursor, usefull only for the setline_error
# method
sub getline_cursor {
my ($self) = @_;
return $self->{CURSORS}->{"getline"}-1;
}
#####################################################################
# getline_number
#
# returns the input line number of the last line got via getline
sub getline_number {
#####################################################################
# setline_error
#
# stores a error message to the last line got via getline
#
# Parameters: 1st -> object
# 2nd -> error string
# 3rd -> (optional) line nr. (if ommited, error is assigned
# to the last line got via getline)
sub setline_error {
my ($self, $error, $line_cursor) = @_;
if (! defined $line_cursor) {
if ($self->{CURSORS}->{"getline"} > 0) {
push @{$self->{COMMON}->{LINEERROR}->
[$self->{CURSORS}->{"getline"}-1]}, $error;
}
} else {
push @{$self->{COMMON}->{LINEERROR}->[$line_cursor]}, $error;
}
}
sub setglobal_error {
my ($self, $error) = @_;
push @{$self->{COMMON}->{GLOBALERROR}}, $error;
}
#####################################################################
=head1 METHODS
Overview:
new - opens, reads and preparses a file
close - close the file
parse_file - empty method, overload this for specific preparse
functionality
getfile - returns a scalar holding the preparsed file
getline - returns a scalar holding a line of the file
getline_reset - resets the cursor for getline
getline_number - returns the inputfile number of the last line got
via getline
(cursor handled for includes)
getline_file - returns the inputfilename of the last line got
via getline
(cursor handled for includes)
getline_error - returns error messages in for this line
(cursor handled)
setline_error - stores a errormessage to the last line got via
getline
get_errors - returns a human readable string holding ALL error
messages
=head2 new - open, read and preparse file
(1) $ref = CONFIG::Plain->new($filename);
(2) $ref = CONFIG::Plain->new($filename, \%CONFIG);
$line = $file_getline;
returns the file line by line until the end of the file is reached.
The method will return an undefined value on end of file.
NOTE: the first call to this method need not return the first line of
the file (e.g. if the line was empty and DELEMPTYLINE was enabled)
Use the method getline_number to get the linenumber of the last got
line.
=head2 getline_reset - reset the cursor for getline
$file->getline_reset;
If you call this method, the next call to the getline method will
start the filereading from the top of the file.
=head2 getline_number - returns the input line number
$line_number = $file->getline_number;
( run in 0.271 second using v1.01-cache-2.11-cpan-4d50c553e7e )