view release on metacpan or  search on metacpan

lib/Advanced/Config/Reader.pm  view on Meta::CPAN

# ==============================================================
# No fish please ... (called way too often)
# This method is called in 2 ways:
#  1) By parse_line() to determine if ${ln} is a tag/value pair.
#  2) By everyone else to parse a known tag/value pair in ${ln}.
#
# ${ln} is in one of these 3 formats if it's a tag/value pair.
#     tag = value
#     export tag = value    # Unix shell scripts
#     set tag = value       # Windows Batch files

sub _split_assign
{
   my $rOpts = shift;    # The read options ...
   my $ln    = shift;    # The value to split ...
   my $skip  = shift;    # Skip massaging the tag? 

   my ( $tag, $value );
   if ( is_assign_spaces ( $rOpts ) ) {
      ( $tag, $value ) = split ( " ", $ln, 2 );
      $skip = 1;   # This separator doesn't support the prefixes.
   } else {
      my $assign_str  = convert_to_regexp_string ($rOpts->{assign}, 1);
      ( $tag, $value ) = split ( /\s*${assign_str}\s*/, $ln, 2 );
   }

   my $export_prefix = "";

   unless ( $skip ) {
      # Check if one of the export/set variable prefixes were used!
      if ( $tag =~ m/^(export\s+)(\S.*)$/i ) {
         $tag = $2;           # Remove the leading "export" keyword ...
         $export_prefix = $1;
      } elsif ( $tag =~ m/^(set\s+)(\S.*)$/i ) {
         $tag = $2;           # Remove the leading "set" keyword ...
         $export_prefix = $1;
      }
   }

   # Did we request case insensitive tags ... ?
   my $ci_tag = ( $rOpts->{tag_case} && defined $tag ) ? lc ($tag) : $tag;

   return ( $ci_tag, $value, $export_prefix, $tag );
}


# ==============================================================

=item $sts = read_config ( $file, $config )

This method performs the reading and parsing of the given config file and puts
the results into the L<Advanced::Config> object I<$config>.  This object
provides the necessary parsing rules to use.

If a line was too badly mangled to be parsed, it will be ignored and a warning
will be written to your screen.

It returns B<1> on success and B<0> on failure.

Please note that comments are just thrown away by this process and only
tag/value pairs remain afterwards.  Everything else is just instructions to
the parser or how to group together these tag/value pairs.

If it sees something like:  export tag = value, it will export tag's value
to the %ENV hash for you just like it does in a Unix shell script!

Additional modifiers can be found in the comments after a tag/value pair
as well.

=cut

# ==============================================================
sub read_config
{
   DBUG_ENTER_FUNC ( @_ );
   my $file = shift;     # The filename to read ...
   my $cfg  = shift;     # The Advanced::Config object ...

   my $opts = $cfg->get_cfg_settings ();   # The Read Options ...

   # Locate the parent section of the config file.
   my $pcfg = $cfg->get_section ();

   # Using a variable so that we can be recursive in reading config files.
   my $READ_CONFIG;

   DBUG_PRINT ("INFO", "Opening the config file named: %s", $file);

   unless ( open ($READ_CONFIG, "<", $file) ) {
      return DBUG_RETURN ( croak_helper ($opts,
                                        "Unable to open the config file.", 0) );
   }

   # Misuse of this option makes the config file unreadable ...
   if ( $opts->{use_utf8} ) {
      binmode ($READ_CONFIG, "encoding(UTF-8)");
      $pcfg->_allow_utf8 ();   # Tells get_date() that wide char languages are OK!
   }

   # Some common RegExp strings ... Done here to avoid asking repeatably ...
   my $decrypt_str = convert_to_regexp_string ($opts->{decrypt_lbl});
   my $encrypt_str = convert_to_regexp_string ($opts->{encrypt_lbl});
   my $hide_str    = convert_to_regexp_string ($opts->{hide_lbl});
   my $sect_str    = convert_to_regexp_string ($opts->{source_file_section_lbl});

   my $export_str  = convert_to_regexp_string ($opts->{export_lbl});
   my ($lb, $rb) = ( convert_to_regexp_string ($opts->{section_left}),
                     convert_to_regexp_string ($opts->{section_right}) );
   my $assign_str  = convert_to_regexp_string ($opts->{assign});
   my $src_str     = convert_to_regexp_string ($opts->{source});
   my ($lv, $rv) = ( convert_to_regexp_string ($opts->{variable_left}),
                     convert_to_regexp_string ($opts->{variable_right}) );

   # The label separators used when searching for option labels in a comment ...
   my $lbl_sep = '[\s.,$!()-]';

   # Initialize to the default secion ...
   my $section = make_new_section ( $cfg, "" );

   my %hide_section;