view release on metacpan or  search on metacpan

Config.pm  view on Meta::CPAN

   # Must it be hidden in the fish logs?
   $self->{DATA}->{$tag}->{MASK_IN_FISH} = $hide;

   # Is the value still encrypted?
   $self->{DATA}->{$tag}->{ENCRYPTED} = $still_encrypted ? 1 : 0;

   # 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;

   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;

   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 );

   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};
      delete ( $self->{DATA}->{$tag} );
      return DBUG_RETURN (1);
   }

   DBUG_RETURN (0);