view release on metacpan or  search on metacpan

t/65-rule-config.t  view on Meta::CPAN

   my $msg = shift;
   DBUG_PRINT ("MY_WARN", $msg);
   # diag ($msg);
   # warn "\n";
   return;
}


sub verify_ruleCfg_is_ReadOnly
{
   DBUG_ENTER_FUNC (@_);
   my $ruleCfg = shift;

   local $SIG{__DIE__} = \&my_die;
   local $SIG{__WARN__} = \&my_warn;

   dbug_ok (1, '+'x40);

   my $f = build_filename ( "65-my-config-file.cfg" );
   eval {
      $ruleCfg->load_config ($f);
      dbug_ok (0, "Loading a new file is disallowed.");
   };
   if ($@) {
      dbug_ok (1, "Loading a new file is disallowed.");
   }

   eval {
      $ruleCfg->load_string ( "a = b" );
      dbug_ok (0, "Loading a new string is disallowed.");
   };
   if ($@) {
      dbug_ok (1, "Loading a new string is disallowed.");
   }

   eval {
      $ruleCfg->merge_config ($f);
      dbug_ok (0, "Merging another file is disallowed.");
   };
   if ($@) {
      dbug_ok (1, "Merging another file is disallowed.");
   }

   eval {
      $ruleCfg->merge_string ( "a = b" );
      dbug_ok (0, "Merging another string is disallowed.");
   };
   if ($@) {
      dbug_ok (1, "Merging another string is disallowed.");
   }

   eval {
      $ruleCfg->set_value ( "croak", 2 );
      dbug_ok (0, "Changing a tag's value is disallowed.");
   };
   if ($@) {
      dbug_ok (1, "Changing a tag's value is disallowed.");
   }

   eval {
      $ruleCfg->rename_tag ( "croak", "die" );
      dbug_ok (0, "Renaming a tag's name is disallowed.");
   };
   if ($@) {
      dbug_ok (1, "Renaming a tag's name is disallowed.");
   }

   eval {
      $ruleCfg->move_tag ( "inherit", "*" );
      dbug_ok (0, "Moving a tag to another section is disallowed.");
   };
   if ($@) {
      dbug_ok (1, "Moving a tag to another section is disallowed.");
   }

   eval {
      $ruleCfg->delete_tag ( "assign" );
      dbug_ok (0, "Deleting a tag is disallowed.");
   };
   if ($@) {
      dbug_ok (1, "Deleting a tag is disallowed.");
   }

   eval {
      $ruleCfg->create_section ( "Bad Section" );
      dbug_ok (0, "Creating a new section is disallowed.");
   };
   if ($@) {
      dbug_ok (1, "Creating a new section is disallowed.");
   }

   # This one should actually work!
   my $status = $ruleCfg->refresh_config ( force => 1 );
   dbug_ok ($status, "The refresh of the rule config file worked.");

   DBUG_VOID_RETURN ();
}