File Coverage

blib/lib/Config/Frontend.pm

Criterion	Covered	Total	%
statement	91	94	96.8
branch	23	28	82.1
condition			n/a
subroutine	18	19	94.7
pod	15	17	88.2
total	147	158	93.0

package Config::Frontend;

use 5.006;
use strict;

our $VERSION = '0.18';

sub new {
  my $class=shift;
  my $backend=shift;
  my $self;

  $self->{"backend"}=$backend;
  $self->{"cache_items"}=0;
  $self->{"cache"}={};

  bless $self,$class;

return $self;
}

#####################################################
# Cache
#####################################################

sub cache {
  my ($self,$cache_on)=@_;
  $self->{"cache_items"}=$cache_on;
}

sub clear_cache {
  my ($self)=@_;
  $self->{"cache"}={};
}

#####################################################
# Variables
#####################################################

sub set {
  my ($self,$var,$val)=@_;
  if ($self->{"cache_items"}) {
    if (exists $self->{"cache"}->{$var}) {
      delete $self->{"cache"}->{$var};
    }
  }
  $self->{"backend"}->set($var,$val);
}

sub get {
  my ($self,$var,$preset)=@_;
  if ($self->{"cache_items"}) {
    if (exists $self->{"cache"}->{$var}) {
      return $self->{"cache"}->{$var};
    }
    else {
      my $val=$self->{"backend"}->get($var);
      if (not defined $val) { $val=$preset; }
      $self->{"cache"}->{$var}=$val;
      return $val;
    }
  }
  else {
    my $val=$self->{"backend"}->get($var);
    if (not defined $val) { $val=$preset; }
    return $val;
  }
}

sub del {
  my ($self,$var)=@_;
  $self->{"backend"}->del($var);
  if ($self->{"cache_items"}) {
    if (exists $self->{"cache"}->{$var}) {
      delete $self->{"cache"}->{$var};
    }
  }
  $self->del_props($var);
}

sub exists {
  my ($self,$var)=@_;
  if ($self->{"cache_items"}) {
    if (exists $self->{"cache"}->{$var}) {
      return defined $self->{"cache"}->{$var};
    }
    else {
      my $val=$self->{"backend"}->get($var);
      return defined $val;
    }
  }
  else {
    my $val=$self->{"backend"}->get($var);
    return defined $val;
  }
}

sub move {
  my ($self,$fromvar,$tovar)=@_;
  for my $prop ( $self->properties($fromvar) ) {
    if ($self->exists_prop($fromvar,$prop)) {
      $self->set_prop($tovar,$prop,$self->get_prop($fromvar,$prop));
      $self->del_prop($fromvar,$prop);
    }
  }
  if ($self->exists($fromvar)) {
    $self->set($tovar,$self->get($fromvar));
    $self->del($fromvar);
  }
}

#####################################################
# Properties
#####################################################

sub set_prop {
  my ($self,$var,$prop,$val)=@_;
  $self->set("#props_exist#.$var",1);
  $self->set("#prop#.$var.$prop",$val);
}

sub get_prop {
  my ($self,$var,$prop,$default)=@_;
return $self->get("#prop#.$var.$prop",$default);
}

sub del_prop {
  my ($self,$var,$prop)=@_;
return $self->del("#prop#.$var.$prop");
}

sub exists_prop {
  my ($self,$var,$prop)=@_;
  return $self->exists("#prop#.$var.$prop");
}

sub move_prop {
  my ($self,$var,$fromprop,$toprop)=@_;
  if ($self->exists($var,$fromprop)) {
    $self->set_prop($var,$toprop,$self->get_prop($var,$fromprop));
    $self->del_prop($var,$fromprop);
  }
}

sub del_props {
  my ($self,$var)=@_;
  if ($self->exists("#props_exist#.$var")) {
    my @props=$self->properties($var);
    for my $v (@props) {
      $self->del_prop($var,$v);
    }
    $self->del("#props_exist#.$var");
  }
}

#####################################################
# Variables/properties
#####################################################

sub properties {
  my ($self,$var)=@_;
  my $prefix="#prop#.$var";
  my $N=length($prefix);
  my @props;
  for my $prop ( grep { (substr($_,0,$N) eq $prefix) } $self->{"backend"}->variables() ) {
    push @props,substr($prop,$N+1);
  }
return @props;
}

sub variables {
  my ($self)=@_;
  my $prefix="#prop#.";
  my $N=length($prefix);
  return grep { (substr($_,0,$N) ne $prefix) } $self->{"backend"}->variables();
}

#####################################################
# info
#####################################################

sub cached {
  my $self=shift;
  my $items=scalar (keys %{$self->{"cache"}});
return $items;
}


1;
__END__