--- cfg.pm 2004/11/20 16:51:52 1.6
+++ cfg.pm 2004/11/20 17:09:35 1.7
@@ -326,5 +326,187 @@
# static-loading functions
XSLoader::load('OSSP::cfg', $VERSION);
+##
+## Highest-Level Perl Convenience API
+## (based on OSSP::cfg Perl API above)
+##
+
+package OSSP::cfg::simple;
+
+use 5.008;
+use strict;
+use warnings;
+use Carp;
+use IO::File;
+
+# object constructor
+sub new ($;$) {
+ my ($proto, $input) = @_;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless ($self, $class);
+ $self->{-cfg} = new OSSP::cfg
+ or croak "failed to create OSSP::cfg object";
+ $self->parse($input) if (defined($input));
+ return $self;
+}
+
+# object destructor
+sub DESTROY ($) {
+ my ($self) = @_;
+ undef $self->{-cfg};
+ return;
+}
+
+# parse textual syntax into node tree
+sub parse ($$) {
+ my ($self, $input) = @_;
+ my $cfg = $self->{-cfg};
+ if (length($input) < 1024 and $input !~ m|[{}&\n\s]|s) {
+ if (-f $input) {
+ my $io = new IO::File "<" . $input
+ or croak "unable to read from configuration file \"".$input."\"";
+ { local $/; $input = <$io>; }
+ $io->close();
+ }
+ }
+ $cfg->import(\0, $cfg->CFG_FMT_CFG, $input)
+ or die "failed to parse configuration: " . $cfg->error();
+ return $self;
+}
+
+# format textual syntax from node tree
+sub format ($$) {
+ my ($self) = @_;
+ my $cfg = $self->{-cfg};
+ my $root = $cfg->node_root();
+ my $str = $cfg->export($root, $cfg->CFG_FMT_CFG)
+ or die "failed to format configuration: " . $cfg->error();
+ return $str;
+}
+
+# pack Perl complex data structure into node tree
+sub pack ($$) {
+ my ($self, $tree) = @_;
+
+ # destroy old and create new OSSP::cfg object
+ undef $self->{-cfg};
+ my $cfg = new OSSP::cfg
+ or croak "failed to create OSSP::cfg object";
+ $self->{-cfg} = $cfg;
+
+ # start parsing with a sequence
+ my $node = &parse_seq($cfg, $tree);
+
+ # parse a sequence (reference) scalar
+ sub parse_seq {
+ my ($cfg, $seq) = @_;
+ my $node = undef;
+ if (ref($seq) eq 'ARRAY') {
+ $node = $cfg->node_create();
+ $cfg->node_set($node, $cfg->CFG_NODE_ATTR_TYPE, $cfg->CFG_NODE_TYPE_SEQ);
+ if (@{$seq} > 0) {
+ my $child = &parse_dir($cfg, $seq->[0]);
+ $cfg->node_set($node, $cfg->CFG_NODE_ATTR_CHILD1, $child);
+ my $sibling = $child;
+ foreach my $dir (@{$seq}[1..$#{$seq}]) {
+ $child = &parse_dir($cfg, $dir);
+ $cfg->node_set($sibling, $cfg->CFG_NODE_ATTR_RBROTH, $child);
+ $sibling = $child;
+ }
+ }
+ }
+ return $node;
+ }
+
+ # parse a directive (reference) scalar
+ sub parse_dir {
+ my ($cfg, $dir) = @_;
+ my $node = undef;
+ if (ref($dir) eq 'ARRAY') {
+ $node = $cfg->node_create();
+ $cfg->node_set($node, $cfg->CFG_NODE_ATTR_TYPE, $cfg->CFG_NODE_TYPE_DIR);
+ if (@{$dir} > 0) {
+ my $child = &parse_tok($cfg, $dir->[0]);
+ $cfg->node_set($node, $cfg->CFG_NODE_ATTR_CHILD1, $child);
+ my $sibling = $child;
+ foreach my $tok (@{$dir}[1..$#{$dir}]) {
+ $child = &parse_tok($cfg, $tok);
+ $cfg->node_set($sibling, $cfg->CFG_NODE_ATTR_RBROTH, $child);
+ $sibling = $child;
+ }
+ }
+ }
+ return $node;
+ }
+
+ # parse a token scalar
+ sub parse_tok {
+ my ($cfg, $tok) = @_;
+ my $node;
+ if (ref($tok) eq 'ARRAY') {
+ # token is actually a sub-sequence
+ $node = &parse_seq($cfg, $tok); # recursion
+ }
+ else {
+ # token is a plain one
+ $node = $cfg->node_create();
+ $cfg->node_set($node, $cfg->CFG_NODE_ATTR_TYPE, $cfg->CFG_NODE_TYPE_ARG);
+ $cfg->node_set($node, $cfg->CFG_NODE_ATTR_TOKEN, $tok);
+ }
+ return $node;
+ }
+
+ # set generated node tree into OSSP::cfg object
+ $cfg->node_root($node);
+
+ return $self;
+}
+
+# unpack Perl complex data structure from node tree
+sub unpack ($) {
+ my ($self) = @_;
+ my $cfg = $self->{-cfg};
+
+ # start traversing the node tree from the root node
+ my $root = $cfg->node_root();
+ my $tree = &traverse($cfg, $root);
+
+ # node processing function
+ sub traverse {
+ my ($cfg, $node) = @_;
+ return if (not(ref($node) and $$node != 0));
+ my $type = $cfg->node_get($node, $cfg->CFG_NODE_ATTR_TYPE);
+ if ($type == $cfg->CFG_NODE_TYPE_SEQ) {
+ # node is a sequence
+ my $seq = [];
+ $node = $cfg->node_get($node, $cfg->CFG_NODE_ATTR_CHILD1);
+ while (ref($node) and $$node != 0) {
+ my $tree = &traverse($cfg, $node); # recursion
+ push(@{$seq}, $tree) if (defined($tree));
+ $node = $cfg->node_get($node, $cfg->CFG_NODE_ATTR_RBROTH);
+ }
+ return $seq;
+ }
+ elsif ($type == $cfg->CFG_NODE_TYPE_DIR) {
+ # node is a directive
+ my $dir = [];
+ $node = $cfg->node_get($node, $cfg->CFG_NODE_ATTR_CHILD1);
+ while (ref($node) and $$node != 0) {
+ my $tree = &traverse($cfg, $node); # recursion
+ push(@{$dir}, $tree) if (defined($tree));
+ $node = $cfg->node_get($node, $cfg->CFG_NODE_ATTR_RBROTH);
+ }
+ return $dir;
+ }
+ else {
+ # node is a token
+ my $token = $cfg->node_get($node, $cfg->CFG_NODE_ATTR_TOKEN);
+ return $token;
+ }
+ }
+ return $tree;
+}
+
1;
|
