view release on metacpan or  search on metacpan

t/30-alt_symbols_cfg.t  view on Meta::CPAN

   my $multiple = shift;

   my $f1 = File::Spec->catfile ("t", "config", "30-alt_symbols_03.cfg");
   my $f2 = File::Spec->catfile ("t", "config", "30-alt_symbols_04 multi section test.cfg");

   my ($ropt1, $dopt1) = grab_options ($ctl_cfg, basename ($f1));
   my ($ropt2, $dopt2) = grab_options ($ctl_cfg, basename ($f2));

   # What to do with $dopt???

   dbug_ok ($new_cfg->merge_config ($f1, $ropt1), "1st Merge is OK");
   dbug_ok ($new_cfg->merge_config ($f2, $ropt2), "2nd Merge is OK");

   if ( $multiple ) {
      dbug_ok ($new_cfg->merge_config ($f1, $ropt1), "3rd Merge is OK");
      dbug_ok ($new_cfg->merge_config ($f2, $ropt2), "4th Merge is OK");
   }

   DBUG_VOID_RETURN ();
}

# ====================================================================
# The generic config file loader ...
# ====================================================================
sub initialize_each_config
{
   DBUG_ENTER_FUNC (@_);
   my $ctrl_cfg = shift;
   my $file     = shift;

   my @section_tags;   # List of sections to compare against ...
   my $ropts;
   my $dopts;

   ($ropts, $dopts, @section_tags) = grab_options ( $ctrl_cfg, $file );

   # Always die if we can't locate tags in this config file.
   my %gopts = ( required => 2 );

   my $cfg = initialize_config ( $file, $ropts, \%gopts, $dopts );

   DBUG_RETURN ( $cfg, @section_tags );
}

# ====================================================================
# Grab the needed options ...
# ====================================================================
sub grab_options
{
   DBUG_ENTER_FUNC (@_);
   my $ctrl_cfg = shift;
   my $file     = shift;

   my @section_tags;

   $ctrl_cfg = $ctrl_cfg->get_section ($file);

   dbug_ok ( defined $ctrl_cfg, "Processing config file: $file" );

   unless ( defined $ctrl_cfg ) {
      return DBUG_RETURN ( undef, undef, @section_tags );
   }

   # Get the "Read" & "Date" Options to use ...
   my (%ropts, %dopts);
   foreach my $tg ( $ctrl_cfg->find_tags () ) {
      if ( $tg =~ m/^section_test_/i ) {
         my $val = $ctrl_cfg->get_value ( $tg );
         push ( @section_tags, $val );
      } else {
         my $ltg = lc ($tg);

         if ( exists $default_ropts->{$ltg} ) {
            $ropts{$ltg} = $ctrl_cfg->get_value ( $tg )  # Read
         } elsif ( exists $default_dopts->{$ltg} ) {
            $dopts{$ltg} = $ctrl_cfg->get_value ( $tg )  # Date
         } else {
            DBUG_PRINT ("INFO", "Skipping unknown tag (%s)", $tg);
         }
      }
   }

   DBUG_RETURN ( \%ropts, \%dopts, @section_tags );
}

# ====================================================================
# This is a special one off test config file to verify using
# RegExp chars doesn't cause problems.
# ====================================================================
sub special_31_tests
{
   DBUG_ENTER_FUNC (@_);

   my $cfg = initialize_config ("31-using-regex-seps.cfg",
			{ "assign"     => "...", "comment"     => ".+",
			  "quote_left" => "..",  "quote_right" => "..",
			  "section_left" => ".*", "section_right" => "*." },
			{ "required" => 2 } );

   my $cnt = $cfg->find_tags ();
   $cnt = 0 unless (defined $cnt);
   dbug_cmp_ok ($cnt, '==', 0, "There are no tags located in the main section.");

   my $sect = $cfg->get_section ( "Section" );
   dbug_ok (defined $sect, "Section 'Section' exists.");

   my @lst = $sect->find_tags ();
   $cnt = @lst;
   dbug_cmp_ok ($cnt, ">", 0, "There are ${cnt} tags in this section.");

   foreach my $tag ( @lst ) {
      my $value = $sect->get_value ( $tag );
      if ( $tag =~ m/^empty/ ) {
	 dbug_cmp_ok ($value, "eq", "", "Tag ${tag}'s value is the empty string.");
      } elsif ( $tag =~ m/^space/ ) {
	 dbug_cmp_ok ($value, "eq", " ", "Tag ${tag}'s value is a space char.");
      } else {
	 dbug_cmp_ok ($value, "eq", $tag, "Tag ${tag}'s value is itself.");
      }
   }