head	1.17;
access;
symbols
	FSL_1_7_0:1.17
	CFG_0_9_11:1.17
	FSL_1_6_1:1.15
	CFG_0_9_10:1.15
	FSL_1_6_0:1.14
	FSL_1_6b2:1.14
	CFG_0_9_9:1.14
	FSL_1_6b1:1.13
	CFG_0_9_8:1.13
	CFG_0_9_7:1.11
	CFG_0_9_6:1.10
	CFG_0_9_5:1.9;
locks; strict;
comment	@# @;


1.17
date	2006.08.10.19.36.00;	author rse;	state Exp;
branches;
next	1.16;
commitid	Isy241gp4yykKkIr;

1.16
date	2006.08.10.19.32.57;	author rse;	state Exp;
branches;
next	1.15;
commitid	KbosAzCq3U7jJkIr;

1.15
date	2005.10.03.09.12.40;	author rse;	state Exp;
branches;
next	1.14;

1.14
date	2005.02.18.10.33.31;	author rse;	state Exp;
branches;
next	1.13;

1.13
date	2005.01.24.14.35.55;	author rse;	state Exp;
branches;
next	1.12;

1.12
date	2004.12.31.19.16.34;	author rse;	state Exp;
branches;
next	1.11;

1.11
date	2004.12.19.19.36.27;	author rse;	state Exp;
branches;
next	1.10;

1.10
date	2004.12.04.12.54.42;	author rse;	state Exp;
branches;
next	1.9;

1.9
date	2004.11.27.19.56.25;	author rse;	state Exp;
branches;
next	1.8;

1.8
date	2004.11.27.19.40.33;	author rse;	state Exp;
branches;
next	1.7;

1.7
date	2004.11.20.17.09.35;	author rse;	state Exp;
branches;
next	1.6;

1.6
date	2004.11.20.16.51.52;	author rse;	state Exp;
branches;
next	1.5;

1.5
date	2004.11.17.13.15.15;	author rse;	state Exp;
branches;
next	1.4;

1.4
date	2004.11.17.09.05.47;	author rse;	state Exp;
branches;
next	1.3;

1.3
date	2004.11.16.19.32.40;	author rse;	state Exp;
branches;
next	1.2;

1.2
date	2004.11.16.19.31.35;	author rse;	state Exp;
branches;
next	1.1;

1.1
date	2004.11.14.18.38.53;	author rse;	state Exp;
branches;
next	;


desc
@@


1.17
log
@cleanup source tree for status as of 2006
@
text
@##
##  OSSP cfg - Configuration Parsing
##  Copyright (c) 2002-2006 Ralf S. Engelschall <rse@@engelschall.com>
##  Copyright (c) 2002-2006 The OSSP Project <http://www.ossp.org/>
##
##  This file is part of OSSP cfg, a configuration parsing library which
##  can be found at http://www.ossp.org/pkg/lib/cfg/.
##
##  Permission to use, copy, modify, and distribute this software for
##  any purpose with or without fee is hereby granted, provided that
##  the above copyright notice and this permission notice appear in all
##  copies.
##
##  THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
##  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
##  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
##  IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
##  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
##  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
##  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
##  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
##  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
##  SUCH DAMAGE.
##
##  cfg.pm: Perl Binding (Perl part)
##

package OSSP::cfg;

use 5.008;
use strict;
use warnings;
use Carp;
use XSLoader;
use Exporter;

##
##  API Definition
##

#   API version
our $VERSION = do { my @@v = ('0.9.11' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); };

#   API inheritance
our @@ISA = qw(Exporter);

