#!/usr/bin/perl -w
#----------------------------------------------------------------------------
#   elwomis.pm - a do-it-all module
# 
#   Copyright (c) 2001-2002 Walter Werther, Baltasar Cevc
# 
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
# 
#   DISCLAIMER: THIS SOFTWARE AND DOCUMENTATION IS PROVIDED "AS IS," AND
#   COPYRIGHT HOLDERS MAKE NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR
#   IMPLIED, INCLUDING BUT NOT LIMITED TO, WARRANTIES OF MERCHANTABILITY
#   OR FITNESS FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE SOFTWARE
#   OR DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS,
#   TRADEMARKS OR OTHER RIGHTS.
#   IF YOU USE THIS SOFTWARE, YOU DO SO AT YOUR OWN RISK.
#
#   See this internet site for more details: http://technik.juz-kirchheim.de/
#
#   Creation:       unknown     ww+bc 
#   Last Update:    31.08.02    ww
#   Version:        0.1.2
# ----------------------------------------------------------------------------
##################################################
# Package name and version
##################################################
package elwomis;
use vars qw($VERSION);
$VERSION = "0.1.2";

##################################################
# Dependencies
##################################################
# warn and error reporting functions
use Carp;
# needs at least perl 5.000
use 5.000;

##################################################
# Compiler Pragma
##################################################
# warn and error reporting functions
use strict;

##################################################
# global defaults (feel free to change)
##################################################
use vars qw($strict_commentparsing);
# comment parsing mode: 0 - loose; 1 - strict;
# strict will allow comments only on lines without vars
# loose will also allow comments at the end of data lines
$strict_commentparsing=0;


##################################################
# DOCUMENTATION HEAD
##################################################

=head1 NAME

C<elwomis.pm> - a do-it-all module...

=head1 DESCRIPTION

Here comes a detailed description of the functions of this module.

=head1 Function overview

=head2 Template related

=over 4

=item C<strict_commentparsing>

Set comment parsing behaviour

=item C<append_template_sub> I<(internal use only)>

sub routine for append_template (does the most of the work)

=item C<append_template>

appends data constructed from a template and a hash of variables
to a file

=item C<print_template>

prints data constructed from a template and a hash of variables
to a filehandle (e.g. stdout)

=item C<string_template>

replace all varialbes in a string acting as a template

=item C<template2var>

read a file template file into a variable, replacing variables by
their values

=back

=head2 Configuraion file work

=over 4

=item C<parse_config>

parse configuration file, replacing variables

=item C<dump_config>

write a configuration file (complete)

=item C<save_config>

write a configuration file (leaving out values from other files)

=back

=head2 Data verification and manipulation

=over 4

=item C<check_var>

checks whether config variables are defined properly

=item C<check_config>

checks whether config variables in a hash are defined properly

=back

=head2 Misc file and directory functions

=over 4

=item C<walk_dirs>

get all the directories that must be walked through

=item C<findfiles>

gets all config files of a specific type (definded by a pattern)
in a specific directory

=item C<append_file_to_file>

appends file1 to file2

=item C<extract_dir_from_path>

extracts the directory part out of a path specification.

=item C<empty_file>

Empty a file or create it if it does not exist.

=back

=head1 Detailed Information

=cut

##################################################
# TEMPLATE RELATED
##################################################

=pod

=head2 Template related

=over 4

=item B<Variables and Functions:>

=over 8

=item C<${E<lt>VARNAMEE<gt>}>

insert variable called E<lt>VARNAMEE<gt> here
Undefined variables are replaced by a null string

=over 12

=item Special variables:

=over 16

=item C<${DATETIME}>

is replaced by the local time string

=item C<${TIME}>

is replaced by the time at the moment of
parsing (time in seconds since 1/1/70, 0:0:0)

=item C<${~TMPL_TEMPLATEFILE}>

template file given to C<append_template>, C<print_template> and C<template2var>.

=item C<${~TMPL_CALLERFILE}>

the themplate that included the current one (available only in C<append_template> and C<print_template>).

=item C<${~TMPL_ACTFILE}>

file name of current template (available only in C<append_template> and C<print_template>).

=back

=back

=item C<\$[E<lt>FORMATE<gt>]{E<lt>VARNAMEE<gt>}>

variable, using formatted output:

