File Coverage

blib/lib/Rose/Conf.pm

Criterion	Covered	Total	%
statement	42	52	80.7
branch	12	20	60.0
condition	2	3	66.6
subroutine	10	12	83.3
pod	3	3	100.0
total	69	90	76.6

package Rose::Conf;

use strict;

use Carp();

our $VERSION = '0.021';

our $ExportLevel = 0;

sub import
{
  my($pkg, $export_name) = @_;

  return  unless(@_ > 1 && length $export_name);

  my($callpkg) = caller($ExportLevel);

  return if($pkg eq __PACKAGE__);

  #
  # Mostly lifted from Exporter.pm
  #

  # Make import warnings look like they're coming from the "use"
  local $SIG{'__WARN__'} = sub
  {
    my($text) = shift;

    if($text =~ s/ at \S*Rose\/Conf.pm line \d+.*\n//)
    {
      local $Carp::CarpLevel = 1; # ignore package calling us too.
      carp $text;
    }
    else
    {
      warn $text;
    }
  };

  local $SIG{'__DIE__'} = sub
  {
    local $Carp::CarpLevel = 1; # ignore package calling us too.
    Carp::croak "$_[0] Illegal null symbol in \@${1}::EXPORT"
      if($_[0] =~ /^Unable to create sub named "(.*?)::"/);
  };

  unless($export_name =~ /^%\w+$/)
  {
    local $Carp::CarpLevel = 0;
    Carp::croak "Usage: use $pkg qw(%SOME_HASH)";
  }

  # Chop off the %
  $export_name = substr($export_name, 1);

  # Alias the %CONF hash
  no strict 'refs';
  *{"${callpkg}::$export_name"} = \%{"${pkg}::CONF"}
}

sub param
{
  my($class) = shift;

  my $conf = $class->conf_hash;

  if(@_)
  {
    my $param = shift;

    if(@_)
    {
      return $conf->{$param} = shift;
    }
    else
    {
      Carp::croak "No such conf parameter in $class: '$param'\n"
        unless(exists $conf->{$param});

      if(ref $conf->{$param} eq 'HASH')
      {
        return bless $conf->{$param}, 'Rose::Conf::Setting';
      }

      return $conf->{$param};
    }
  }

  Carp::croak "Cannot get param() without parameter name";
}

sub conf_hash
{
  my($class) = shift;

  no strict 'refs';

  return \%{$class . '::CONF'};
}

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

  Carp::croak "Cannot check if param_exists() without parameter name"
    unless(defined $param);

  my $conf = $class->conf_hash;

  return exists $conf->{$param};
}

BEGIN
{
  package Rose::Conf::Setting;
  our @ISA = qw(Rose::Conf);
  sub conf_hash { $_[0] }
}


1;

__END__