#   API symbols
my $symbols = {
    'const' => [qw(
        CFG_OK
        CFG_ERR_ARG
        CFG_ERR_USE
        CFG_ERR_MEM
        CFG_ERR_SYS
        CFG_ERR_FMT
        CFG_ERR_INT
        CFG_ERR_SYN
        CFG_ERR_NDE
        CFG_FMT_CFG
        CFG_FMT_XML
        CFG_NODE_TYPE_SEQ
        CFG_NODE_TYPE_DIR
        CFG_NODE_TYPE_OPT
        CFG_NODE_TYPE_ARG
        CFG_NODE_ATTR_PARENT
        CFG_NODE_ATTR_LBROTH
        CFG_NODE_ATTR_RBROTH
        CFG_NODE_ATTR_CHILD1
        CFG_NODE_ATTR_CHILDL
        CFG_NODE_ATTR_CHILDS
        CFG_NODE_ATTR_NODES
        CFG_NODE_ATTR_DEPTH
        CFG_NODE_ATTR_SRCNAME
        CFG_NODE_ATTR_SRCPOS
        CFG_NODE_ATTR_TYPE
        CFG_NODE_ATTR_TOKEN
        CFG_NODE_ATTR_DATA
        CFG_DATA_TYPE_PTR
        CFG_DATA_TYPE_STR
        CFG_DATA_TYPE_INT
        CFG_DATA_TYPE_FLT
        CFG_DATA_CTRL_CLONE
        CFG_DATA_CTRL_DESTROY
        CFG_DATA_ATTR_TYPE
        CFG_DATA_ATTR_VALUE
        CFG_DATA_ATTR_CTRL
    )],
    'func' => [qw(
        cfg_create
        cfg_destroy
        cfg_error
        cfg_version
        cfg_import
        cfg_export
        cfg_node_create
        cfg_node_destroy
        cfg_node_clone
        cfg_node_set
        cfg_node_get
        cfg_node_root
        cfg_node_select
        cfg_node_find
        cfg_node_apply
        cfg_node_cmp
        cfg_node_link
        cfg_node_unlink
        cfg_data_set
        cfg_data_get
        cfg_data_ctrl
    )]
};

#   API symbol exportation
our %EXPORT_TAGS = (
    'all'   => [ @@{$symbols->{'const'}}, @@{$symbols->{'func'}} ],
    'const' => [ @@{$symbols->{'const'}} ],
    'func'  => [ @@{$symbols->{'func'}}  ]
);
our @@EXPORT_OK = @@{$EXPORT_TAGS{'all'}};
our @@EXPORT    = ();

##
##  High-Level Perl Module OO-style API
##  (just an OO wrapper around the C-style API)
##

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    bless ($self, $class);
    $self->{-cfg} = undef;
    $self->{-rc}  = $self->CFG_OK;
    my $rc = cfg_create($self->{-cfg});
    if ($rc != $self->CFG_OK) {
        croak(sprintf("OSSP::cfg::new: cfg_create: %s (%d)", $self->error($rc), $rc));
    }
    return $self;
}

sub DESTROY ($) {
    my ($self) = @@_;
    $self->{-rc} = cfg_destroy($self->{-cfg}) if (defined($self->{-cfg}));
    if ($self->{-rc} != $self->CFG_OK) {
        carp(sprintf("OSSP::cfg::DESTROY: cfg_destroy: %s (%d)", $self->error($self->{-rc}), $self->{-rc}));
        return;
    }
    $self->{-cfg} = undef;
    $self->{-rc}  = undef;
    return;
}

sub import { # ($$$$)
    #   ATTENTION: The OSSP cfg API function "import" conflicts with
    #   the standardized "import" method the Perl world expects from
    #   their modules. In order to keep the Perl binding consist
    #   with the C API, we solve the conflict under run-time by
    #   distinguishing between the two types of "import" calls.
    if (defined($_[0]) and ref($_[0]) =~ m/^OSSP::cfg/) {
        #   the regular OSSP::cfg "import" method
        my ($self, $node, $fmt, $in) = @@_;
        $self->{-rc} = cfg_import($self->{-cfg}, $node, $fmt, $in, length($in));
        return ($self->{-rc} == $self->CFG_OK);
    }
    else {
        #   the special Perl "import" method
        #   (usually inherited from the Exporter)
        no strict "refs";
        return OSSP::cfg->export_to_level(1, @@_);
    }
}

