view release on metacpan or  search on metacpan

Config.pm  view on Meta::CPAN

   # Does the value still reference variables?
   $self->{DATA}->{$tag}->{VARIABLE} = $has_variables ? 1 : 0;

   return ( 1, $hide );
}


#######################################

=back

=head2 Manipulating the contents of an Advanced::Config object.

These methods allow you to manipulate the contents of an B<Advanced::Config>
object in many ways.  They all just update what's in memory and not the contents
of the config file itself.

So should the contents of this module get refreshed, you will loose any changes
made by these B<4> methods.

=over

=item $ok = $cfg->set_value ( $tag, $value );

Adds the requested I<$tag> and it's I<$value> to the current section in the
I<Advanced::Config> object.

If the I<$tag> already exists, it will be overridden with its new I<$value>.

It returns B<1> on success or B<0> if your request was rejected!
It will also print a warning if it was rejected.

=cut

sub set_value
{
   my $self  = shift;   # Reference to the current section of the object.
   my $tag   = shift;   # The tag set to value ...
   my $value = shift;

   if ( $self->_chk_if_read_only () ) {
      die ("You may not modify a rules config file!\n");
      return (0);
   }

   my ( $worked, $sensitive ) = $self->_base_set ($tag, $value, undef);

   DBUG_MASK_NEXT_FUNC_CALL (2)  if ( $sensitive );
   DBUG_ENTER_FUNC ( $self, $tag, $value, @_ );

   unless ( $worked ) {
      warn ("You may not use \"${tag}\" as your tag name!\n");
   }

   DBUG_RETURN ($worked);
}

#######################################

=item $bool = $cfg->rename_tag ( $old_tag, $new_tag );

Renames the tag found in the current section to it's new name.  If the
I<$new_tag> already exists it is overwriting by I<$old_tag>.  If I<$old_tag>
doesn't exist the rename fails.

Returns B<1> on success, B<0> on failure.

=cut

sub rename_tag
{
   DBUG_ENTER_FUNC (@_);
   my $self    = shift;
   my $old_tag = shift;
   my $new_tag = shift;

   if ( $self->_chk_if_read_only () ) {
      die ("You may not modify a rules config file!\n");
      return DBUG_RETURN (0);
   }

   unless ( defined $old_tag && defined $new_tag ) {
      warn ("All arguments to rename_tag() are required!\n");
      return DBUG_RETURN (0);
   }

   if ( $new_tag =~ m/^shft3+$/i ) {
      warn ("You may not use \"${new_tag}\" as your new tag name!\n");
      return DBUG_RETURN (0);
   }

   # Get the main/parent section to work against!
   my $pcfg = $self->{PARENT} || $self;

   # Check if a case insensitive lookup was requested ...
   if ( $pcfg->{CONTROL}->{read_opts}->{tag_case} ) {
      $old_tag = lc ($old_tag)  if ( $old_tag );
      $new_tag = lc ($new_tag)  if ( $new_tag );
   }

   if ( $old_tag eq $new_tag ) {
      warn ("The new tag name must be different from the old tag name!\n");
      return DBUG_RETURN (0);
   }

   # Was there something to rename ???
   if ( exists $self->{DATA}->{$old_tag} ) {
      $self->{DATA}->{$new_tag} = $self->{DATA}->{$old_tag};
      delete ( $self->{DATA}->{$old_tag} );
      return DBUG_RETURN (1);
   }

   DBUG_RETURN (0);
}

#######################################

=item $bool = $cfg->move_tag ( $tag, $new_section[, $new_tag] );

This function moves the tag from the current section to the specified new
section.  If I<$new_tag> was provided that will be the tag's new name in
the new section.  If the tag already exists in the new section it will be
overwritten.

If the tag or the new section doesn't exist, the move will fail!  It will also
fail if the new section is the current section.

Returns B<1> on success, B<0> on failure.

=cut

sub move_tag
{
   DBUG_ENTER_FUNC (@_);
   my $self        = shift;
   my $tag         = shift;
   my $new_section = shift;
   my $new_tag     = shift;

   $new_tag = $tag  unless ( defined $new_tag );

   if ( $self->_chk_if_read_only () ) {
      die ("You may not modify a rules config file!\n");
      return DBUG_RETURN (0);
   }

   unless ( defined $tag && defined $new_section ) {
      warn ("Both \$tag and \$new_section are required for move_tag()!\n");
      return DBUG_RETURN (0);
   }

   if ( $new_tag =~ m/^shft3+$/i ) {
      warn ("You may not use \"${new_tag}\" as your new tag name!\n");
      return DBUG_RETURN (0);
   }

   # Get the main/parent section to work against!
   my $pcfg = $self->{PARENT} || $self;

   # Check if a case insensitive lookup was requested ...
   $tag = lc ($tag)  if ( $pcfg->{CONTROL}->{read_opts}->{tag_case} && $tag );

   my $cfg = $self->get_section ( $new_section ) || $self;

   if ( $self ne $cfg && exists $self->{DATA}->{$tag} ) {
      $cfg->{DATA}->{$new_tag} = $self->{DATA}->{$tag};