File Coverage

blib/lib/Config/Backend/File.pm

Criterion	Covered	Total	%
statement	99	99	100.0
branch	24	26	92.3
condition			n/a
subroutine	9	9	100.0
pod	5	6	83.3
total	137	140	97.8

package Config::Backend::File;

use 5.006;
use strict;

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

  # Read in config

  my $str="";
  my @order;
  my %conf;
  my $invar=0;
  my $open=1;
  my @vars_and_comments;

  open my $in,"<$filename" or $open=0;;
  if ($open) {
    while (my $line=<$in>) {
      $str.=$line;
    }
    close $in;
  }

  # Process Comments and %%

  my $i=0;
  my $k=0;
  my $N=length($str);

  while ($i<$N) {
    if (substr($str,$i,3) eq "\n%#") {
      if ($k!=$i) {
	push @vars_and_comments,substr($str,$k,($i-$k));
	$k=$i+1;
	$i+=2;
      }
    } elsif (substr($str,$i,3) eq "\n%%") {
      $i+=2;
    } elsif (substr($str,$i,2) eq "\n%") {
      if ($k!=$i) {
	push @vars_and_comments,substr($str,$k,($i-$k));
	$k=$i+2;
	$i+=2;
      }
    }
    $i+=1;
  }

  if ($k!=$i) {
    push @vars_and_comments,substr($str,$k,($N-$k));
  }

  my $comment=0;
  for my $item (@vars_and_comments) {
    if ($item=~/^%#/) {
      push @order,"%#$comment,$item";
      $comment+=1;
    } else {
      my ($var,$val)=split /=/,$item,2;
      $var=~s/^%//;
      push @order,$var;
      $val=~s/\n%%/\n%/;
      $conf{$var}=$val;
    }
  }

  # Set config to string

  $self->{"filename"}=$filename;
  $self->{"order"}=\@order;
  $self->{"conf"}=\%conf;
  $self->{"changed"}=0;

  # bless

  bless $self,$class;

return $self;
}

sub DESTROY {
  my $self=shift;
  $self->commit();
}

sub commit {
  my $self=shift;

  # Only commit on changes

  if (not $self->{"changed"}) {
    return;
  }

  # Commit to file

  my $filename=$self->{"filename"};
  my $firstvar=1;
  open my $out,">$filename";
  my $delim="";
  my $cdelim="";
  for my $var (@{$self->{"order"}}) {
    if ($var=~/^%#/) {
      my ($cm,$val)=split /,/,$var,2;
      print $out "$cdelim$val";
    }
    else {
      my $val=$self->{"conf"}->{"$var"};
      $val=~s/\n%/\n%%/g;
      print $out "$delim$var=$val";
    }
    $delim="\n%";
    $cdelim="\n";
  }

  close $out;
}

sub set {
  my $self=shift;
  my $var=shift;
  my $val=shift;

  $self->{"changed"}=1;

  my $oldval=$self->get($var);
  if (not exists $self->{"conf"}->{$var}) {
    push @{$self->{"order"}},$var;
  }
  $self->{"conf"}->{$var}=$val;

  $self->commit();
}

sub get {
  my $self=shift;
  my $var=shift;
return $self->{"conf"}->{$var};
}

sub del {
  my ($self,$var)=@_;

  $self->{"changed"}=1;

  delete $self->{"conf"}->{$var};

  my @neworder;
  for my $elem (@{$self->{"order"}}) {
    if ($elem ne $var) {
      push @neworder,$elem;
    }
  }
  $self->{"order"}=\@neworder;

  $self->commit();
}

sub variables {
  my $self=shift;
return keys %{$self->{"conf"}};
}

1;
__END__