sub export { # ($$$)
    #   ATTENTION: The OSSP cfg API function "export" conflicts with
    #   the standardized "export" method the Perl world expects from
    #   their modules. In order to keep the Perl binding consist
    #   with the C API, we solve the conflict under run-time by
    #   distinguishing between the two types of "export" calls.
    if (defined($_[0]) and ref($_[0]) =~ m/^OSSP::cfg/) {
        #   the regular OSSP::cfg "export" method
        my ($self, $node, $fmt) = @@_;
        my $out;
        $self->{-rc} = cfg_export($self->{-cfg}, $node, $fmt, $out, 0);
        return ($self->{-rc} == $self->CFG_OK ? $out : undef);
    }
    else {
        #   the special Perl "export" method
        #   (usually inherited from the Exporter)
        return Exporter::export(@@_);
    }
}

sub error ($;$) {
    my ($self, $rc) = @@_;
    $rc = $self->{-rc} if (not defined($rc));
    my $error;
    if (cfg_error($self->{-cfg}, $rc, $error) != $self->CFG_OK) {
        croak("OSSP::cfg::error: cfg_error: INTERNAL ERROR");
    }
    return wantarray ? ($error, $rc) : $error;
}

sub version () {
    my ($self) = @@_;
    return cfg_version();
}

sub node_create ($) {
    my ($self) = @@_;
    my $node;
    $self->{-rc} = cfg_node_create($self->{-cfg}, $node);
    return ($self->{-rc} == $self->CFG_OK ? $node : undef);
}

sub node_destroy ($$) {
    my ($self, $node) = @@_;
    $self->{-rc} = cfg_node_destroy($self->{-cfg}, $node);
    return ($self->{-rc} == $self->CFG_OK);
}

sub node_clone ($$) {
    my ($self, $node) = @@_;
    my $node2;
    $self->{-rc} = cfg_node_clone($self->{-cfg}, $node, $node2);
    return ($self->{-rc} == $self->CFG_OK ? $node2 : undef);
}

sub node_set ($$$$) {
    my ($self, $node, $attr, $arg) = @@_;
    $self->{-rc} = cfg_node_set($self->{-cfg}, $node, $attr, $arg);
    return ($self->{-rc} == $self->CFG_OK);
}

sub node_get ($$$) {
    my ($self, $node, $attr) = @@_;
    my $arg;
    $self->{-rc} = cfg_node_get($self->{-cfg}, $node, $attr, $arg);
    return ($self->{-rc} == $self->CFG_OK ? $arg : undef);
}

sub node_root ($;$) {
    my ($self, $node_new) = @@_;
    $node_new ||= \0;
    my $node_old;
    $self->{-rc} = cfg_node_root($self->{-cfg}, $node_new, $node_old);
    return ($self->{-rc} == $self->CFG_OK ? $node_old : undef);
}

sub node_select ($$$) {
    my ($self, $node, $spec) = @@_;
    my $result;
    $self->{-rc} = cfg_node_select($self->{-cfg}, $node, $result, $spec);
    return ($self->{-rc} == $self->CFG_OK ? $result : undef);
}

sub node_find ($$$$) {
    my ($self, $node, $cb_fct_cmp, $cb_ctx_cmp) = @@_;
    my $cont;
    $self->{-rc} = cfg_node_find($self->{-cfg}, $node, $cb_fct_cmp, $cb_ctx_cmp, $cont);
    return ($self->{-rc} == $self->CFG_OK ? $cont : undef);
}

sub node_apply ($$$$) {
    my ($self, $node, $cb_fct_cmp, $cb_ctx_cmp, $cb_fct_cb, $cb_ctx_cb) = @@_;
    $self->{-rc} = cfg_node_apply($self->{-cfg}, $node, $cb_fct_cmp, $cb_ctx_cmp, $cb_fct_cb, $cb_ctx_cb);
    return ($self->{-rc} == $self->CFG_OK);
}