x       output width in characters
l       align to left (default)
c       centered (I<won't work at the moment>)
r       align to right

=item C<\${E<lt>VARNAMEE<gt>}>

escaped variable, will become ${E<lt>VARNAMEE<gt>}

=item C<#{E<lt>VARNAMEE<gt>}>

if construction: only if E<lt>VARNAMEE<gt> is defined, the
contents of this line are used, else the output is
an empty string

=item C<#!{E<lt>VARNAMEE<gt>}>

if not construction - see also if construction

=item C<&SWAP>

Swaps the contents of the variable at the "."'s
e.g. the order of the numbers of an ip adress is
reversed in order to be able to build the
in-addr.arpa address. Usage:

C<&SWAP(E<lt>delimiter-charE<gt>, $E<lt>variable to insert here swappedE<gt>)>


=item C<#@{filename}> I<(C<append_template> only)>

Inserts the template from filename at the current
position (this directive must be the only thing in
one line) - caution: this is recursive, so make
sure that the template does not insert itself or
another template with an include of the actual one,
as this would cause a never-ending loop
The line is piped through string_template before
executing the insert, so filename can consist of
one or more variables, too.

e.g. #@{${MYTEMPLATE}} will insert the file
specified in MYTEMPLATE
Path names are relative to the path of the template
containing this command.

=back

=cut

#######################
sub strict_commentparsing
{
   carp "strict_commentparsing(): can only take numeric argument."
      unless ( (@_ == 1) && ($_[0] =~ /\d+/));

   if ($_[0])
   {
      $strict_commentparsing = 1;
   } else {
      $strict_commentparsing = 0;
   };

};

=pod

=item C<strict_commentparsing>

=over 8

=item Short description:

set comment parsing behaviour

=item Long description:

If set 0, comment parsing will be loose, meaning that comments
are even allowed in middle of line (e.g. after a var. declaration)
If set 1, comments are only accepted at beginning of line
(but having whitespaces ignored).

=item Return value:

C<none>

=item Syntax: 
C<void parse_config(boolean mode)>

=back

=cut

#######################
# append_template_sub precompiled rexexps
use vars qw($regexp_append_template_sub_fileinclude);
$regexp_append_template_sub_fileinclude = qr/^#@\{(.*)\}\s*$/;

sub append_template_sub
{
   my ($template_file) = shift;
   local (*OUTF) = shift;
   my ($pfade,%varhash) = @_;
   my ($templline);
   local (*TEMPH);
   $varhash{'~tmpl_callerfile'}=$varhash{'~tmpl_actfile'};
   $varhash{'~tmpl_actfile'}=$template_file;
   if (!open(*TEMPH, "<$template_file"))
   {
      carp "append_template_sub(): Could not open template file '$template_file': $!";
   };

   while ($templline=<TEMPH>) {
      $templline = string_template ($templline,%varhash);
      if ($templline =~ /$regexp_append_template_sub_fileinclude/) {
         append_template_sub ("$pfade$1",*OUTF,$pfade,%varhash);
      } else {
         print OUTF $templline;
      };
   };
   close (*TEMPH) || carp "append_template_sub(): Could not close template file '$template_file': $!";
};

=pod

=item C<append_template_sub> I<(internal use only)>

=over 8

=item Short description:

sub routine for append_template (does the most of the work)

=item Long description:

reads the template-file line by line and pipes it through
string_template. Then it check's if there is an include
command in the line. If there is one, it call's itself
recursivly to insert the given include file.

=item Syntax:
C<append_template_sub (string template_name, filehandle OUTPUTFILE, string
path_to_templates, hash variables)>

=back

=cut

#######################
sub append_template
{
   my ($template_file, $outfile, %varhash) = @_;
   my ($error, $pathtotemplate);
   local (*TEMPLATE,*OUT);

   $pathtotemplate = extract_dir_from_path ($template_file);
   $varhash{'~tmpl_templatefile'}=$template_file;

   if (($error) || (!open(OUT, ">>$outfile")))
   {
      $error=1;
      carp "append_template(): Could not open output file '$outfile'";
      close (TEMPLATE) || carp "could not close template file '$template_file'";
   };

   # if an error occurred -> do not continue
   ($error) && return (!$error);

   append_template_sub ($template_file,*OUT,$pathtotemplate,%varhash);

   close (OUT) || carp "could not close output file '$outfile'";

   return (!$error);
};

=pod

=item C<append_template>

=over 8

=item Short description:

appends data constructed from a template and a hash of variables
to a file

=item Long description:

reads the file line per line, feeding the data into string_template
and appends the string_template output to the given file

=item Syntax:

C<append_template (string template_file, string output_file, hash variables)>

=back

=cut

#######################
sub print_template
{
   my ($template_file) = shift;
   local (*PRINTTEMPLATEOUTFH) = shift;
   my (%varhash) = @_;
   my ($error, $pathtotemplate);
   local (*TEMPLATE,*OUT);

   $varhash{'~tmpl_templatefile'}=$template_file;

   $pathtotemplate = extract_dir_from_path ($template_file);

   # if an error occurred -> do not continue
   ($error) && return (!$error);

   append_template_sub ($template_file,*PRINTTEMPLATEOUTFH,$pathtotemplate,%varhash);

   return (!$error);
};

=pod

=item C<print_template>

=over 8

=item Short description:

prints data constructed from a template and a hash of variables
to a filehandle (e.g. stdout)

=item Long description:

reads the file line per line, feeding the data into string_template
and prints it to the given filehandle

=item Syntax:

C<print_template (string template_file, hash variables)>

=back

=cut

#######################
# compiled regexps for string_template
use vars qw($regexp_string_template_if_checker $regexp_string_template_if_getinfo);
use vars qw($regexp_string_tempalte_swap_checker $regexp_string_template_variable_finder);
use vars qw($regexo_string_template_fmtvar_finder);
$regexp_string_template_if_checker = qr/^\#!?\{.+?\}/;
$regexp_string_template_if_getinfo = qr/^(\#!?)\{(.+?)\}/;
$regexp_string_tempalte_swap_checker = qr/(?<!\\)\&SWAP\(.,\s*?\$\{\w*?\}\)/;
$regexp_string_template_variable_finder = qr/(?<!\\)\$\{(.+?)\}/;
$regexo_string_template_fmtvar_finder = qr/(?<!\\)\$\[([0-9]+[lrc]?)\]\{(.+?)\}/;

sub string_template {
 my ($templline, %varhash) = @_;
 my ($error, $var, $varname, $found, $funct, $workline, $delimiter,
     @swapspace, $format, $strlen, $count, $width);

      # work only if the line is defined.
      return undef unless defined ($templline);

      # if/if not
      $found = 1;
      while ($templline =~ /$regexp_string_template_if_checker/)
      {
         last unless ($found);
         $templline =~ s/$regexp_string_template_if_getinfo//;
	 $funct = $1;
	 $varname = $2;
         $found = 0;
	 if ($funct eq '#') {
            ($found = 1) if ( (exists $varhash{lc $varname})
                              && (defined $varhash{lc $varname}) 
                              && ($varhash{lc $varname} ne ''));
	 } elsif ($funct eq '#!') {
            ($found = 1) unless ( (exists $varhash{lc $varname})
                              && (defined $varhash{lc $varname}) 
                              && ($varhash{lc $varname} ne ''));
	 } else { warn "An internal error occured." };
      }
      if ($found)
      {
         # swap-Funktion
         while ( $templline =~ /$regexp_string_tempalte_swap_checker/ )
	 {
	    $workline = $&;
	    $workline =~ s/,,/тт,/;
	    ($delimiter, $varname) = split (/,/, $workline);
	    $delimiter =~ s/тт/,/;
	    $delimiter =~ s/(?<!\\)\&SWAP\(//;
	    $varname =~ s/\s*\$\{//;
	    $varname =~ s/\}.*//;
	    $varname = lc($varname);
	    @swapspace = reverse (split (/[$delimiter]/, $varhash{$varname}));
	    $varname = join ($delimiter, @swapspace);
	    $templline =~ s/\&SWAP\(.,\s*?\$\{\w*?\}\)/$varname/;
	 }
	 # variablen ersetzen
	 $varhash{'datetime'}=localtime();
	 $varhash{'time'}=time();
         while ($templline =~ /$regexp_string_template_variable_finder/) {
           $var = $1;
           $varname = lc $var;
           #rint "varname: $varname $var\n";
           if ($varhash{$varname}) {
              $templline =~ s/\$\{$var\}/$varhash{$varname}/g;
           } else {
              $templline =~ s/\$\{$var\}//g;
           };
         };
         while ($templline =~ /$regexo_string_template_fmtvar_finder/) {
           $format = $1;
           $var = $2;
           $varname = lc $var;
           $funct = $format;
           if ($funct =~ /([0-9]+)r/i) {
               $width=$1;
               $workline = sprintf "%${width}s", $varhash{$varname};
           } elsif ($funct =~ /([0-9]+)c/i) {
               $width = $1;
               $strlen = length $varhash{$varname};
               $workline = '';
               for ($count = 1; $count < (($width - $strlen)/2); $count ++) {
                  $workline .= ' ';
               };
               $workline .= $varhash{$varname};
               for ($count = length $workline; $count < $width; $count ++) {
                  $workline .= ' ';
               };
           } else {
               $funct =~ /([0-9]+)[l]?/i;
               $width = $1;
               $workline = $varhash{$varname};
               for ($count = length $workline; $count < $width; $count ++) {
                  $workline .= ' ';
               };
           };
           $templline =~ s/\$\[$format\]\{$var\}/$workline/g;
         };
         #oreach $varname (keys %varhash)
         #
         #  (defined $varhash{$varname}) && ($templline =~ s/(?<!\\)\$\{$varname\}/$varhash{$varname}/gi);
         #;
         ## nicht-definierte Variablen durch einen Null-String ersetzen
         ## (ausser sie ist durch einen \ escapt.)
	 #templline =~ s/(?<!\\)\$\{[\w-]+?\}//gi;
	 # escapte Zeichen durch ihre Originale ersetzten
	 $templline =~ s/\\\$/\$/gi;
	 $templline =~ s/\\\&/\&/gi;
         return $templline;
      };
     return '';
}

=pod

=item C<string_template>

=over 8

=item Short description:

replace all varialbes in a string acting as a template

=item Long description:

Reads a string searching for variables and creates a new string
were all the variables are exchanged by their values.
Some special functions are known as well (e.g. if).
Non-existing or empty variables are replaced by an empty string.

=item Return value:

Returns the newly created string or undef on error.

=item Syntax:

	string string_template (string template, hash %variables)

=back

=cut

#######################
sub template2var
{
   my ($template_file, $varref, %varhash) = @_;
   my $tmpstring;
   my $error=0;
   my $dataline;

   $varhash{'~tmpl_templatefile'}=$template_file;

   if (!open(INFILE, "<$template_file"))
   {
      $error=1;
      carp "template2var(): Could not open input file '$template_file'";
   };

   ($error) && return (!$error);


   while ($dataline = <INFILE>)
   {
      $tmpstring .= (string_template($dataline, %varhash));
   };

   $$varref = $tmpstring;

   unless (close(INFILE))
   {
      $error=1;
      carp "template2var(): Could not close input file '$template_file'";
   };

   return (!$error);
};

=pod

=item C<template2var>

=over 8

=item Short description:

read a file template file into a variable, replacing variables by
their values

=item Return value:

Returns true (!0) on success and false (0) on error

=item Syntax:

C<bool template2var (string $filename, string \$variable, hash %data);>

=back

=cut

#######################

=pod

=back

=cut

### END TEMPLATE RELATED


##################################################
# CONFIGURATION FILE FUNCTIONS
##################################################

=pod

=head2 Configuration file work

=over 4

=cut


use vars qw ($regexp_parse_config_comment_strict $regexp_parse_config_comment_loose);
$regexp_parse_config_comment_strict = qr/^\s*#.*$/;
$regexp_parse_config_comment_loose  = qr/\s*#.*$/;
sub parse_config
{
   my $configfile=shift;
   my %givenconfighash;
   if  ( (@_ > 0) && ((@_ % 2)==0) )
   {
     (%givenconfighash) = @_;
   }
   my $error;
   my %conf;
   my ($ident, $value, $data);

   unless (defined ($configfile))
   {
      carp "parse_config(): no config file specified!";
      $error=1;
   }
   if ( (!$error) && ( ! -e $configfile) )
   {
      carp "parse_config(): '$configfile': file not found!";
      $error=1;
   }

   # if there was an error, continuing makes no sense
   ($error) && return undef;

   if (!open(CFGFILE, "<$configfile"))
   {
      carp "parse_config(): could not open config file '$configfile'!";
      $error=1;
   };

   # if there was an error, continuing makes no sense
   ($error) && return undef;

   while ($data = <CFGFILE>)
     {
        chomp $data;
        if ($strict_commentparsing)
	{
	   $data =~ s/$regexp_parse_config_comment_strict//;
	} else {
	   $data =~ s/$regexp_parse_config_comment_loose//;
	};
	(defined $data) || next;
        ($data =~ /^\s*$/) && next;
	if ($data =~ s/^[\t\s]//) # lines beginning with a space are continuing lines for last ident
	{
	  $value=$data;
	  $conf{lc($ident)} .= "\n".string_template ($value, (%givenconfighash, %conf));
	  next;
	};
        ($ident, $value) = split (' ', $data, 2);
	# (defined $value) || carp "parse_config: undefined value for $ident";
        $conf{lc($ident)} = string_template ($value, (%givenconfighash, %conf));
     };

   close (CFGFILE);

   ($error) && return undef;

   return %conf;
};

=item C<parse_config>

=over 8

=item Short description:

parse configuration file, replacing variables

=item Long description:

Will parse a configuration file, variables are replaced by their
values. If a hash is given as second argument, the contents of
it are used as replacement material if the new hash does not contain
any data for the named variable.

=item Return value:

C<undef> on error, a config hash in all the other cases
	
=item Syntax: 

C<%config parse_config(string $filename, [hash @configvalues])>

=back

=cut

#######################
sub dump_config
{
   my ($configfile, %hash);
   if (@_ == 2) {
      my $hashref;
      ($configfile, $hashref) = @_;
      %hash = %$hashref;
   } elsif ((@_ > 2) && ((@_ % 2) == 1)) {
      ($configfile, %hash) = @_;
   } else {
      croak ("dump_config: usage: dump_config(string \$filename, [\\]\%hash);\n")
   };
   my $count = 0;
   my $error = 0;
   my $key;

   if (!open(CFGFILE, ">$configfile"))
   {
      carp "dump_config(): could not open config file '$configfile' for write!";
      $error=1;
   };

   # if there was an error, continuing makes no sense
   ($error) && return undef;

   foreach $key (keys %hash)
   {
      # convert CR or CR-LF to LF (DOS/MAC to Unix)
      if (defined $hash{$key}) {
         $hash{$key} =~ s/\r|\r\n/\n/g;
         $hash{$key} =~ s/\n/\n\t/g;
         $hash{$key} =~ s/\&/\\\&/gi;
         $hash{$key} =~ s/\$/\\\$/gi;
         print CFGFILE "$key $hash{$key}\n";
         $count ++;
      } else {
         print CFGFILE "$key\n";
      };
   };

   unless (close(CFGFILE))
   {
      carp "dump_config(): close ('$configfile') failed - data may be lost";
      $error=1;
   };

   ($error) && return -1;

   return $count;
};

=pod

=item C<dump_config>

=over 8

=item Short description:

write a configuration file (complete)

=item  Long description:

dump_config will save the contents of a configuration hash to a file.
In opposite to save_config it will write down all the keys/values
contained in the hash, as it does no comparison to the upper level hash.
If the file exists, it will be overwritten!

B<NOTE>: Usually you shold prefer the use of save_config.

=item Return value:

returns the number of keys/values (each pair counted once) written
to the file or -1 on error

=item Syntax:

C<int dump_config(string $filename, \%hash)>
C<int dump_config(string $filename, %hash)>

=item See also:

C<save_config();>, C<parse_config();>

=back

=cut

#######################
sub save_config
{
   croak ("save_config: usage: dump_config(string \$filename, \\\%hash, \\\%upperhash);\n")
      unless (@_ == 3);

   my ($configfile, $hashref, $upperhashref) = @_;
   my %hash = %$hashref;
   my %upperhash = %$upperhashref;
   my %outhash;
   my @oldconfig;
   my ($ident, $value, $comment, $key, $data);
   my $count = 0;
   my $error = 0;

   # save all data that must be saved in outhash
   foreach $key (keys %hash)
   {
     if (defined $hash{$key})
     {
       if ( (exists $upperhash{$key}) && (defined $upperhash{$key}) )
       {
         # skip if hash val is same as upperhash val
         ($hash{$key} eq $upperhash{$key}) && next;
       };
       $outhash{$key} = $hash{$key};
     };
   };

   # open the config file
   if (!open(CFGFILE, "<$configfile"))
   {
      if (!open(CFGFILE, ">$configfile"))
      {
         carp "save_config(): could not create config file '$configfile'!";
	 $error=1;
      } elsif (!open(CFGFILE, "<$configfile"))
      {
         carp "save_config(): could not open config file '$configfile' for reading!";
         $error=1;
      };
   };

   # if there was an error, continuing makes no sense
   ($error) && return undef;

   # read it into memory
   while ($data = <CFGFILE>)
   {
      push @oldconfig, $data;
   };

   # reopen the file for writing
   unless (close(CFGFILE))
   {
      carp "save_config(): close ('$configfile') failed - data may be lost";
      $error=1;
   };
   unless (open(CFGFILE, ">$configfile"))
   {
      carp "save_config(): could not open config file '$configfile' for writing!";
      $error=1;
   };

   # if there was an error, continuing makes no sense
   ($error) && return undef;

   foreach $data (@oldconfig)
   {
        if ($strict_commentparsing)
	{
	   $data =~ s/^(\s*#.*)$//;
	   $comment = $1;
	} else {
	   $data =~ s/(\s*#.*)$//;
	   $comment = $1;
	};
        ($comment = '') unless ($comment);
        if ($data =~ /^\s*$/)
	{  # comment or blank line
	   print CFGFILE $comment."\n";
	} elsif ($data =~ /^\t/)
        {  # no need to worry about multi-line variables here...
	} else {
           ($ident, $value) = split (' ', $data, 2);
	   # even if the value does comes from upper level hash,
	   # we have to print it to keep the order in the file, so we'll get it.
	   unless (exists $outhash{$ident})
	   {
	      $outhash{$ident} = $upperhash{$ident};
	   }
           # convert CR or CR-LF to LF (DOS/MAC to Unix)
           if (exists $outhash{$ident} && defined $outhash{$ident}) {
              $outhash{$ident} =~ s/\r|\r\n/\n/g;
              $outhash{$ident} =~ s/\n/\n\t/g;
              $outhash{$ident} =~ s/\&/\\\&/gi;
	      $outhash{$ident} =~ s/\$/\\\$/gi;
              print CFGFILE "$ident $outhash{$ident}".$comment."\n";
	      delete $outhash{$ident};
           };
	};
   };

   # print remaining variables at the end of file.
   foreach $key (keys %outhash)
   {
      if (defined $outhash{$key}) {
         # convert CR or CR-LF to LF (DOS/MAC to Unix)
         $outhash{$key} =~ s/\r|\r\n/\n/g;
         $outhash{$key} =~ s/\n/\n\t/g;
         print CFGFILE "$key $outhash{$key}\n";
         $count ++;
      };
   };

   # close config file
   unless (close(CFGFILE))
   {
      carp "save_config(): close ('$configfile') failed - data may be lost";
      $error=1;
   };

   ($error) && return -1;

   return $count;
};

=pod

=item C<save_config>

=over 8

=item Short description:

write a configuration file (leaving out values from other files)

=item Long description:

save_config will save the contents of a configuration hash to a file.
During this process it will compare the values to the values to the
next upper config hash and will skip a value which was overtaken from
the upper level.

The old configuration file will be read and this function tries to
keep the layout. Also variables set in the file with the same value
as in the upper hash will be written in order to keep the file more
similar to the original.

B<NOTE:> If the file exists, it will be overwritten!

=item  Return value:

returns the number of keys/values (each pair counted once) written
to the file or -1 on error

=item Syntax:

C<int save_config(string $filename, \%hash, \%upperhash)>

=item See also:

C<dump_config();>, C<parse_config();>

=back

=cut

#######################

=pod

=back

=cut

### END CONFIGURATION FILE WORK


##################################################
# DATA VERIFICATION AND MANIPULATION
##################################################

=pod 

=head2 Data verification and manipulation

=over 4

=cut

#######################
sub check_var {
   my ($varname, $configvalref, $checkflags, $runmode) = @_;
   my $configval = $$configvalref;
   my @flags;
   my $flag;
   my $flagparams;
   my $critical = 0;
   my $errors = 0;
   my $errormesg;
   # temporary variables that can be used arbitrarily by flag parts
   my (@work, $work, $data, $data2);
   # variables special to create flag
   my ($create_owner, $create_mode, $create_uid, $create_gid);


   @flags = split (/,\s*/, $checkflags);

   $errormesg = "The following errors were found for variable name $varname:\n";
   # sort the keys in order not to introduce mistakes (e.g. check existance
   # before creating)
   @work = ();

   # sort flags by priority
   # higher priority flags
   foreach $flag (@flags)
   {
      ($flag eq "create") && push @work, $flag;
   };
   # less priority flags
   foreach $flag (@flags)
   {
      ($flag ne "create") && push @work, $flag;
   };

   # do the actual work
   foreach $flag (@flags)
   {
      SWITCH:
	 {
	    ($flag eq "def") && do
	    {
	      unless (defined $configval)
	      {
	        $errors++;
		$errormesg .= " - the variable is not defined\n";
	      };
	      last SWITCH;
	    }; # flag eq "defined"
	    ($flag eq "critical") && ($critical = 1);
	    # all following flags include a defined check
	    unless (defined $configval)
	    {
	       $errors++;
	       $errormesg .= " - the variable is not defined\n";
	       last SWITCH;
	    }; # defined?
	    ($flag eq "exist") && do
	    {
	       foreach $data (@flags)
	       {
	          ($data eq "dir") && last SWITCH;
		  ($data eq "file") && last SWITCH;
	       };
	       unless ( -e $configval)
	       {
	          $errors++;
		  $errormesg .= " - the node (file/dir/...) named by the variable does not exist\n";
	       };
	       last SWITCH;
	    }; # flag eq "exists"
	    ($flag eq "dir") && do
	    {
	       unless ( $configval=~ /[^\0\ca-\cZ\c[\c?]/ )
	       {
	          $errors++;
		  $errormesg .= " - variable contains control characters which cannot be used in a dir. name\n";
	       };
	       foreach $data (@flags)
	       {
	          ($data eq "exist") && do
		  {
		     unless ( (-e $configval) && (-d $configval) )
		     {
  	                $errors++;
		        $errormesg .= " - $configval does not exist or is not a directory\n";
		     };
		  };
	       }; # foreach (@flags)
	       # make sure that a slash is at the end
	       ($$configvalref =~ /[^\/]$/) && ($$configvalref .= "/");
	       last SWITCH;
	    }; # flag eq "dir"
	    ($flag eq "file") && do
	    {
	       unless ( $configval=~ /[^\0\ca-\cZ\c[\c?]/ )
	       {
	          $errors++;
		  $errormesg .= " - variable contains control characters which cannot be used in a dir. name\n";
	       };
	       foreach $data (@flags)
	       {
	          ($data eq "exist") && do
		  {
		     unless ( (-e $configval) && (-f $configval) )
		     {
  	                $errors++;
		        $errormesg .= " - $configval does not exist or is not a directory\n";
		     };
		  };
	       };
	       last SWITCH;
	    }; # flag eq "file"
	    ($flag eq "exec") && do
	    {
	       unless ( -x $configval )
	       {
	          $errors++;
		  $errormesg .= " - $configval is not executable/cannot dive into directory\n";
	       };
	       last SWITCH;
	    }; # flag eq "exec"
	    ($flag =~ /^regexp/) && do
	    {
	       ($flag, $flagparams) = split (" ", $flag);
	       unless ($configval =~ /$flagparams/)
	       {
	          $errors++;
		  $errormesg .= " - does not match the pattern '$flagparams'\n";
	       };
	       last SWITCH;
	    }; # flag eq "regexp <pattern>"
	    ($flag =~ /^create/) && do
	    {
	       # not needed if node exists!
	       ( -e $configval) && last SWITCH;

	       ($flag, $create_owner, $create_mode) = split (' ', $flag);
	       (defined $create_mode) && (($create_mode =~ /^[0-7]*$/) || croak ("create mode $create_mode for node '$configval' is illegal"));
	       if (defined $create_owner)
	       {
	          ($create_uid, $create_gid) = split (':', $create_owner);
  	          ($create_uid =~ /^\d+$/) || croak ("create uid $create_uid for node '$configval' is illegal");
		  unless (defined $create_gid)
		  {
		     croak("Group ID mus be specified - use '-1' in order to leave untouched");
		  } else
		  {
		     ($create_gid =~ /^\d+$/) || croak ("create gid $create_gid for node '$configval' is illegal");
		  };
	       };
	       foreach $data (@flags)
	       {
	          ($data eq "dir") && do
		  {
		     $work = "";
		     @work = split ('/', $configval);
		     foreach $data2 (@work)
		       {
		          $work .= $data2.'/';
		          unless (-e $work)
			  {
			     ((defined $create_mode) && mkdir $work, $create_mode) || carp ("Could not create directory $work");
			     unless (defined $create_mode) { mkdir $work,0750 || carp ("Could not create directory $work")};
			     if (defined $create_owner)
			     {
			        chown $create_uid, $create_gid, $work;
		             }; # if defined $work2
			  }; # unless
		       }; # while
		     last;
		  }; # $data eq dir
		  ($data eq "file") && do
		  {
		     if (open(TOUCH, '>'.$configval))
		     {
		       close(TOUCH) || carp("Could not close touched file: $configval\n");
		     } else {
		       carp ("Could not touch file: $configval!\n");
		     }
 	             (defined $create_owner) &&
		        chown $create_uid, $create_gid, $configval;
		     last;
		  }; # $data eq file
	       }; # foreach @flags
	    }; # flag eq "create <owner>:<ownergroup> <mode>"
 	    last SWITCH;
	 }; # SWITCH
   }; # foreach (@flags);
   ($errors) && carp ($errormesg);
   unless ($runmode && ($runmode eq 'check_config')) {
      croak ("One of the variable mistakes above was critical. Please check your\nconfiguration. - dieing")
         if ($errors && $critical);
   };
   return ($errors, $critical);
};

=pod

=item C<check_var>

=over 8

=item Short description:

checks whether config variables are defined properly

=item Long description:

This function checks a variable in order to assure that all variables
needed by the program are defined properly. It will be checked against
a list of flags which specify the valid contents.
The checking can be manipulated by giving tags as the contents of the
check definition hash variables.

Some flags cause manipulation of the data in the variable - in the following
overview of standard flags, they will be marked with an asterisk (*):

=over 12

=item C<def>

Fail if variable is not defined/is undef

=item C<critical>

If the variable check fails, the function will croak, so that the
programm excecution is aborted with a die command - without
this flag, only warnings will be shown.

=item ----- the following checks include a def(ined) check:

=item C<exist>

Fails if the variable does not contain the
path to a valid filesystem node

=item C<dir> (*)

Check if the variable can describe a directory.
If there is no trailing slash in the variable, it will be added.

=item C<file>

Check whether the variable contents CAN
describe a file

=item C<exec>
is the var a executable file/dir?

=item C<regexp E<lt>patE<gt>>

Do a pattern match on the variable contents, warn/die if the match fails.

=item C<create [E<lt>ownerE<gt> [E<lt>modeE<gt>]]>

Create the node if it does not exist. If node is a directory, even
parent dirs are created. Owner is a UID (numeric) if a GID
should be given specify UID:GID. Mode is a file mode in octal notation.

=back

=item Return value:

returns the number of errors found in scalar context or the number
of errors found and a variable which is true if one of the errors
was critical.

=item Syntax:

C<boolean check_var (string $varname, sring-ref $configvalref,
 string $checkflags[, string $runmode]);>

=item See also:

C<check_var();>

=item Note:

The $runmode specification is for library-internal use only. It is used
by the check_config function and should not be used by hand.

=back

=cut


#######################
sub check_config
{
   unless ( (@_ == 2) )
   #  && (defined $_[1]) && (defined $_[2])
   {
      croak ("check_config: usage: check_config (hashref \%config, hashref \%check_against);");
   };

   my ($configref, $checkref) = @_;
  # my %config = %$configref;
   my %check = %$checkref;
   my ($varname, $errors, $critical);

   # do this for all variables to check
   foreach $varname (keys %check)
   {
       ($errors, $critical) = check_var ($varname, \$configref->{$varname}, $check{$varname}, 'check_config');
   }; # foreach (keys %check)
   ($errors && $critical) && croak ("One of the variable mistakes above was critical. Please check your\nconfiguration. - dieing");
   return ($errors);
}; # sub check_config

=pod

=item C<check_config>

=over 8

=item Short description:

checks whether config variables in a hash are defined properly

=item Long description:

This function checks a hash in order to assure that all variables
needed by the program are defined properly. This is done by checking
the contents of the hash variables. The variables that will be checked
are defined in a hash.

For the checking, check_var is called, whose behaviour can be modified
by flags. Please have a look at the check_var description to get more
information about them.
=item Return value:

returns the number of errors found.

=item Syntax:

C<boolean check_config (hashref \%config, hashref \%check_against);>

=item See also:

C<check_var();>

=back

=cut


#######################

=pod

=back

=cut

### END DATA VER. AND MANIP.

#######################

##################################################
# MISC FILE AND DIRECTORY FUNCTIONS
##################################################

=pod

=head2 Misc file and directory functions

=over 4

=cut


#######################
sub walk_dirs
{
   croak ("usage: walk_dirs(rootdir, needed-pattern, exclude-pattern [, bool recursive {0;1}]);\n") unless (@_ == 3 || @_ == 4);
   my ($rootdir, $needpattern, $excludepattern) = @_;
   my $recurs = 1;
   my ($data);
   if (@_ == 4)
   {
     $recurs = pop;
     if ( (!defined $recurs) || (($recurs != 1) && ($recurs != 0)) )
     { $recurs = 1; };
   }; # if (@_ == 4)
   my (@nodes, @dirs);

   ($rootdir =~ /[^\/]$/) && ($rootdir .= "/");
   push @dirs, $rootdir;

   unless (opendir(DIR, "$rootdir"))
   {
     carp "Could not open directory '$rootdir'!";
     return undef;
   };

   @nodes = grep { /[^\.].*/ } readdir(DIR);
   closedir(DIR) || carp "Could not close directory '$rootdir'!";
   @nodes = grep {! /$excludepattern/} (grep { /$needpattern/ } @nodes);
   foreach $data (@nodes)
   {
      $data = $rootdir.$data;
      if (-d $data)
      {
        ($recurs) && (push @dirs, walk_dirs($data, $needpattern, $excludepattern, $recurs));
	($recurs) || (push @dirs, "$data/");
      };
   };

   return @dirs;
};

=pod

=item C<walk_dirs>

=over 8

=item Short description:

get all the directories that must be walked through

=item Long description:

Reads all directory entries of rootdir, and calls itself for
every one matching needed pattern and in same time not matching
exclude-pattern. If a value is given for recursive, the function will
eigther rerun itself for each subdirectory or only push the directory
name to the array. If no value is given, the function will work as if
1 was the number, so a recursive search will be done. Each such entry
is appended to an array which is returned to the initial caller.

=item Return value:

Array containing all the directory paths on success and undef on error

=item Sytax:

C<@dirs walk_dirs(rootdir, needed-pattern, exclude-pattern[, recursive={0|1}]);>

=back

=cut

#######################


sub findfiles {
   my ($dir, $pattern);
   my ($file);

   if (@_ == 2) {
     ($dir, $pattern) = @_;
     ((defined($dir)) && (defined($pattern))) || return undef;
   } else {
     croak ("usage: find_files(dir, pattern);\n");
     return undef;
   }
   my (@files, @files2, $error);

   ($dir =~ /[^\/]$/) && ($dir .= "/");

   opendir(DIR, "$dir") || do
   {
     $error=1;
     carp "Could not open configuration file directory '$dir'!";
   };

   @files = grep { /$pattern/ } readdir(DIR);

   closedir(DIR);

   foreach $file (@files)
   {
     ( -d $dir.$file ) && next;
     push(@files2, "$dir$file");
   };

   ($error) && return undef;
   return @files2;
};

=pod

=item C<findfiles>

=over 8

=item Short description:

gets all config files of a specific type (definded by a pattern)
in a specific directory

=item Long description:

Reads all files in a given directory and matches them to the given
pattern. If the pattern matches, the path is prepended to the filename
and the result is saved in an array which is returned to the caller.

=item Return value:

Returns an array containing all matching files or undef on error.

=item Syntax:

C<@files find_files(string directory, string pattern);>

=back

=cut

#######################
sub append_file_to_file
{
   my $file1=shift;
   my $file2=shift;
   my $error=0;
   my $data;

   if (!open(IN, "<$file1"))
     {
        $error=1;
        carp "append_file_to_file(): Could not open input file '$file1'";
     };

   if (!open(MYOUT, ">>$file2"))
     {
        $error=1;
        carp "append_file_to_file(): Could not open output file '$file2'";
     };

   while ($data = <IN>)
     {
        print MYOUT $data;
     };

   close (IN);
   close (MYOUT);

   return !$error;
};

=pod

=item C<append_file_to_file>

=over 8

=item Short description:

appends file1 to file2

=item Return value:

returns true (!0) on success and false (0) on error

=item Syntax:

C<bool append_file_to_file(string filename1, string filename2);>

=back

=cut

#######################
sub extract_dir_from_path
{
   carp ('extract_dir_from_path: syntax: string dir extract_dir_from_path(string path)') unless (@_ == 1);
   my ($path) = shift;

   # if the path is a directory, return it, if needed append a / at the end.
   if ( -d $path )
   {
      ($path =~ /\//) || ($path .= '/');
      return $path;
   };

   # split path and filename; if no slash is in the name, the file resides
   # resides in the current directory -> return "./"
   if ($path =~ /^(.*\/)(.*)$/)
   {
      return $1;
   } else {
      return './';
   }
};

=pod

=item C<extract_dir_from_path>

=over 8

=item Short description:

extracts the directory part out of a path specification.

=item Syntax:

C<$path = extract_dir_from_path (string filename);>

=back

=cut

#######################
sub empty_file
{
   my $file=shift;
   my $error=0;

   if (!open(FH, ">$file"))
   {
      $error=1;
      carp "empty(): Could not open file '$file'";
   };

   close (FH);

   return !$error;
};

=pod

=item C<empty_file>

=over 8

=item Short description:

Empty a file or create it if it does not exist.

=item Return value:

returns true (!0) on success and false (0) on error

=item Syntax:

C<bool empty_file(string filename);>

=back

=cut

#######################

=pod

=back

=cut

### END MISC FILE AND DIRECTORY FUNCTIONS


##################################################
# DOCUMENTATION REST (e.g. changelog)
##################################################

#######################

=pod

=head1 CHANGES

=over 4

=item (version 0.1.2)

=over 8

=item *

Change the calling syntax of append_template_sub. 

=item *

Added dynamical set variables ~tmpl_templatefile, ~tmpl_callerfile, ~tmpl_actfile

=back

=item Re-structuring from JUZ.pm to elwomis.pm (version 0.1.1)

=over 8

=item *

B<Removed init-function and %config-hash>

The function read a configuration file and asked the user to enter a name. 
All this information was saved in a hash named %config.
Because these two symbols weren't used in quite some programs which used
JUZ.pm we thought that it would be better to remove them, as it was a 
function which had to be called before using any other.

=item *

B<Created POD documentation>

=item *

B<Changed C<dump_config> syntax>

Before this, dump_config had to be called using a reference to a hash. Because
we don't like references, we modified the source and made it possible to
call the function either with a reference or with the hash directly.

=item *

B<Renamed cfgfiles to findfiles, empty to empty_file, append to
append_file_to_file and file2var to template2var>

The name changement was made in order to match the functionality of that
subroutines.

=item *

B<string_template: added support for formatted output (for strings)>

We introduced a notation $[wa]{variable} which can be used to create an
output of a specified width w and align the variable to a (l, c, r).

=back

=back

=head1 BUGS

At the moment, we only know about one problem using this module.

=over 4

=item * Case of variable names when using templates

Although the variable names are case-insensitive in the templates,
the functions will only insert variables that have all lower-case
names in the hash of data.
This "bug" was introduced intendedly, as it makes it possible to
use an algorith which is about three times faster as the old one,
which was really case-indifferent.

=back 

If you find any bugs in the latest version, please send us a mail
to code@juz-kirchheim.de, please include a description of the environment
and the problem.

=head1 COPYRIGHT

This program is copyrighted by its authors Walter Werther and Baltasar Cevc.
It is free software - use annd distribute under the terms of the GPL
(GNU Public License, Version 2, or at your choice any later version).

=cut

1;