view release on metacpan or  search on metacpan

lib/Config/Singleton.pm  view on Meta::CPAN

#pod =head2 Alternate Configuration Objects
#pod
#pod Although it's generally preferable to begin your program by forcing the loading
#pod of a configuration file and then using the global configuration, it's possible
#pod to have multiple Your::Thing::Config configurations loaded by instantiating
#pod objects of that class, like this:
#pod
#pod   my $config_obj = Your::Thing::Config->new($filename);
#pod
#pod The named file is found via the same path resolution (if it's relative) as
#pod described above.
#pod
#pod =head1 METHODS
#pod
#pod Config::Singleton doesn't actually have any real public methods of its own.
#pod Its methods are all private, and serve to power its C<import> routine.  These
#pod will probably be exposed in the future to allow for subclassing of
#pod Config::Singleton, but in the meantime, don't rely on them.
#pod
#pod =cut

# Initialize all the methods for our new class.
# this is a Sub::Exporter group generator
sub _build_config_methods {
  my ($self, $name, $arg) = @_;

  # XXX: validate $arg here -- rjbs

  # This is the set of subs we're going to install in config classes.
  my %sub = (
    $self->_build_default_filename_methods($arg),
    $self->_build_default_object_methods($arg),
    _template  => sub { $arg->{template} },
    _config    => sub { shift->_self->{config} },
    import     => $self->_build_import($arg),
    new        => $self->_build_new($arg),
  );

  for my $attr (keys %{ $arg->{template} }) {
    Carp::croak "can't use reserved name $attr as config entry"
      if exists $sub{ $attr };

    $sub{ $attr } = sub {
      my $value = shift->_self->_config->{$attr};
      return @$value if (ref $value || q{}) eq 'ARRAY'; # XXX: use _ARRAYLIKE
      return $value;
    };
  }

  return \%sub;
}

## METHODS THAT BUILD METHODS TO INSTALL

sub _build_new {
  my ($app_config, $arg) = @_;

  sub {
    my ($class, $filename) = @_;

    my $self = bless { } => $class;

    $self->{basename} = $filename || $class->default_filename;

    $filename = $app_config->_find_file_in_path(
      $self->{basename},
      $arg->{path},
    );

    $self->{filename} = $filename;

    $self->{config} = $app_config->_merge_data(
      $self->_template,
      $app_config->_load_file(
        $app_config->_find_file_in_path(
          $self->{filename},
          $arg->{path},
        ),
      ),
    );

    return $self;
  };
}

sub _build_default_filename_methods {
  my ($app_config, $arg) = @_;

  my $set_default;

  my $get_default_filename = sub {
    my ($self) = @_;
    return $set_default ||= $arg->{filename}
                        ||  $app_config->_default_filename_for_class($self);
  };

  my $set_default_filename = sub {
    my ($class, $filename) = @_;
    Carp::croak "can't change default filename, config already loaded!"
      if  $set_default
      and $set_default ne $filename;
    $set_default = $filename;
  };

  return (
    _get_default_filename => $get_default_filename,
    _set_default_filename => $set_default_filename,
  );
}

sub _build_default_object_methods {
  my ($app_config) = @_;

  my $default;

  my $_self = sub {
    my ($self) = @_;
    return $self if ref $self;
    return $default ||= $self->new($self->_get_default_filename);
  };