Config::Properties::Simple - Perl extension to manage configuration files.

Config-Properties-Simple documentation Contained in the Config-Properties-Simple distribution.

Index

Code Index:

NAME

Top

Config::Properties::Simple - Perl extension to manage configuration files.

SYNOPSIS

Top

  use Config::Properties::Simple;

  my $cfg=Config::Properties::Simple->new();
  my $foo=$cfg->getProperty('foo', 'default foo');

  $cfg->setProperty(bar => 'my bar')
  $cfg->save

  my $cfg2=Config::Properties::Simple->new(
    name => 'app/file',
    file => $opt_c,
    optional => 1,
    aliases => { Fhoo => 'Foo', Bhar => 'Bar' },
    validate => { Foo => 'boolean',
                  MyHexProp => qr/^0x[0-9a-f]+$/i,
                  Odd => sub {
                    my ($key, $value, $cfg)=@_;
                    $value = int $value;
                    $value & 1 or
                      $cfg->fail("$value is not odd");
                    1 } },
    defaults => { Foo => 1,
                  MyHexProp => '0x45' },
    required => [qw( Foo )] );

ABSTRACT

Top

Wrapper around Config::Properties to simplify its use.

DESCRIPTION

Top

This package mix functionality in Config::Properties and Config::Find packages to provide a simple access to configuration files.

It changes new and save methods of Config::Properties (every other method continues to work as usual):

Config::Properties::Simple->new(%opts)

creates a new Config::Properties::Simple object and reads on the configuration file determined by the options passed through %opts.

The supported options are:

defaults => {...}

hash reference containing default values for the configuration keys (similar to defaultProperties field in the original Config::Properties::new constructor).

noread => 1
mode => "write"

stops properties for being read from a file.

utf8 => 1>

opens the file for reading/writing with the :utf8 layer.

optional => 1

by default an exception is thrown when the configuration file can not be found or opened, this option makes the constructor succeed anyway.

If the file option is included and defined the constructor dies unless optional value is greater than 1. This is useful to let the user pass the configuration file name on the script command line when you want the script to fail if it's not found.

format => $format

equivalent to calling setFormat method.

dups_ok => 1

by default, an error is reported when two similar keys are found on the same file, setting dups_ok causes previous values to be ignored instead.

aliases => { alias1 = key1, alias2 =>key2 ... }

entries on the configuration file whose keys are found on the aliases hash are normalized to the corresponding key. Aliases only affect parsing and are not taken into account for default values or when getting or setting properties.

validate => ...

sets conditions that the properties in the configuration file have to meet.

There are several formats allowed:

validate => \&subroutine

calls the subroutine as

  &subroutine($key, $value, $cfg)

subroutine should return a true value if the pair $key $value is valid or false otherwise. For customized error messages $cfg->fail($error) can be called.

Both $key and $value can be modified manipulating the @_ array directly. Its sometimes useful to normalize the value, i.e.:

  use Date::Manip;
  sub validate_date { defined($_[1] = Date::Manip::ParseDate($_[1])) }
  my $cfg = Config::Properties::Simple->new(validate => \&validate_date);
validate => \@array

only properties in @array are allowed. Regexp are also allowed inside de array. i.e.:

   validate => [ qr/^Foo\.\w+$/, qw(Bar Doz) ],
validate => \%hash

%hash allows to set a condition for every property.

There could be an additional __default entry to be applied to properties that don't have their own entries.

Supported conditions are:

\&subroutine

calls the subroutine as

  &subroutine($key, $value, $cfg)

similar to passing a validating subrutine (explained before).

\@array

property value has to be in @array.

\%hash

$hash{$value} has to exist and its value is returned instead of the original $value.

qr/regular expression/

$value has to match the regular expression.

b or boolean

$value has to be a boolean value.

Valid true values are y, yes, t, true, 1.

Valid false values are n, no, f, false, 0, .

Case doesn't matter.

u or unsigned

unsigned integer.

i or integer

integer

f, float, n or number

float number

s, string, a or any

anything is ok.

required => [...]

properties that have to be included in the configuration file. When someone is missing, an exception is raised telling the user the reason.