sub node_cmp ($$$) {
    my ($self, $node, $token) = @@_;
    $self->{-rc} = cfg_node_cmp($self->{-cfg}, $node, $token);
    return ($self->{-rc} == $self->CFG_OK);
}

sub node_link ($$$$) {
    my ($self, $node, $id, $node2) = @@_;
    $self->{-rc} = cfg_node_link($self->{-cfg}, $node, $id, $node2);
    return ($self->{-rc} == $self->CFG_OK);
}

sub node_unlink ($$) {
    my ($self, $node) = @@_;
    $self->{-rc} = cfg_node_unlink($self->{-cfg}, $node);
    return ($self->{-rc} == $self->CFG_OK);
}

sub data_set ($$$$) {
    my ($self, $data, $attr, $value) = @@_;
    $self->{-rc} = cfg_data_set($data, $attr, $value);
    return ($self->{-rc} == $self->CFG_OK);
}

sub data_get ($$$) {
    my ($self, $data, $attr) = @@_;
    my $value;
    $self->{-rc} = cfg_data_get($data, $attr, $value);
    return ($self->{-rc} == $self->CFG_OK ? $value : undef);
}

sub data_ctrl ($$$;$) {
    my ($self, $data, $ctrl, $value) = @@_;
    $self->{-rc} = cfg_data_ctrl($data, $ctrl, $value);
    return ($self->{-rc} == $self->CFG_OK);
}

##
##  Low-Level Perl XS C-style API
##  (actually just the activation of the XS part)
##

#   auto-loading constants
sub AUTOLOAD {
    my $constname;
    our $AUTOLOAD;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "&OSSP::cfg::constant not defined" if ($constname eq 'constant');
    my ($error, $val) = constant($constname);
    croak $error if ($error);
    { no strict 'refs'; *$AUTOLOAD = sub { $val }; }
    goto &$AUTOLOAD;
}

#   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, %arg) = @@_;
    my $cfg = $self->{-cfg};

    #   start traversing the node tree from the root node
    my $root = $cfg->node_root();
    my $tree = &traverse($cfg, \%arg, $root);

    #   node processing function
    sub traverse {
        my ($cfg, $arg, $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, $arg, $node); # recursion
                push(@@{$seq}, $tree) if (defined($tree));
                $node = $cfg->node_get($node, $cfg->CFG_NODE_ATTR_RBROTH);
            }
            #   optional post-processing of data structure
            $seq = &unpack_postproc_merge   ($seq, $arg->{-merge})   if (defined($arg->{-merge}));
            $seq = &unpack_postproc_index   ($seq, $arg->{-index})   if (defined($arg->{-index}));
            $seq = &unpack_postproc_strip   ($seq, $arg->{-strip})   if (defined($arg->{-strip}));
            $seq = &unpack_postproc_flatten ($seq, $arg->{-flatten}) if (defined($arg->{-flatten}));
            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, $arg, $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;
}

