CONFIG
view release on metacpan or search on metacpan
= \&comment_type_sh_antiescape;
$CONFIG::Plain::comment_style->{'C++'}->{COUNT}
= \&comment_type_cpp_count;
$CONFIG::Plain::comment_style->{'C++'}->{REMOVE}
= \&comment_type_cpp_remove;
$CONFIG::Plain::comment_style->{'C++'}->{ANTIESCAPE}
= \&comment_type_cpp_antiescape;
$CONFIG::Plain::comment_style->{'C'}->{COUNT}
= \&comment_type_c_count;
$CONFIG::Plain::comment_style->{'C'}->{REMOVE}
= \&comment_type_c_remove;
$CONFIG::Plain::comment_style->{'C'}->{ANTIESCAPE}
= \&comment_type_c_antiescape;
$CONFIG::Plain::comment_style->{asm}->{COUNT}
= \&comment_type_asm_count;
$CONFIG::Plain::comment_style->{asm}->{REMOVE}
= \&comment_type_asm_remove;
$CONFIG::Plain::comment_style->{asm}->{ANTIESCAPE}
= \&comment_type_asm_antiescape;
$CONFIG::Plain::comment_style->{'sql'}->{COUNT}
= \&comment_type_sql_count;
$CONFIG::Plain::comment_style->{'sql'}->{REMOVE}
= \&comment_type_sql_remove;
$CONFIG::Plain::comment_style->{'sql'}->{ANTIESCAPE}
= \&comment_type_sql_antiescape;
$CONFIG::Plain::comment_style->{'pascal'}->{COUNT}
= \&comment_type_pascal_count;
$CONFIG::Plain::comment_style->{'pascal'}->{REMOVE}
= \&comment_type_pascal_remove;
$CONFIG::Plain::comment_style->{'pascal'}->{ANTIESCAPE}
= \&comment_type_pascal_antiescape;
$CONFIG::Plain::comment_style->{'regexp'}->{COUNT}
= \&comment_type_regexp_count;
$CONFIG::Plain::comment_style->{'regexp'}->{REMOVE}
= \&comment_type_regexp_remove;
$CONFIG::Plain::comment_style->{'regexp'}->{ANTIESCAPE}
= \&comment_type_regexp_antiescape;
}
#####################################################################
# Important data structures used in this file
#
# the mayor variable is
# CONFIG::Plain::already_open_configs
# 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
# OR ref to hash holding config parameters
# including the filename in the "FILE" key
# or the data itselve in the "DATA" key
# 3rd -> ref to hash holding config parameters if the
# 2nd arg was a scalar
# 4th -> (optional) for internal use only
# include path (array ref)
# only allowed if 2nd arg is scalar!
# return -> undef or object referenc
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
my $filename = shift;
my $config = shift;
my $include_path = shift;
my @include_path;
my $pwd;
my %COMMON;
my %CONFIG;
my $key;
# check parameters
if (ref($filename) eq "HASH") {
$config = $filename;
$filename = $filename->{FILE};
}
if (! defined $include_path) {
$include_path = [];
}
@include_path = ($include_path);
# make absolute path
if ($filename !~ /^\//) {
$pwd = getcwd;
chomp($pwd);
$filename = $pwd ."/". $filename;
}
push @include_path, $filename;
# if file is unknown
if (! defined $CONFIG::Plain::already_open_configs{$filename}) {
# create data struct for file
$COMMON{FILENAME} = $filename;
$COMMON{GLOBALERROR} = ();
$COMMON{USED} = 0;
$COMMON{ACTIVE} = 0;
$self->{COMMON}->{LINESFILE_unparsed} = ();
$self->{COMMON}->{INPUTLINE} = ();
$self->{COMMON}->{FILELINE} = ();
$self->{COMMON}->{GLOBALERROR} = ();
$self->{COMMON}->{LINEERROR} = ();
if (defined $fh) {
$line = $fh->getline;
} else {
if ($self->{COMMON}->{CONFIG}->{DATA} !~ m/\n$/s) {
$self->{COMMON}->{CONFIG}->{DATA} .= "\n";
}
$self->{COMMON}->{CONFIG}->{DATA} =~ s/^(.*?\n)(.*)$/$2/s;
$line = $1;
}
while (defined $line) {
$input_linenr ++;
$self->{COMMON}->{LINESFILE_unparsed}->[$input_linenr] = $line;
$file_bytes += length($line);
$long_line .= $line;
if ($self->apply_config(\$long_line)) {
# line contains "\n", so store in cache
if (! defined $linenr) {
$linenr = $input_linenr;
}
$self->check_for_include($long_line, $linenr);
undef $linenr;
$long_line = "";
} else {
# line contains no "\n", so merge with next line
if (! defined $linenr && $long_line ne "") {
$linenr = $input_linenr;
}
}
if (defined $fh) {
$line = $fh->getline;
} else {
$self->{COMMON}->{CONFIG}->{DATA} =~
s/^(.*?\n)(.*)$/$2/s;
$line = $1;
}
}
$self->{COMMON}->{FILELINES} = $input_linenr;
$self->{COMMON}->{FILEBYTES} = $file_bytes;
$self->{COMMON}->{CACHEBYTES} = length($self->{COMMON}->{PLAINFILE});
$self->{COMMON}->{CACHELINES} = $#{$self->{COMMON}->{LINESFILE}}+1;
$self->{COMMON}->{READS}++;
$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;
chomp($pwd);
$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) = @_;
}
#####################################################################
# apply_config
#
# apllies the configuration to a source line
#
# parameters: 1st -> object-ref
# 2nd -> reference to scalar holding the sources
# return -> (the scalar referenced by the second argument
# may changed)
# the return value(boolsch) is true if the line
# was finished, the retrun value is false if
# the line is incomplete (e.g. multi-line comments)
sub apply_config {
my ($self, $line_ref) = @_;
my $line = $$line_ref;
$line = $self->remove_comments($line);
# NewLineESCape
if (defined $self->{COMMON}->{CONFIG}->{ESCAPE} &&
$self->{COMMON}->{CONFIG}->{ESCAPE} ne "") {
$line =~ m /($self->{COMMON}->{CONFIG}->{ESCAPE}+)\n/;
if ((length ($1) % 2) != 0) {
# new line is escaped -> delete it
$line =~ s/$self->{COMMON}->{CONFIG}->{ESCAPE}\n//;
}
}
if ($self->{COMMON}->{CONFIG}->{DELEMPTYLINE}) {
if ($line eq "\n") {
$line = "";
}
}
if ($self->{COMMON}->{CONFIG}->{REMOVETRAILINGBLANKS}) {
$line =~ s/^\s*//;
$line =~ s/\s*\n/\n/;
}
# now handle escaped escape signs :)
if (defined $self->{COMMON}->{CONFIG}->{ESCAPE} &&
$self->{COMMON}->{CONFIG}->{ESCAPE} ne "") {
$line =~ s/($self->{COMMON}->{CONFIG}->{ESCAPE}){2}/$1/g;
}
$$line_ref = $line;
if ($line =~ /\n/) {
return 1;
while (defined ($error = $self->getline_error)) {
$outtext .= $error . "\n";
}
while (defined ($line = $self->getline)) {
$error = $self->getline_error;
if (defined $error) {
$outtext .= sprintf("ERROR in %s:%d\n",
$self->getline_file, $self->getline_number);
while ($filename = $self->getline_file) {
$outtext .= sprintf(" included from %s:%d\n",
$filename,
$self->getline_number)
}
do {
$outtext .= sprintf(" %s\n", $error);
} while (defined ($error = $self->getline_error));
}
}
$self->getline_reset();
return $outtext;
}
#####################################################################
# getfile
#
# returns a scalar holding the whole file
sub getfile {
my ($self) = @_;
return $self->{COMMON}->{PLAINFILE};
}
#####################################################################
# getline
#
# returns the file linewhise, returns undef on end of file
sub getline {
my ($self) = @_;
my $line = "";
if ($self->{CURSORS}->{getline} >= $self->{COMMON}->{CACHELINES}) {
undef $line;
} else {
$line = $self->{COMMON}->{LINESFILE}->
[$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 {
my ($self) = @_;
my $rc;
$rc = $self->{COMMON}->{INPUTLINE}->[$self->{CURSORS}->{"getline"}-1]->
[$self->{CURSORS}->{"getline_number"}];
$self->{CURSORS}->{"getline_number"}++;
if ((! defined $rc) || ($self->{CURSORS}->{"getline_number"} < 1)) {
return undef;
} else {
return $rc;
}
}
#####################################################################
# getline_file
#
# returns the filename of the file from which the last line got via
# getline comes.
sub getline_file {
my ($self) = @_;
my $rc;
$rc = $self->{COMMON}->{FILELINE}->[$self->{CURSORS}->{"getline"}-1]->
[$self->{CURSORS}->{"getline_file"}];
$self->{CURSORS}->{"getline_file"}++;
if ((! defined $rc) || ($self->{CURSORS}->{"getline_file"} < 1)) {
return undef;
} else {
return $rc;
}
}
#####################################################################
# getline_error
#
# returns errormessages of this line
sub getline_error {
my ($self) = @_;
my $rc = undef;
if ($self->{CURSORS}->{"getline"} == 0) {
$rc = $self->{COMMON}->{GLOBALERROR}[
$self->{CURSORS}->{global_error}];
$self->{CURSORS}->{global_error}++;
} else {
$rc = $self->{COMMON}->{LINEERROR}->
[$self->{CURSORS}->{"getline"}-1]->
[$self->{CURSORS}->{"getline_error"}];
$self->{CURSORS}->{"getline_error"}++;
}
return $rc;
}
#####################################################################
# getline_reset
#
# resets the linepointer for getline
sub getline_reset {
my ($self) = @_;
$self->{CURSORS}->{"getline"} = 0;
}
#####################################################################
# 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;
}
#####################################################################
#
# stupid translations functions for comment styles ;)
##### sh #####
sub comment_type_sh_count {
my ($self, $line, $param) = @_;
return comment_type_regexp_count($self, $line, "#|\$");
}
sub comment_type_sh_remove {
my ($self, $line, $param) = @_;
return comment_type_regexp_remove($self, $line, "#|\$");
}
sub comment_type_sh_antiescape {
my ($self, $line, $param) = @_;
return comment_type_regexp_antiescape($self, $line, "#|\$");
}
##### C++ #####
sub comment_type_cpp_count {
my ($self, $line, $param) = @_;
return comment_type_regexp_count($self, $line, "\/\/|\$");
}
sub comment_type_cpp_remove {
my ($self, $line, $param) = @_;
return comment_type_regexp_remove($self, $line, "\/\/|\$");
}
sub comment_type_cpp_antiescape {
my ($self, $line, $param) = @_;
return comment_type_regexp_antiescape($self, $line, "\/\/|\$");
}
##### C #####
sub comment_type_c_count {
my ($self, $line, $param) = @_;
return comment_type_regexp_count($self, $line, "\/[*]|[*]\nn/");
}
sub comment_type_c_remove {
my ($self, $line, $param) = @_;
return comment_type_regexp_remove($self, $line, "\/[*]|[*]\/");
}
sub comment_type_c_antiescape {
printf("%s:%d> %s\n", $file->getline_file,
$file->getline_number,
$line);
}
# example for error reporting
while (defined ($line = $file->getline)) {
$error = $file->getline_error;
if (defined $error) {
printf("ERROR in %s:%d\n", $file->getline_file,
$file->getline_number);
while ($filename = $file->getline_file) {
printf(" included from %s:%d\n", $filename,
$file->getline_number);
}
do {
printf(" %s\n", $error);
} while (defined ($error = $file->getline_error));
}
}
=head1 ABSTRACT
This perl module is highly useful in connection with mod_perl cgi
scripts. It caches files (re-reads the files if necessary) to speed
up the file reading. It is possible to configure the module to remove
comments, trailing blanks, empty lines or to do other useful things
only once.
=head1 DESCRIPTION
The methods of this module are very similar to the IO methods to read a file.
The two major differences are:
=head2 Caching
If you open/read a file twice (or often) the file will be cached after the
first access. So the second (and third, and forth, ...) access is much faster.
This feature is very useful in connection with mod_perl CGI scripts.
=head2 Preparsing
You can configure this class to preparse the input file immediatly after the
disk access (NOTE: the preparsed file will be cached). Some default preparse
algorithms are available (delete empty lines, remove comments, remove trailing
blanks, ...) but it's possible to overload a method to implement special
preparse functionality.
=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);
(3) $ref = CONFIG::Plain->new(\%CONFIG);
This method creates a new object from the class.
You can specify the filename as first argument (see syntax (1) or (2)) or
include the filename into the options hash (use "FILE" as key).
Configuration Options:
COMMENT - define comment styles
Known comment styles are:
sh - shell like comments
(from '#' to end of line)
C - C like comments
(from '/*' to '*/', multi line)
C++ - C++ like comments
(from '//' to end of line)
asm - assembler like comments
(from ';' to end of line)
pascal - pascal like comments
(from '{' to '}', multi line)
sql - oracle sql style
(from '--' to end of line)
regexp - define comments by regular expression for start
and end.
This style accepts two parameters, the syntax is:
"regexp:<startre>|<stopre>"
where <startre> is the regular expression for the
start of the comment, and <stopre> the regexp for
the end.
EXAMPLE:
"regexp:#|\$"
comments goes from "#" to new line (same as
"sh" style).
DEFAULT: "sh C C++"
DATA - use given data instaed of read it from a file
Use the data given in this argument instaed of read it from disk.
DELEMPTYLINE - delete empty lines
Boolsch, if true empty lines will be deleted.
DEFAULT: 1
will get into
>a backslash:\<
EXAMPLE: (escape a new line)
>line one \
line two<
will get into
>line one line two<
DEFAULT: `\\\\` # -> one backslash
FILE - specify the filename
If you use the syntax (3) the filename is got from this option.
INCLUDE - specify a regexp for includes
If this regexp matches, the specified file will be included
at this point.
This regexp must store the filename in the $1 varaible.
DEFAULT: "include <(.*?)>"
(filename in <> is stored)
REMOVETRAILINGBLANKS - remove trailing blanks
Boolsch, if true trailing blanks will be removed.
EXAMPLE:
> ho ho <
will get into
>ho ho< (no leading or trailing white spaces)
DEFAULT: 1
=head2 close - closes a object instance
This method accually does nothing, but this may changed in future
releases, so please use it for compatibily.
=head2 getfile - returns a scalar holding the whole file
$file_contents = $file->getfile;
returns the preparsed file.
=head2 getline - returns a scalar holding a line
$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;
Returns the input line number of the last line got via getline.
Because of the INCLUDE feature this method may called often to get
the include path (see example below).
=head2 getline_file - returns the input filename
$filename = $file->getline_file;
Returns the filename of the sourcefile of the last line got via getline.
Because of the INCLUDE feature this mathod may called often to get
the include path (see example below).
=head2 getline_error - returns errors of this line
$error = $file->getline_error;
Returns for every error occurred in this line a human readable error message
or an undefined value if no error occures.
NOTE: Since one line may contain more then one error, this method may called
often to get all error messages. The list will be terminated by
an undefined value.
NOTE: If you call this method before the first call to getline, you will
get the global error messages (such as "file not found").
=head2 get_errors - returns ALL error messages
print $file->get_errors;
Returns a scalar holding ALL error messages in a preformated style.
=head2 setline_error - stores a errormessage
$file->setline_error(sprintf("File %s not found", $filename));
Stores a error message to a line.
Every line may contain more then one error(message).
=head1 SEE ALSO
CONFIG::Hash(3pm)
The CONFIG:: Guide at http://www.fatalmind.com/programs/CONFIG
=head1 TODO
( run in 0.584 second using v1.01-cache-2.11-cpan-39bf76dae61 )