Config::Backend::File - a file backend for Config::Frontend.

Config-Frontend documentation Contained in the Config-Frontend distribution.

Index

Code Index:

NAME

Top

Config::Backend::File - a file backend for Config::Frontend.

ABSTRACT

Top

Config::Backend::File is a file backend for Config::Frontend. It handles files with identifiers that are assigned values. The files can have comments.

Description

Top

Each call set() will immediately result in file to be rewritten.

The configuration file has following syntax:

  %# Head of the configuration file
  %variable=value
  %variable=mult
  line value with
  %% double percentage sign
  at the beginning of the line % indicating
  %%# (This is not a comment)
  a single escaped percentage sign.
  %# Comments start with %#.

new(filename) --> Config::Backend::File

Invoked with a valid filename, new will open the filename for reading and read in the configuration items. A configuration file will have the following form:

  %var = value
  %multiline=Hi there,
  This is a multiline, with a hundred,
  %% (percent) read 
  back.
  %test=1000.0

Notice that the percentage sign in a multiline config item will be doubled to distinguish it from config variables.

DESTROY()

This function will write back the configuration to file.

set(var,value) --> void

Sets config key var to value. Writes the config file right away.

get(var) --> string

Reads var from config. Returns undef, if var does not exist. Returns the value of configuration item var, otherwise.

del(var) --> void

Deletes var from the configuration file.

variables() --> list of strings

Returns all variables in the configuraton file.

SEE ALSO

Top

Config::Frontend.

AUTHOR

Top

Hans Oesterholt-Dijkema, <oesterhol@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright 2004 by Hans Oesterholt-Dijkema

This library is free software; you can redistribute it and/or modify it under LGPL.

Config-Frontend documentation Contained in the Config-Frontend distribution. 
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__


  



=cut