Any option accepted by Config::Find can also be used in new method.

$this->save(%opts)

creates a new configuration file with the properties defined in the object.

%opts are passed to Config::Find->find() to determine the configuration file name and location.

$this->fail($error)

method to be called from inside validation subs to report an error. It appends the filename and the line number to the error and throws an exception that if uncatched will show the user what went wrong.

EXPORT

None, this package is OO.

SEE ALSO

Top

Config::Properties, Config::Find.

AUTHOR

Top

Salvador Fandiņo, <sfandino@yahoo.com>

COPYRIGHT AND LICENSE

Top

Copyright 2003-2005 by Salvador Fandiņo

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Config-Properties-Simple documentation Contained in the Config-Properties-Simple distribution. 
package Config::Properties::Simple;

use 5.006;

our $VERSION = '0.14';

use strict;
use warnings;
use Carp;

use Config::Properties;
use Config::Find;

our @ISA=qw(Config::Properties Config::Find);

sub new {
    my ($class, %opts)=@_;

    my $defaults;
    if (defined $opts{defaults}) {
	if (UNIVERSAL::isa($opts{defaults}, 'Config::Properties')) {
	    $defaults=$opts{defaults}
	}
	else {
	    $defaults=Config::Properties->new();
	    for my $k (keys %{$opts{defaults}}) {
		$defaults->setProperty($k, $opts{defaults}->{$k})
	    }
	}
    }

    my $this=$class->SUPER::new($defaults);

    $this->{simple_opts}=\%opts;

    exists $opts{format}
	and $this->setFormat($opts{format});

    unless ($opts{noread}
	    or (exists $opts{mode} and $opts{mode}=~/^w(?:rite)?/i)) {
	my $fn=$this->{simple_fn}=$this->find(%opts);
	unless (defined $fn) {
	    return $this if ($opts{optional} and (!defined $opts{file} or $opts{optional} > 1));
	    croak 'configuration file not found';
	}
	my $fh=IO::File->new($fn, "r");
	binmode $fh, ':utf8' if $this->{simple_opts}{utf8};
	unless ($fh) {
	    return $this if ($opts{optional} and !defined $opts{file})
		or croak 'unable to open configuration file for reading';
	}
	$this->load($fh);
	close $fh
	    or croak 'unable to read configuration file';

	my $required=$opts{required};
	if (defined $required) {
	    UNIVERSAL::isa($required, 'ARRAY')
		or croak "invalid object passed for 'required' option, array reference expected";
	    foreach my $req (@{$required}) {
		die "required property '$req' not found in $fn"
		    unless defined $this->getProperty($req);
	    }
	}
    }

    return $this;
}

sub find {
    my $this=shift;
    return $this->SUPER::find(%{$this->{simple_opts}}, @_)
}

sub file_name { shift->{simple_fn} }

sub save {
    my $this=shift;
    my %opts= (%{$this->{simple_opts}}, mode => 'w', @_);
    my $fh=$this->open(%opts)
	or croak 'unable to open configuration file for writing';
    binmode $fh, ':utf8' if $this->{simple_opts}{utf8};
    my $header=$opts{header}
	|| 'Automatically generated configuration file';
    $this->SUPER::save($fh, $header);
    close $fh
	or croak 'unable to write configuration file';
}

sub fail {
    my ($this, $error)=@_;
    die "$error at ".$this->file_name." line ".$this->line_number."\n";
}

sub validate {
    my $this = shift;
    my $okey = $_[0];
    $this->validate_1(@_);
    my $oln=$this->_property_line_number($_[0]);
    if (defined $oln
	and !$this->{simple_opts}{dups_ok}) {
	$this->fail($okey eq $_[0]
		    ? "duplicated property '$okey' (previous appearance at line $oln)"
		    : "duplicated property '$okey' (resolves to '$_[0]', previous appearance at line $oln)" )
    }
}

