aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--MANIFEST1
-rw-r--r--beam.conf43
-rw-r--r--lib/App/Beam.pm102
-rw-r--r--lib/App/Beam/Backup.pm14
-rw-r--r--lib/App/Beam/Config.pm173
-rw-r--r--lib/App/Beam/Config/Locus.pm197
-rw-r--r--t/TestConfig.pm28
-rw-r--r--t/conf01l.t20
-rw-r--r--t/conf02l.t45
-rw-r--r--t/conf03l.t32
-rw-r--r--t/conf04l.t40
-rw-r--r--t/conf05l.t30
-rw-r--r--t/locus.t34
13 files changed, 693 insertions, 66 deletions
diff --git a/MANIFEST b/MANIFEST
index df0071f..ea27ac0 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4,6 +4,7 @@ MANIFEST
Makefile.PL
README
lib/App/Beam/Config.pm
+lib/App/Beam/Config/Locus.pm
lib/App/Beam.pm
t/TestConfig.pm
t/conf01.t
diff --git a/beam.conf b/beam.conf
index c2587ff..af3a047 100644
--- a/beam.conf
+++ b/beam.conf
@@ -1,9 +1,13 @@
[core]
# Location of the state file
- statfile = /var/spool/beam/beam.state
+# statfile = /var/spool/beam/beam.state
+ statfile = /tmp/beam.state
# Directory for temporary files
tempdir = /tmp
-
+ #
+ archivedir = /var/backups
+# items = databases
+
# Configure logging
[logger]
# Declare the channel. Valid values are: "file" and "syslog"
@@ -42,3 +46,38 @@
# Retain this number of completed rounds.
retain = 8
+[backend tar]
+ # Any additional options to pass to tar. Do not place tar operation
+ # switches (as -c, -t, etc.) here! These will be added automatically
+ # by appropriate scripts, depending on the operation being performed.
+ #
+ # By default this variable is empty (no additional options).
+ #
+ options = -j
+
+ # Suffix for archive files.
+ # Default is "tar"
+ #
+ suffix = tar.bz2
+
+ # Directory where to store snapshot files. The files will be named as
+ # their archive counterparts, with the suffix ".db".
+ #
+ # This variable must be set
+ snapshot-dir = /var/lib/backups
+
+[item system]
+ backend = tar
+ directory = /
+ file = etc var/spool/cron
+
+[item databases]
+# backend = mysql
+ databases = a b c
+ individual = On
+
+[item www]
+ backend = tar
+ directory = /var/www
+
+
diff --git a/lib/App/Beam.pm b/lib/App/Beam.pm
index 82d8f97..ff4f414 100644
--- a/lib/App/Beam.pm
+++ b/lib/App/Beam.pm
@@ -93,6 +93,27 @@ my %parameters = (
section => {
statfile => { default => '/var/spool/beam/beam.state' },
tempdir => { default => '/tmp' },
+ archivedir => { default => '/var/backups' },
+ items => 1
+ }
+ },
+ backend => {
+ section => {
+ '*' => {
+ section => {
+ '*' => 1
+ }
+ }
+ }
+ },
+ item => {
+ section => {
+ '*' => {
+ section => {
+ backend => { mandatory => 1 },
+ '*' => 1
+ }
+ }
}
}
);
@@ -121,11 +142,13 @@ sub new {
$_{parameters} = \%parameters;
# $_{debug} = sub { print "D @_\n"; };
+ $_{locations} = 1;
my $self = $class->SUPER::new($filename, %_);
$self->{progname} = $progname;
$self->{dry_run} = $dry_run;
+ $self->{debug}++ if $dry_run;
return $self;
}
@@ -167,11 +190,10 @@ sub logfmt {
$self->logger($prio, sprintf($fmt, @_));
}
-sub logger {
- my $self = shift;
- my $prio = shift;
- my $msg = join(' ', map { my $a = $_; $a =~ s/\n/\\n/g; $a } @_);
-
+sub logger_line {
+ my ($self, $prio, $msg) = @_;
+ chomp $msg;
+
if ($self->get('logger.channel') eq 'syslog') {
syslog($prio, $msg);
} else {
@@ -181,8 +203,22 @@ sub logger {
}
}
+sub logger {
+ my $self = shift;
+ my $prio = shift;
+ my @msg = split(/\n/, join(' ', @_));
+ $self->logger_line($prio, shift @msg);
+ for (@msg) {
+ $self->logger_line($prio, " $_");
+ }
+}
+
sub error {
- my ($self, $err) = @_;
+ my $self = shift;
+ my $err = shift;
+ local %_ = @_;
+
+ $err = $_{locus}->format($err) if exists($_{locus});
$self->logger('err', $err);
}
@@ -239,6 +275,55 @@ sub status {
return $ret;
}
+sub load_backends {
+ my $self = shift;
+ $self->abend(EX_CONFIG, "no items defined")
+ unless $self->isset('item');
+ $self->set('core.items', join(' ', $self->names_of('item')))
+ unless $self->isset('core.items');
+ my $err;
+ my %h;
+ foreach my $be (map {
+ $_->[1]
+ }
+ sort {
+ if ($a->[0] == $b->[0]) {
+ $a->[1] cmp $b->[1]
+ } else {
+ $a->[0] <=> $b->[0]
+ }
+ }
+ map {
+ if ($self->isset("item.$_")) {
+ my $backend = $self->get("item.$_.backend");
+ print "V $_ $backend\n";
+ if (exists($h{$backend})) {
+ ();
+ } else {
+ $h{$backend} = 1;
+ [ $self->isset("backend.$backend.order")
+ ? $self->get("backend.$backend.order")
+ : 0,
+ $backend ];
+ }
+ } else {
+ $self->error("item $_ not defined");
+ $err = 1;
+ ();
+ }
+ } split(/\s+/, $self->get('core.items'))) {
+ my $pack = "App::Beam::Backend::" . ucfirst($be);
+ $self->debug(1, "loading $pack");
+ my $cfg = $self->get("backend.$be");
+ my $obj = eval "use $pack; new $pack(\$cfg);";
+ if ($@) {
+ $self->logger('crit', $@);
+ ++$err;
+ }
+ }
+ exit(EX_UNAVAILABLE) if $err;
+}
+
sub begin {
my $self = shift;
exit(EX_CONFIG) unless $self->parse();
@@ -259,10 +344,13 @@ sub begin {
exit(EX_CANTCREAT);
};
}
- if (!exists($self->{debug}) && defined(my $v = $self->get('logger.debug'))) {
+ if (!exists($self->{debug})
+ && defined(my $v = $self->get('logger.debug'))) {
$self->{debug} = $v;
}
+
$self->logger('info', 'startup');
+ $self->load_backends;
}
sub end {
diff --git a/lib/App/Beam/Backup.pm b/lib/App/Beam/Backup.pm
index d6c30a5..8f8c07b 100644
--- a/lib/App/Beam/Backup.pm
+++ b/lib/App/Beam/Backup.pm
@@ -8,11 +8,13 @@ our @ISA = qw(App::Beam);
sub run {
my $self = shift;
- $self->lock();
use Data::Dumper;
- print Dumper([$self->{status}]);
- $self->status('round', $self->status('round') + 1);
- $self->status('timestamp', time());
- $self->unlock();
-# print Dumper([$self->{conf}]);
+ # $self->lock();
+ # print Dumper([$self->{status}]);
+ # $self->status('round', $self->status('round') + 1);
+ # $self->status('timestamp', time());
+ # $self->unlock();
+ $self->set('a.b.c.d.e', 110);
+ print Dumper([$self->{conf}]);
+ print $self->get('logger.file.timestamp')."\n";
}
diff --git a/lib/App/Beam/Config.pm b/lib/App/Beam/Config.pm
index 46624bb..f2bf2d8 100644
--- a/lib/App/Beam/Config.pm
+++ b/lib/App/Beam/Config.pm
@@ -20,6 +20,7 @@ use strict;
use Carp;
use File::stat;
use Storable qw(retrieve store);
+use App::Beam::Config::Locus;
use Data::Dumper;
require Exporter;
@@ -28,7 +29,10 @@ our @ISA = qw(Exporter);
our $VERSION = "1.00";
sub error {
- my ($self, $err) = @_;
+ my $self = shift;
+ my $err = shift;
+ local %_ = @_;
+ $err = $_{locus}->format($err) if exists $_{locus};
print STDERR "$err\n";
}
@@ -54,6 +58,10 @@ sub new {
if (defined($v = delete $_{ci})) {
$self->{ci} = $v;
}
+
+ if (defined($v = delete $_{locations})) {
+ $self->{locations} = $v;
+ }
if (defined($v = delete $_{parameters})) {
if (ref($v) eq 'HASH') {
@@ -143,7 +151,7 @@ sub parse_section {
$rootname = $name unless defined $rootname;
$ref->{$name} = {} unless ref($ref->{$name}) eq 'HASH';
$ref = $ref->{$name};
-
+
if (defined($kw)
and ref($kw) eq 'HASH' and exists($kw->{$name}{section})) {
$kw = $kw->{$name}{section};
@@ -165,20 +173,37 @@ sub check_mandatory {
while (my ($k, $d) = each %{$kw}) {
if (ref($d) eq 'HASH') {
if ($d->{mandatory} && !exists($section->{$k})) {
+ $loc = $section->{-locus} if exists($section->{-locus});
if (exists($d->{section})) {
- $self->error("$loc: mandatory section ["
+ $self->error("mandatory section ["
. join(' ', @_, $k)
- . "] not present");
+ . "] not present",
+ locus => $loc);
++$err;
} else {
- $self->error("$loc: mandatory variable \""
+ $self->error("mandatory variable \""
. join('.', @_, $k)
- . "\" not set");
+ . "\" not set",
+ locus => $loc);
++$err;
}
}
- if (exists($d->{section}) && exists($section->{$k})) {
- $err += $self->check_mandatory($d->{section}, $section->{$k}, $loc, @_, $k);
+ if (exists($d->{section})) {
+ if ($k eq '*') {
+ while (my ($name, $vref) = each %{$section}) {
+ if (is_section_ref($vref)) {
+ $err += $self->check_mandatory($d->{section},
+ $vref,
+ $loc,
+ @_, $name);
+ }
+ }
+ } elsif (exists($section->{$k})) {
+ $err += $self->check_mandatory($d->{section},
+ $section->{$k},
+ $loc,
+ @_, $k);
+ }
}
}
}
@@ -218,7 +243,7 @@ sub readconfig {
s/\s+$//;
s/#.*//;
next if ($_ eq "");
-
+
if (/^\[(.+?)\]$/) {
$include = 0;
my $arg = $1;
@@ -228,8 +253,14 @@ sub readconfig {
$include = 1;
} else {
($section, $rootname, $kw) = $self->parse_section($conf, $1);
- $self->error("$file:$line: unknown section")
+ $self->error("unknown section",
+ locus => new App::Beam::Config::Locus($file, $line))
if (exists($self->{parameters}) and !defined($kw));
+ if ($self->{locations}) {
+ $section->{-locus} =
+ new App::Beam::Config::Locus($file, $line)
+ unless exists $section->{-locus};
+ }
}
} elsif (/([\w_-]+)\s*=\s*(.*)/) {
my ($k, $v) = ($1, $2);
@@ -246,7 +277,8 @@ sub readconfig {
$err += $self->readconfig($file, $conf, include => 1);
}
} else {
- $self->error("$file:$line: keyword \"$k\" is unknown");
+ $self->error("keyword \"$k\" is unknown",
+ locus => new App::Beam::Config::Locus($file, $line));
++$err;
}
next;
@@ -256,16 +288,23 @@ sub readconfig {
my $x = $kw->{$k};
$x = $kw->{'*'} unless defined $x;
if (!defined($x)) {
- $self->error("$file:$line: keyword \"$k\" is unknown");
+ $self->error("keyword \"$k\" is unknown",
+ locus => new App::Beam::Config::Locus($file, $line));
++$err;
next;
} elsif (ref($x) eq 'HASH') {
my $errstr;
- my $prev_val = $section->{$k} if exists $section->{$k};
-
+ my $prev_val;
+ if (exists($section->{$k})) {
+ $prev_val = $section->{$k};
+ $prev_val = $prev_val->{-value}
+ if ref($prev_val) eq 'HASH'
+ && exists($prev_val->{-value});
+ }
if (exists($x->{re})) {
if ($v !~ /$x->{re}/) {
- $self->error("$file:$line: invalid value for $k");
+ $self->error("invalid value for $k",
+ locus => new App::Beam::Config::Locus($file, $line));
++$err;
next;
}
@@ -273,7 +312,8 @@ sub readconfig {
if (exists($x->{check})) {
if (defined($errstr = &{$x->{check}}(\$v, $prev_val))) {
- $self->error("$file:$line: $errstr");
+ $self->error($errstr,
+ locus => new App::Beam::Config::Locus($file, $line));
++$err;
next;
}
@@ -288,16 +328,27 @@ sub readconfig {
}
}
}
-
- $section->{$k} = $v;
+ if ($self->{locations}) {
+ $section->{-locus}->add($file, $line);
+ unless (exists($section->{$k})) {
+ $section->{$k}{-locus} =
+ new App::Beam::Config::Locus();
+ }
+ $section->{$k}{-locus}->add($file, $line);
+ $section->{$k}{-value} = $v;
+ } else {
+ $section->{$k} = $v;
+ }
} else {
- $self->error("$file:$line: malformed line");
+ $self->error("malformed line",
+ locus => new App::Beam::Config::Locus($file, $line));
++$err;
next;
}
}
close $fd;
- $err += $self->check_mandatory($self->{parameters}, $conf, "$file:$line")
+ $err += $self->check_mandatory($self->{parameters}, $conf,
+ new App::Beam::Config::Locus($file, $line))
unless $_{include};
return $err;
}
@@ -353,7 +404,7 @@ sub parse {
return !$err;
}
-sub get {
+sub getref {
my $self = shift;
return undef unless exists $self->{conf};
@@ -365,21 +416,66 @@ sub get {
return $ref;
}
+# 1. get('foo', 'bar', 'baz')
+# Returns the value of the variable foo.bar.baz
+# 2. get({ variable => [ 'foo', 'bar', 'baz' ], return => 'value' })
+# Ditto.
+# 3. get({ variable => [ 'foo', 'bar', 'baz' ], return => 'locus' })
+# Returns location of the foo.bar.baz definition.
+# 4. get({ variable => [ 'foo', 'bar', 'baz' ], return => 'all' })
+# or get({ variable => [ 'foo', 'bar', 'baz' ] })
+# Returns both as { value => X, locus => Y }
+sub get {
+ my $self = shift;
+ croak "no variable to get" unless @_;
+ my $ref;
+ my $ctl;
+ if (ref($_[0]) eq 'HASH') {
+ $ctl = shift;
+ croak "too many arguments" if @_;
+ croak "no variable to get" unless exists $ctl->{variable};
+ $ref = $self->getref(@{$ctl->{variable}});
+ if (defined($ref)
+ && exists($ctl->{return})
+ && $ctl->{return} ne 'all') {
+ if (exists($ref->{$ctl->{return}})) {
+ $ref = $ref->{$ctl->{return}};
+ } else {
+ $ref = undef;
+ }
+ } elsif (!exists($ref->{-value})) {
+ $ref = { '-value' => $ref };
+ }
+ } else {
+ $ref = $self->getref(@_);
+ if (defined($ref) && ref($ref) eq 'HASH' && exists($ref->{-value})) {
+ $ref = $ref->{-value};
+ }
+ }
+ return $ref;
+}
+
sub isset {
my $self = shift;
- return defined $self->get(@_);
+ return defined $self->getref(@_);
+}
+
+sub is_section_ref {
+ my ($ref) = @_;
+ return ref($ref) eq 'HASH'
+ && !exists($ref->{-value});
}
sub issection {
my $self = shift;
- my $ref = $self->get(@_);
- return defined($ref) and ref($ref) eq 'HASH';
+ my $ref = $self->getref(@_);
+ return defined($ref) && is_section_ref($ref);
}
sub isscalar {
my $self = shift;
- my $ref = $self->get(@_);
- return defined($ref) and ref($ref) ne 'HASH';
+ my $ref = $self->getref(@_);
+ return defined($ref) && !is_section_ref($ref);
}
sub set {
@@ -392,7 +488,11 @@ sub set {
$ref->{$arg} = {} unless exists $ref->{$arg};
$ref = $ref->{$arg};
}
- $ref->{$_[0]} = $_[1];
+ if ($self->{locations}) {
+ $ref->{$_[0]}{-value} = $_[1];
+ } else {
+ $ref->{$_[0]} = $_[1];
+ }
$self->{updated} = $self->{rw};
}
@@ -416,6 +516,13 @@ sub unset {
$self->{updated} = $self->{rw};
}
+sub names_of {
+ my $self = shift;
+ my $ref = $self->getref(@_);
+ return () if !defined($ref) || ref($ref) ne 'HASH';
+ return map { /^-/ ? () : $_ } keys %{$ref};
+}
+
#sub each {
# my $self = shift;
# return @{[ each %{$self->{conf}} ]};
@@ -427,10 +534,14 @@ sub _foreach {
foreach my $k (defined($sort) ? sort $sort @keys : @keys) {
my $v = $aref->{$k};
if (ref($v) eq 'HASH') {
- push @{$domain}, $k;
- $self->_foreach($domain, $v, $cb, $sort);
- pop @{$domain};
- } else {
+ if (exists($v->{-value})) {
+ &{$cb}($k, $v->{-value}, @{$domain});
+ } else {
+ push @{$domain}, $k;
+ $self->_foreach($domain, $v, $cb, $sort);
+ pop @{$domain};
+ }
+ } elsif ($k !~ /^-/) {
&{$cb}($k, $v, @{$domain});
}
}
diff --git a/lib/App/Beam/Config/Locus.pm b/lib/App/Beam/Config/Locus.pm
new file mode 100644
index 0000000..050e5bb
--- /dev/null
+++ b/lib/App/Beam/Config/Locus.pm
@@ -0,0 +1,197 @@
+package App::Beam::Config::Locus;
+
+use strict;
+use Carp;
+
+require Exporter;
+our @ISA = qw(Exporter);
+
+=head1 NAME
+
+App::Beam::Config::Locus - source file location
+
+=head1 SYNOPSIS
+
+use App::Beam::Config::Locus;
+
+$locus = new App::Beam::Config::Locus;
+
+$locus = new App::Beam::Config::Locus($file, $line);
+
+$locus->add($file, $line);
+
+$s = $locus->format;
+
+$locus->fixup_names('old' => 'new');
+
+$locus->fixup_lines();
+
+=head1 DESCRIPTION
+
+Provides support for manipulating source file locations.
+
+=head2 $locus = new App::Beam::Config::Locus($file, $line);
+
+Creates a new locus object. Arguments are optional: either no arguments
+should be given, or both of them. If given, they indicate the source
+file name and line number this locus is to represent.
+
+=cut
+
+sub new {
+ my $class = shift;
+
+ my $self = bless { table => {}, order => 0 }, $class;
+
+ $self->add(@_) if $#_ == 1;
+
+ return $self;
+}
+
+=head2 $locus->add($file, $line);
+
+Adds new location to the locus. Use this for statements spanning several
+lines and/or files.
+
+=cut
+
+sub add {
+ my ($self, $file, $line) = @_;
+ unless (exists($self->{table}{$file})) {
+ $self->{table}{$file}{order} = $self->{order}++;
+ $self->{table}{$file}{lines} = [];
+ }
+ push @{$self->{table}{$file}{lines}}, $line;
+ delete $self->{string};
+}
+
+=head2 $s = $locus->format($msg);
+
+Returns a string representation of the locus. The argument is optional.
+If given, its string representation will be concatenated to the formatted
+locus with a ": " in between. This is useful for formatting error messages.
+
+If the locus contains multiple file locations, the method tries to compact
+them by representing contiguous line ranges as B<I<X>-I<Y>> and outputting
+each file name once. Line ranges are separated by commas. File locations
+are separated by semicolons. E.g.:
+
+ $locus = new App::Beam::Config::Locus("foo", 1);
+ $locus->add("foo", 2);
+ $locus->add("foo", 3);
+ $locus->add("foo", 5);
+ $locus->add("bar", 2);
+ $locus->add("bar", 7);
+ print $locus->format("here it goes");
+
+will produce the following:
+
+ foo:1-3,5;bar:2,7: here it goes
+
+=cut
+
+sub format {
+ my $self = shift;
+ unless (exists($self->{string})) {
+ foreach my $file (sort {
+ $self->{table}{$a}{order} <=> $self->{table}{$b}{order}
+ }
+ keys %{$self->{table}}) {
+ my @lines = @{$self->{table}{$file}{lines}};
+ $self->{string} .= ';' if $self->{string};
+ $self->{string} .= "$file:";
+ my $beg = shift @lines;
+ my $end = $beg;
+ my @ranges;
+ foreach my $line (@lines) {
+ if ($line == $end + 1) {
+ $end = $line;
+ } else {
+ if ($end > $beg) {
+ push @ranges, "$beg-$end";
+ } else {
+ push @ranges, $beg;
+ }
+ $beg = $end = $line;
+ }
+ }
+
+ if ($end > $beg) {
+ push @ranges, "$beg-$end";
+ } else {
+ push @ranges, $beg;
+ }
+ $self->{string} .= join(',', @ranges);
+ }
+ }
+ return "$self->{string}: $_[0]" if @_;
+ return $self->{string};
+}
+
+=head2 $locus->fixup_names('foo' => 'bar', 'baz' => 'quux');
+
+Replaces file names in the locations according to the arguments.
+
+=cut
+
+sub fixup_names {
+ my $self = shift;
+ local %_ = @_;
+ while (my ($oldname, $newname) = each %_) {
+ next unless exists $self->{table}{$oldname};
+ croak "target name already exist" if exists $self->{table}{$newname};
+ $self->{table}{$newname} = delete $self->{table}{$oldname};
+ }
+ delete $self->{string};
+}
+
+=head2 $locus->fixup_lines('foo' => 1, 'baz' => -2);
+
+Offsets line numbers for each named file by the given number of lines. E.g.:
+
+ $locus = new App::Beam::Config::Locus("foo", 1);
+ $locus->add("foo", 2);
+ $locus->add("foo", 3);
+ $locus->add("bar", 3);
+ $locus->fixup_lines(foo => 1. bar => -1);
+ print $locus->format;
+
+will produce
+
+ foo:2-4,bar:2
+
+If given a single argument, the operation will affect all locations. E.g.,
+adding the following to the example above:
+
+ $locus->fixup_lines(10);
+ print $locus->format;
+
+will produce
+
+ foo:22-24;bar:22
+
+=cut
+
+sub fixup_lines {
+ my $self = shift;
+ return unless @_;
+ if ($#_ == 0) {
+ my $offset = shift;
+ while (my ($file, $ref) = each %{$self->{table}}) {
+ $ref->{lines} = [map { $_ + $offset } @{$ref->{lines}}];
+ }
+ } elsif ($#_ % 2) {
+ local %_ = @_;
+ while (my ($file, $offset) = each %_) {
+ if (exists($self->{table}{$file})) {
+ $self->{table}{$file}{lines} =
+ [map { $_ + $offset }
+ @{$self->{table}{$file}{lines}}];
+ }
+ }
+ } else {
+ croak "bad number of arguments";
+ }
+ delete $self->{string};
+}
+
diff --git a/t/TestConfig.pm b/t/TestConfig.pm
index ef5ce1d..daafe56 100644
--- a/t/TestConfig.pm
+++ b/t/TestConfig.pm
@@ -69,26 +69,14 @@ sub expected_error {
}
sub error {
- my ($self, $err) = @_;
- if ($err =~ /^(.+?):(.+?): (.+)/) {
- unless (exists($self->{first_line})) {
- if (open(my $fd, '<', $0)) {
- $self->{first_line} = 0;
- while (<$fd>) {
- $self->{first_line}++;
- chomp;
- last if /^__DATA__$/;
- }
- close $fd;
- }
- }
- my $line = $2 + $self->{first_line};
- push @{$self->{errors}}, { file => $0,
- orig => $1,
- line => $line,
- message => $3 };
- print STDERR "$0:$line: $3\n"
- unless $self->expected_error($3);
+ my $self = shift;
+ my $err = shift;
+ local %_ = @_;
+
+ if (exists($_{locus})) {
+ push @{$self->{errors}}, { message => $err };
+ print STDERR $_{locus}->format($err)."\n"
+ unless $self->expected_error($err);
} else {
push @{$self->{errors}}, { message => $err };
print STDERR "$err\n"
diff --git a/t/conf01l.t b/t/conf01l.t
new file mode 100644
index 0000000..0436df0
--- /dev/null
+++ b/t/conf01l.t
@@ -0,0 +1,20 @@
+# -*- perl -*-
+use lib 't';
+use strict;
+use Test;
+use TestConfig;
+
+plan(tests => 1);
+
+my $cfg = new TestConfig(locations => 1);
+ok($cfg->canonical, 'backend.foo.file="a" core.retain-interval=10 core.tempdir="/tmp"');
+
+__DATA__
+# This is a sample configuration file
+[core]
+ retain-interval = 10
+ tempdir = /tmp
+[backend foo]
+ file = a
+
+
diff --git a/t/conf02l.t b/t/conf02l.t
new file mode 100644
index 0000000..c57b0ae
--- /dev/null
+++ b/t/conf02l.t
@@ -0,0 +1,45 @@
+# -*- perl -*-
+use lib 't';
+use strict;
+use Test;
+use TestConfig;
+
+plan(tests => 7);
+
+my %keywords = (
+ core => {
+ section => {
+ 'retain-interval' => { mandatory => 1 },
+ 'tempdir' => 1,
+ 'verbose' => 1,
+ }
+ },
+ backend => {
+ section => {
+ file => 1
+ }
+ }
+);
+
+my $cfg = new TestConfig(parameters => \%keywords, locations => 1);
+ok($cfg->isset('backend','foo','file'));
+ok($cfg->isscalar('backend','foo','file'));
+ok($cfg->get('backend','foo','file'), 'foo');
+
+ok($cfg->isset('core', 'verbose') == 0);
+
+ok($cfg->issection('backend','foo'));
+
+$cfg->set('core','verbose','On');
+ok($cfg->get('core','verbose'),'On');
+
+$cfg->unset('core','tmpdir');
+ok($cfg->isset('core','tmpdir') == 0);
+
+__DATA__
+# This is a sample configuration file
+[core]
+ retain-interval = 10
+ tempdir = /tmp
+[backend foo]
+ file = foo
diff --git a/t/conf03l.t b/t/conf03l.t
new file mode 100644
index 0000000..ff14596
--- /dev/null
+++ b/t/conf03l.t
@@ -0,0 +1,32 @@
+# -*- perl -*-
+
+use lib 't';
+use strict;
+use Test;
+use TestConfig;
+
+plan(tests => 1);
+
+my %keywords = (
+ core => {
+ section => {
+ 'tempdir' => 1,
+ 'verbose' => 1,
+ }
+ },
+ backend => {
+ section => {
+ file => 1
+ }
+ }
+);
+my $cfg = new TestConfig(parameters => \%keywords,
+ locations => 1,
+ expect => [ 'keyword "output" is unknown' ]);
+ok($cfg->errors() == 1);
+__DATA__
+# This is a sample configuration file
+[core]
+ tempdir = /tmp
+ output = file
+
diff --git a/t/conf04l.t b/t/conf04l.t
new file mode 100644
index 0000000..1ea5477
--- /dev/null
+++ b/t/conf04l.t
@@ -0,0 +1,40 @@
+# -*- perl -*-
+use lib 't';
+use strict;
+use Test;
+use TestConfig;
+
+plan(tests => 1);
+
+my %keywords = (
+ core => {
+ section => {
+ 'retain-interval' => { mandatory => 1 },
+ 'tempdir' => 1,
+ 'verbose' => 1,
+ }
+ },
+ backend => {
+ section => {
+ file => {
+ section => {
+ name => { mandatory => 1 },
+ local => 1
+ }
+ }
+ }
+ }
+);
+
+my $cfg = new TestConfig(parameters => \%keywords,
+ locations => 1,
+ expect => [ 'mandatory variable "core.retain-interval" not set',
+ 'mandatory variable "backend.file.name" not set' ]);
+ok($cfg->errors()==2);
+
+__DATA__
+# This is a sample configuration file
+[core]
+ tempdir = /tmp
+[backend file]
+ local = 1
diff --git a/t/conf05l.t b/t/conf05l.t
new file mode 100644
index 0000000..11f9cb1
--- /dev/null
+++ b/t/conf05l.t
@@ -0,0 +1,30 @@
+# -*- perl -*-
+use lib 't';
+use strict;
+use Test;
+use TestConfig;
+
+plan(tests => 1);
+
+my %keywords = (
+ core => {
+ section => {
+ list => {
+ array => 1
+ },
+ pidfile => 1
+ }
+ }
+);
+
+my $cfg = new TestConfig(parameters => \%keywords, locations => 1);
+ok($cfg->canonical(),'core.list=["en","to",5] core.pidfile="file2"');
+
+__END__
+[core]
+ list = en
+ list = to
+ list = 5
+
+ pidfile = file1
+ pidfile = file2
diff --git a/t/locus.t b/t/locus.t
new file mode 100644
index 0000000..a08280b
--- /dev/null
+++ b/t/locus.t
@@ -0,0 +1,34 @@
+# -*- perl -*-
+use strict;
+use Test;
+use App::Beam::Config::Locus;
+
+plan(tests => 7);
+
+my $loc = new App::Beam::Config::Locus;
+$loc->add('foo', 10);
+ok($loc->format, "foo:10");
+
+$loc->add('foo', 11);
+$loc->add('foo', 12);
+$loc->add('foo', 13);
+ok($loc->format, "foo:10-13");
+
+$loc->add('foo', 24);
+$loc->add('foo', 28);
+ok($loc->format, "foo:10-13,24,28");
+
+$loc->add('bar', 1);
+$loc->add('baz', 8);
+$loc->add('baz', 9);
+$loc->add('bar', 5);
+ok($loc->format, "foo:10-13,24,28;bar:1,5;baz:8-9");
+
+$loc->fixup_names('foo' => 'Foo', 'bar' => 'BAR');
+ok($loc->format, "Foo:10-13,24,28;BAR:1,5;baz:8-9");
+
+$loc->fixup_lines('Foo' => -1, 'baz' => 2);
+ok($loc->format, "Foo:9-12,23,27;BAR:1,5;baz:10-11");
+
+$loc->fixup_lines(3);
+ok($loc->format, "Foo:12-15,26,30;BAR:4,8;baz:13-14");

Return to:

Send suggestions and report system problems to the System administrator.

Generated by cgit.