view release on metacpan or  search on metacpan

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

#            'SCALAR' => {
#               'SCALAR' => sub { $_[0] },
#               'ARRAY'  => &die_array_scalar,
#               'HASH'   => &die_hash_scalar,
#              },
#            'ARRAY' => {
#               'SCALAR' => sub { [ @{ $_[0] }, $_[1] ] },
#               'ARRAY'  => sub { [ @{ $_[0] }, @{ $_[1] } ] },
		       #               'HASH'   => &die_hash_array,
#              },
#            'HASH' => {
#               'SCALAR' => &die_scalar_hash,
#               'ARRAY'  => &die_array_hash,
#               'HASH'   => sub { _merge_hashes( $_[0], $_[1] ) },
#              },
#	  },

		      }, $pkg);

    $self->_init_StrongSingleton();
    if ( $yaml_file ) {
	$self->load( $yaml_file )
    }
    else {
	$self->load();
    }
    return $self;
}

=head2 load()

Load a YAML file into the registry. Throws exception if the file has
already been successfully loaded.

=cut

sub load {
    my ( $pkg, $yaml_file, $reload ) = @_;
    my $self = $pkg->new();
    my $registered_something;

    if( $reload ) {
	$self->{REGISTRY_BACKUP} = $self->{REGISTRY};
	$self->{REGISTRY} = { };
    }

    if ( !keys( %{ $self->{REGISTRY} } ) ) {

	if( defined ( $ENV{ACT_REG_YAML_FILE} ) && -f $ENV{ACT_REG_YAML_FILE} ) {
	    $self->register_file( $ENV{ACT_REG_YAML_FILE} );
	    $registered_something = 1;
	}

	if ( defined( $yaml_file ) && -f $yaml_file ) {
	    $self->register_file( $yaml_file );
	    $registered_something = 1;
	}
    }

    else {
	# refuse to reload without flag
	WARN("Cowardly refusing to stomp registry without 'reload' flag");
	return;
    }

    if ( !$registered_something ) {

	my $action = 'load';
	if ( keys %{ $self->{REGISTRY_BACKUP} } ) {
	    $self->{REGISTRY} = $self->{REGISTRY_BACKUP};
	    $action = 'reload';
	}

	if ( $ENV{ACT_REG_YAML_FILE} || $yaml_file ) {
	    my $msg = "Registry $action failed." .
	    'Neither $ENV{ACT_REG_YAML_FILE} ('. ( $ENV{ACT_REG_YAML_FILE} || 'undef' ) .
	    ') nor $yaml_file ('. ( $yaml_file || 'undef' ) .
	    ') are a valid configuration file';

	    # TODO: figure out how to solve the cyclic dependancy problem.
	    # That is, Log depends on this file to find it's config, so
	    # when calling new, we can't be guranteed that log is loaded.
	    # We need to figure out if Log is loaded, then we can just
	    # warn for the outlier case where Log is configured to a bad
	    # filename.
	    warn( "[WARN] $msg" );
	}
	$registered_something = 0;
    }
    else {
	$registered_something = 1;
    }

    return $registered_something;
}

=head2 reload()

Reloads a specific configuration file. This nukes the existing registry.

=cut

sub reload {
    my ( $pkg, $yaml_file ) = @_;
    $pkg->load( $yaml_file, 1 );
}

=head2 register( $key, $value, $realm )

Register a key-value pair to C<$realm>. Registers to the default realm
if C<$realm> not defined. Returns true on success, false otherwise
(more specifically, the return value of the C<eq> operator when
testing the set value to the value passed in).

=cut

sub register {
  my ($pkg, $key, $value, $realm) = @_;
  my $self = $pkg->new();
  $realm ||= $self->{DEFAULT_REALM};

   my @keys = split( '->', $key );