sub validate_1 {
    my $this = shift;
    my $alias=$this->{simple_opts}{aliases};
    if (defined $alias) {
	$_[0]=$alias->{$_[0]} if exists $alias->{$_[0]};
    }
    my $vtor=$this->{simple_opts}{validate};
    if (defined $vtor) {
	my $fn=$this->{simple_fn};
	if (UNIVERSAL::isa($vtor, 'CODE')) {
	    &$vtor(@_, $this) or $this->fail("invalid property '$_[0]' value '$_[1]'");
	    return;
	}
	if (UNIVERSAL::isa($vtor, 'ARRAY')) {
	    foreach my $vtor2 (@{$vtor}) {
		if (UNIVERSAL::isa($vtor2, 'Regexp')) {
		    return if $_[0]=~$vtor2;
		}
		else {
		    return if $vtor2 eq $_[0];
		}
	    }
	    $this->fail("unknown property '$_[0]' found");
	}
	if (UNIVERSAL::isa($vtor, 'HASH')) {
	    # warn "validate is hash";
	    my $vtor2;
	    if (exists $vtor->{$_[0]}) {
		$vtor2=$vtor->{$_[0]}
	    }
	    elsif (exists $vtor->{__default}) {
		$vtor2=$vtor->{__default}
	    }
	    else {
		$this->fail("unknow property '$_[0]' found");
	    }
	    if (UNIVERSAL::isa($vtor2, 'CODE')) {
		&$vtor2(@_, $this) or $this->fail("invalid property '$_[0]' value '$_[1]'");
		return;
	    }
	    if (UNIVERSAL::isa($vtor2, 'Regexp')) {
		return if $_[1]=~$vtor2;
		$this->fail("property '$_[0]' value '$_[1]' not allowed: it doesn't match regexp '$vtor2'");
	    }
	    if (UNIVERSAL::isa($vtor2, 'ARRAY')) {
		return if (grep { $_[1] eq $_} @{$vtor2});
		$this->fail("property '$_[0]' value '$_[1]' is not allowed");
	    }
	    if (UNIVERSAL::isa($vtor2, 'HASH')) {
		if (exists $vtor2->{$_[1]}) {
		    $_[1]=$vtor->{$_[1]};
		    return
		}
		$this->fail("property '$_[0]' value '$_[1]' is not allowed");
	    }
	    if ($vtor2=~/^s(?:tring)?$/i or $vtor2=~/^a(?:ny)?$/i) {
		return;
	    }
	    if ($vtor2=~/^b(?:oolean)?$/i) {
		if ( $_[1] eq '1' or
		     $_[1]=~/^y(?:es)?$/i or
		     $_[1]=~/^t(?:rue)?$/i) {
		    $_[1]=1;
		    return;
		}
		if ( $_[1] eq '' or
		     $_[1] eq '0' or
		     $_[1]=~/^no?$/i or
		     $_[1]=~/^f(?:alse)?$/i) {
		    $_[1]=0;
		    return;
		}
		$this->fail("property '$_[0]' value '$_[1]' is not allowed: boolean expected");
	    }
	    if ($vtor2=~/^u(?:nsigned)?$/i) {
		if ($_[1]=~/^\d+$/) {
		    $_[1]=int $_[1];
		    return;
		}
		$this->fail("property '$_[0]' value '$_[1]' is not allowed: unsigned integer expected");
	    }
	    if ($vtor2=~/^i(?:nteger)?$/i) {
		if ($_[1]=~/^[+\-]?\d+$/) {
		    $_[1]=int $_[1];
		    return;
		}
		$this->fail("property '$_[0]' value '$_[1]' is not allowed: integer expected");
	    }
	    if ($vtor2=~/^f(?:loat)?$/i or $vtor2=~/^n(?:umber)?$/i) {
		if ($_[1]=~/^[+-]?(?:\d+|\d*\.\d+|\d+\.\d*)(?:[eE][+-]?\d+)?$/) {
		    $_[1]=$_[1]+0;
		    return;
		}
		$this->fail("property '$_[0]' value '$_[1]' is not allowed: number expected");
	    }

	    croak "invalid object '$vtor2' for validate";
	}
	else {
	    croak "invalid object '$vtor' for validate";
	}
    }
}

1;
__END__