view release on metacpan or  search on metacpan

lib/Activator/Registry.pm  view on Meta::CPAN

       }
       return $retval;
   }
   return $self->{REGISTRY}->{ $realm }->{ $key };
}

sub _deep_get {
   my ($pkg, $keys, $realm, $reg_ref) = @_;
   my $key = shift @$keys;

   if ( @$keys == 0 ) {
       if ( exists( $reg_ref->{ $key } ) ) {
	   return $reg_ref->{ $key };
       }
       else {
	   Activator::Exception::Registry->throw( 'key', 'invalid', $key );
       }
   }

   if ( exists( $reg_ref->{ $key } ) ) {
       return $pkg->_deep_get( $keys, $realm, $reg_ref->{ $key } );
   }
   else {
       Activator::Exception::Registry->throw( 'key', 'invalid', $key );
   }
}

=head2 get_realm( $realm )

Return a reference to hashref for an entire C<$realm>.

=cut

sub get_realm {
   my ($pkg, $realm) = @_;

   my $self = $pkg->new();
   $realm ||= $self->{DEFAULT_REALM};
   return $self->{REGISTRY}->{ $realm };
}


=head2 set_default_realm( $realm )

Use C<$realm> instead of 'default' for default realm calls.

=cut

sub set_default_realm {
   my ($pkg, $realm) = @_;

   my $self = $pkg->new();
   $self->{DEFAULT_REALM} = $realm;
}

=head2 replace_in_realm( $realm, $replacements )

Replace variables matching C<${}> notation with the values in
C<$replacements>. C<$realm> must be specified. Use C<'default'> for
the default realm. Keys that refer to other keys in the realm are
processed AFTER the passed in C<$replacements> are processed.

=cut

sub replace_in_realm {
    my ($pkg, $realm, $replacements) = @_;
    my $self = $pkg->new();

    my $reg = $self->get_realm( $realm );
    if ( !keys %$reg ) {
	Activator::Exception::Registry->throw( 'realm', 'invalid', $realm );
    }

    TRACE("replacing (realm '$realm') ". Dumper($reg) . "\n ---- with ----\n". Dumper($replacements));
    $self->replace_in_hashref( $reg, $replacements );
    $self->replace_in_hashref( $reg, $reg );
    TRACE("Done replacing. End result: ". Dumper($reg));
}

=head2 replace_in_hashref( $hashref, $replacements )

Replace withing the values of C<$hashref> keys, variables matching
C<${}> notation with the values in C<$replacements>.

=cut

sub replace_in_hashref {
    my ( $pkg, $hashref, $replacements ) = @_;
    foreach my $key ( keys %$hashref ) {

	# if key is a hash, recurse
	if ( UNIVERSAL::isa( $hashref->{ $key }, 'HASH')) {
	    $pkg->replace_in_hashref( $hashref->{ $key }, $replacements );
	}

	# if key is an array, do replacements for each item
	elsif ( UNIVERSAL::isa( $hashref->{ $key }, 'ARRAY')) {
	    for( my $i = 0; $i < @{ $hashref->{ $key } }; $i++ ) {
		@{ $hashref->{ $key }}[ $i ] =
		  $pkg->do_replacements( @{ $hashref->{ $key }}[ $i ],
					 $replacements,
					 0 );
	    }
	}

	# if key is a string just do the replacment for the string
	else {
	    $hashref->{ $key } =
	      $pkg->do_replacements( $hashref->{ $key },
				     $replacements,
				     0 );
	}
    }
}

=head2 do_replacements ( $string, $replacements )

Helper subroutine to allow recursive replacements of C<${}> notation
with values in C<$replacements>. Returns the new value.

=cut