view release on metacpan or  search on metacpan

t/56-tohash.t  view on Meta::CPAN

   DBUG_VOID_RETURN ();
}

# ====================================================================
sub trim_if_sensitive
{
   DBUG_ENTER_FUNC ( @_ );
   my $cfg = shift;
   my $sensitive = shift;

   my @tags = $cfg->find_tags ( undef, 0 );
   my @keep;

   if ( $sensitive ) {
      foreach ( @tags ) {
        push (@keep, $_)  unless ( $cfg->chk_if_sensitive ($_, 0) );
      }
   } else {
      @keep = @tags;
   }

   DBUG_RETURN ( @keep );
}

# ====================================================================
sub test_section
{
   DBUG_ENTER_FUNC ( @_ );
   my $sect    = shift;
   my $data    = shift;
   my @tags    = @_;

   my %found;
   foreach my $tag ( sort @tags ) {
      my $val = $sect->get_value ($tag) || "";
      dbug_ok ( exists $data->{$tag} && $data->{$tag} eq $val,
            "Tag '${tag}' exists in the hash with the correct value ($val)");

      $found{$tag} = 1;
   }

   # Make sure there are no extra keys ...
   foreach my $tag ( sort keys %{$data} ) {
      unless ( exists $found{$tag} ) {
         dbug_ok ( 0, "Tag '$tag' exists in the Advanced::Config object!" );
      }
   }

   DBUG_VOID_RETURN ();
}

# ====================================================================
sub init_config
{
   DBUG_ENTER_FUNC ( @_ );
   my $in_string = shift;

   my $cfg;
   my ( %rOpts, %gOpts, %dOpts );

   $rOpts{Croak} = 1;      # Call die on error.
   $gOpts{Required} = 1;   # Call die if the tag doesn't exist.

   # Did we override the read options to use with the string?
   my %oOpts;

   eval {
      $cfg = Advanced::Config->new (undef, \%rOpts, \%gOpts, \%dOpts);
      dbug_isa_ok ($cfg, 'Advanced::Config');
      my $ldr = $cfg->load_string ( $in_string, \%oOpts );
      dbug_ok (defined $ldr, "Advanced::Config contents have been loaded into memory!");
   };
   if ( $@ ) {
      unless (defined $cfg) {
         dbug_isa_ok ($cfg, 'Advanced::Config');
      }
      dbug_ok (0, "Advanced::Config contents have been loaded into memory!");
      DBUG_LEAVE (3);
   }

   # So can tell when the config files were loaded in fish ...
   DBUG_PRINT ("====", "%s", "-"x50);

   DBUG_RETURN ( $cfg );
}