view release on metacpan or  search on metacpan

Config.pm  view on Meta::CPAN

using them.

For a list of the related helper modules see the B<SEE ALSO> section at the
end of this POD.  These helper modules are not intended for general use.

=cut 

# ---------------------------------------------------------------

package Advanced::Config;

use strict;
use warnings;

# The version of this module!
our $VERSION = "1.14";

use File::Basename;
use File::Copy;
use Sys::Hostname;
use File::Spec;
use Perl::OSType ':all';
use Cwd 'abs_path';

use Advanced::Config::Date;
use Advanced::Config::Options;
use Advanced::Config::Reader;
use Fred::Fish::DBUG 2.09 qw / on_if_set  ADVANCED_CONFIG_FISH /;

# The name of the default section ... (even if no sections are defined!)
use constant DEFAULT_SECTION => Advanced::Config::Options::DEFAULT_SECTION_NAME;

# Should only be modifiable via BEGIN ...
my %begin_special_vars;
my $secret_tag;
my $fish_tag;


# This begin block initializes the special variables used
# for "rule 5" & "rule 6" in lookup_one_variable()
# and _find_variables()!
BEGIN
{
   DBUG_ENTER_FUNC ();

   # -----------------------------------------------
   # These are the "Rule 5" special perl varibles.
   # Done this way to avoid having to support
   # indirect "eval" logic.
   # -----------------------------------------------
   $begin_special_vars{'0'}  = ($0 eq "-e") ? "perl" : $0;
   $begin_special_vars{'$'}  = $$;
   $begin_special_vars{'^O'} = $^O;   # MSWin32, aix, etc ...

   # ---------------------------------------------
   # Start of the "rule 6" initialization ...
   # ---------------------------------------------
   $begin_special_vars{PID}      = $$;
   $begin_special_vars{user}     = Advanced::Config::Options::_get_user_id ();
   $begin_special_vars{hostname} = hostname ();
   $begin_special_vars{flavor}   = os_type ();  # Windows, Unix, etc...

   # ---------------------------------------------
   # Get the Parent PID if available ... (PPID)
   # ---------------------------------------------
   eval {
      $begin_special_vars{PPID} = getppid ();
   };
   if ( $@ ) {
      DBUG_PRINT ("INFO", "Cheating to get the PPID.  It may be wrong!");
      # We can't easily get the parent process id for Windows.
      # So we're going to cheat a bit.  We'll ask if any parent
      # or grandparent process used this module before and call it
      # the parent process!
      $secret_tag = "_ADVANCED_CONFIG_PPID_";

      if ( $ENV{$secret_tag} ) {
         $begin_special_vars{PPID} = $ENV{$secret_tag};
      } else {
         $begin_special_vars{PPID} = -1;    # Can't figure out the PPID.
      }
      $ENV{$secret_tag} = $$;
   }

   # -----------------------------------------------------
   # Calculate the separator used by the current OS
   # when constructing a directory tree. (sep)
   # -----------------------------------------------------
   my ($a, $b) = ("one", "two");
   my $p = File::Spec->catfile ($a, $b);
   if ( $p =~ m/^${a}(.+)${b}$/ ) {
      $begin_special_vars{sep} = $1;    # We have it!
   } else {
      warn "Unknown separator for current OS!\n";
      $begin_special_vars{sep} = "";    # Unknown value!
   }

   # -----------------------------------------------------
   # Calculate the program name minus any path info or
   # certain file extensions.
   # -----------------------------------------------------
   if ( $0 eq "-e" ) {
      $begin_special_vars{program} = "perl";    # Perl add hock script!
   } else {
      $begin_special_vars{program} = basename ($0);

      # Remove only certain file extensions from the program's name!
      if ( $begin_special_vars{program} =~ m/^(.+)[.]([^.]*)$/ ) {
         my ($f, $ext) = ($1, lc ($2));
         if ( $ext eq "" || $ext eq "pl" || $ext eq "t" ) {
            $begin_special_vars{program} = $f;
         }
      }
   }

   DBUG_VOID_RETURN ();
}

# Called automatically when this module goes out of scope ...
# At times this might be called before DESTROY ...
END