#   unpack helper function:
#   optionally merge arguments of DIRectives starting with same TOKen.
#   complexity: O(n) (actually 3*n)
sub unpack_postproc_merge {
    my ($seq, $re) = @@_;
    
    #   pass 1: determine directive names and their 
    #   occurences in sequence. complexity: O(n)
    my $dir = {};
    for (my $i = 0; $i < @@{$seq}; $i++) {
        if (    ref($seq->[$i]) eq 'ARRAY' 
            and not ref($seq->[$i]->[0])
            and $seq->[$i]->[0] =~ m/^$re$/s) {
            my $name = $seq->[$i]->[0];
            $dir->{$name} = [] if (not defined($dir->{$name}));
            push(@@{$dir->{$name}}, $i);
        }
    }

    #   pass 2: append arguments of second and following sequences
    #   to arguments of first directive. complexity: O(n)
    foreach my $name (keys(%{$dir})) {
        if (@@{$dir->{$name}} > 1) {
            my $f = $dir->{$name}->[0];
            foreach my $n (@@{$dir->{$name}}[1..$#{$dir->{$name}}]) {
                foreach my $tok (@@{$seq->[$n]}[1..$#{$seq->[$n]}]) {
                    push(@@{$seq->[$f]}, $tok);
                }
                $seq->[$n] = undef;
            }
        }
    }

    #   pass 3: shrink sequence by eliminating removing entries
    #   complexity: O(n)
    for (my $i = 0; $i < @@{$seq}; $i++) {
        if (not defined($seq->[$i])) {
            splice(@@{$seq}, $i, 1);
            $i--; # compensate for splice operation
        }
    }

    return $seq;
}

#   unpack helper function:
#   optionally annotate SEQuence nodes with a DIRective name indexing hash
#   complexity: O(n)
sub unpack_postproc_index {
    my ($seq, $re) = @@_;

    #   create an index hash
    my $idx = {};
    for (my $i = 0; $i < @@{$seq}; $i++) {
        if (ref($seq->[$i]) eq 'ARRAY') {
            #   determine name of directive, i.e.,
            #   first non-sub-sequence element
            my $name = {};
            for (my $j = 0; $j < @@{$seq->[$j]}; $j++) {
                $name = $seq->[$i]->[$j];
                last if (not ref($name));
            }
            if (    not ref($name)
                and $name =~ m/^$re$/s 
                and not defined($idx->{$name})) {
                #    remember position of directive's
                #    first occurrence in sequence
                $idx->{$name} = ($i + 1);
            }
        }
    }

    #   insert index at first position of sequence array following
    #   perlref(1)'s "Pseudo-hashes: Using an array as a hash" approach.
    unshift(@@{$seq}, $idx);

    return $seq;
}

#   unpack helper function:
#   strip directive command/start token
#   complexity: O(n)
sub unpack_postproc_strip {
    my ($seq, $re) = @@_;

    foreach my $dir (@@{$seq}) {
        if (    ref($dir) eq 'ARRAY'
            and $dir->[0] =~ m/^$re$/s) {
            #   remove first token of directive array
            shift(@@{$dir});
        }
    }

    return $seq;
}

#   unpack helper function:
#   flatten empty and single token directives
sub unpack_postproc_flatten {
    my ($seq, $empty) = @@_;

    for (my $i = 0; $i < @@{$seq}; $i++) {
        if (ref($seq->[$i]) eq 'ARRAY') {
            if (@@{$seq->[$i]} == 0) {
                #   replace empty directive array
                #   (can exist after "dirstrip" processing!)
                $seq->[$i] = $empty;
            }
            elsif (@@{$seq->[$i]} == 1) {
                #   simplify single token directive array
                $seq->[$i] = $seq->[$i]->[0];
            }
        }
    }

    return $seq;
}

1;

@


1.16
log
@bump before release
@
text
@d3 2
a4 3
##  Copyright (c) 2002-2005 Ralf S. Engelschall <rse@@engelschall.com>
##  Copyright (c) 2002-2005 The OSSP Project <http://www.ossp.org/>
##  Copyright (c) 2002-2005 Cable & Wireless <http://www.cw.com/>
@


1.15
log
@bump version before release
@
text
@d45 1
a45 1
our $VERSION = do { my @@v = ('0.9.10' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); };
@


1.14
log
@bump before release
@
text
@d45 1
a45 1
our $VERSION = do { my @@v = ('0.9.9' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); };
@


1.13
log
@bump before release
@
text
@d45 1
a45 1
our $VERSION = do { my @@v = ('0.9.8' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); };
@


1.12
log
@Adjust copyright messages for new year 2005.
@
text
@d45 1
a45 1
our $VERSION = do { my @@v = ('0.9.7' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); };
@


1.11
log
@Fixed cfg_node_get() function after recent introduction
of LOAN/GIFT/COPY  argument passing semantics. This
inbreaks the Perl API's unpack() function.
@
text
@d3 3
a5 3
##  Copyright (c) 2002-2004 Ralf S. Engelschall <rse@@engelschall.com>
##  Copyright (c) 2002-2004 The OSSP Project <http://www.ossp.org/>
##  Copyright (c) 2002-2004 Cable & Wireless <http://www.cw.com/>
@


1.10
log
@bump before release
@
text
@d45 1
a45 1
our $VERSION = do { my @@v = ('0.9.6' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); };
@


1.9
log
@add Autoconf support for new Perl API
@
text
@d45 1
a45 1
our $VERSION = do { my @@v = ('0.9.5' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); };
@


1.8
log
@Ok, let's rock: add four optional post-processing functions which allow
one to adjust an unpacked data structure in a way it can be used more
conveniently and intuitive.
@
text
@d45 1
a45 1
our $VERSION = do { my @@v = ('1.1.0' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); };
@


1.7
log
@Add OSSP:::cfg::simple Perl convenience API which is an
ultra high-level API allowing especially the bi-directional
conversion between the C API node tree representation and a
simplified Perl data structure representation.
@
text
@d467 2
a468 2
sub unpack ($) {
    my ($self) = @@_;
d473 1
a473 1
    my $tree = &traverse($cfg, $root);
d477 1
a477 1
        my ($cfg, $node) = @@_;
d485 1
a485 1
                my $tree = &traverse($cfg, $node); # recursion
d489 5
d501 1
a501 1
                my $tree = &traverse($cfg, $node); # recursion
d516 118
@


1.6
log
@synchronize perl wrapper for changed cfg_node_root function
@
text
@d329 182
@


1.5
log
@implement the Perl API
@
text
@d244 6
a249 5
sub node_root ($) {
    my ($self) = @@_;
    my $node;
    $self->{-rc} = cfg_node_root($self->{-cfg}, $node);
    return ($self->{-rc} == $self->CFG_OK ? $node : undef);
@


1.4
log
@add commented prototypes and fix export function
@
text
@a129 1
#   constructor
a143 1
#   destructor
d211 97
@


1.3
log
@Ops, too much cut & paste from OSSP uuid ;-)
@
text
@d158 1
a158 1
sub import {
d178 1
a178 1
sub export {
d188 1
a188 1
        $self->{-rc} = cfg_import($self->{-cfg}, $node, $fmt, $out, 0);
@


1.2
log
@initial Perl API
@
text
@d164 1
a164 1
    if (defined($_[0]) and ref($_[0]) =~ m/^OSSP::uuid/) {
d184 1
a184 1
    if (defined($_[0]) and ref($_[0]) =~ m/^OSSP::uuid/) {
@


1.1
log
@Initial cut for Perl bindings to OSSP cfg. Still partly broken, of course ;-)
@
text
@d137 1
a137 1
    $self->{-rc}   = $self->CFG_OK;
d140 1
a140 2
        croak(sprintf("OSSP::cfg::new: cfg_create: %s (%d)", cfg_error($rc), $rc));
        return undef;
d150 1
a150 1
        carp(sprintf("OSSP::cfg::DESTROY: cfg_destroy: %s (%d)", cfg_error($self->{-rc}), $self->{-rc}));
d154 1
a154 1
    $self->{-rc}   = undef;
d158 38
a195 4
sub FIXME ($$) {
    my ($self, $name) = @@_;
    $self->{-rc} = cfg_load($self->{-cfg}, $name);
    return ($self->{-rc} == $self->CFG_OK);
d201 5
a205 1
    return wantarray ? (cfg_error($rc), $rc) : cfg_error($rc);
d208 1
a208 1
sub version (;$) {
@