Index: /branches/jhoblitt/PS-IPP-Metadata-Config/lib/PS/IPP/Metadata/Config.pm
===================================================================
--- /branches/jhoblitt/PS-IPP-Metadata-Config/lib/PS/IPP/Metadata/Config.pm	(revision 3353)
+++ /branches/jhoblitt/PS-IPP-Metadata-Config/lib/PS/IPP/Metadata/Config.pm	(revision 3353)
@@ -0,0 +1,288 @@
+# Copyright (c) 2005  Joshua Hoblitt
+#
+# $Id#
+
+package PS::IPP::Metadata::Config;
+
+use strict;
+use warnings FATAL => qw( all );
+
+our $VERSION = '0.01';
+
+use Carp qw( carp );
+use Parse::RecDescent;
+#use Data::Dumper;
+
+use base qw( Class::Accessor::Fast );
+__PACKAGE__->mk_accessors( qw( overwrite ) );
+
+#$::RD_TRACE = 1;
+#$::RD_HINT = 1;
+
+my $grammar = do{ local $/; <DATA> };
+
+sub new {
+    my $class = shift;
+
+    my $myparser = Parse::RecDescent->new( $grammar );
+
+    my $self = { _parser => $myparser };
+
+    bless $self, $class;
+
+    $self->overwrite( undef );
+
+    return $self;
+}
+
+sub parse {
+    my ( $self, $metadata ) = @_;
+
+    my $tree = $self->{_parser}->startrule( $metadata );
+
+    # remove comment only lines
+    $self->_strip_comments( $tree ) or return undef;
+
+    # handle multi-declare lines
+    $self->_merge_multi_declares( $tree ) or return undef;
+
+    # look for duplicate names, there should be none after processing the
+    # multi-declares
+    $self->_merge_duplicates( $tree ) or return undef;
+
+    return $tree;
+}
+
+sub _strip_comments {
+    my ( $self, $tree ) = @_;
+
+    # Iteratate through the AoH structure and remove the hashes that have a
+    # class key equal to "comment_line".
+    for (my $i = 0; $i < @{$tree}; $i++) {
+        my $elem = $tree->[$i];
+
+        if ( $elem->{class} eq "comment_line" ) {
+            # delete element from array
+            splice @$tree, $i, 1;
+
+            # the list just got shorter by one element so we don't want to
+            # increment the cursor
+            redo;
+        }
+    }
+
+    return 1;
+}
+
+sub _merge_multi_declares {
+    my ( $self, $tree ) = @_;
+
+    # list of valid multi-declares
+    my %multis;
+
+    # Iteratate through the AoH structure looking for multi-declare
+    # declarations.  This is done in a single pass so multi-declares must
+    # actually be 'declared' before any member elements appear.  
+    for (my $i = 0; $i < @{$tree}; $i++) {
+        my $elem = $tree->[$i];
+
+        if ( $elem->{class} eq "multi_declare" ) {
+            # construct a valid parse spec
+            my $node = {
+                class   => 'vector',
+                name    => $elem->{name},
+                type    => 'STR',   # only strings are allowed
+                value   => [],
+            };
+
+            # add to list of valid multi-declares
+            $multis{ $elem->{name} } = $node;
+
+            # delete mult-declare hash from the array and replace it with the
+            # valid spec
+            splice @$tree, $i, 1, $node;
+
+            next;
+        }
+
+        if ( my $node = $multis{ $elem->{name} } ) {
+            if ( ! $elem->{type} =~ /STR|STRING/ ) {
+                carp "multi-declare element, ",
+                     $elem->{name},
+                     "has type of ",
+                     $elem->{type},
+                     "instead of STR|STRING\n";
+                return undef;
+            }
+
+            # add element value to the appropriate multi-declare element
+            my $vec = $node->{value};
+            push( @$vec, $elem->{value} );
+
+            # delete element from array
+            splice @$tree, $i, 1;
+
+            # the list just got shorter by one element so we don't want to
+            # increment the cursor
+            redo;
+        }
+    }
+
+    return 1;
+}
+
+sub _merge_duplicates {
+    my ( $self, $tree ) = @_;
+
+    # encountered names
+    my %names;
+
+    for (my $i = 0; $i < @{$tree}; $i++) {
+        my $elem = $tree->[$i];
+
+        if ( exists $names{ $elem->{name} } ) {
+            carp "duplicate element name, ", $elem->{name}, "\n";
+
+            if ( $self->{overwrite} ) {
+                # remove the previous occurance
+                splice @{$tree}, $names{ $elem->{name} }, 1;
+            } else {
+                # remove the current occurance
+                splice @{$tree}, $i, 1;
+            }
+        }
+
+        # add element name and location to record of previously seen names
+        $names{ $elem->{name} } = $i;
+    }
+
+    return 1;
+}
+
+1;
+
+__DATA__
+
+startrule:
+    statement(s) /\z/
+        { $item[1 .. -1] }
+
+statement:
+    scalar
+    | vector
+    | multi_declare
+    | comment_line
+
+comment_line:
+    comment
+        {{
+            class   => 'comment_line',
+            comment => $item{comment}
+        }}
+
+comment:
+    '#' end_of_line
+        { $item{end_of_line} }
+
+scalar:
+    name type value comment
+        {{
+            class   => 'scalar',
+            name    => $item{name},
+            type    => $item{type},
+            value   => $item{value},
+            comment => $item{comment}
+         }}
+    | name type value 
+        {{
+            class   => 'scalar',
+            name    => $item{name},
+            type    => $item{type},
+            value   => $item{value},
+        }}
+
+vector:
+    vname vtype vvalue comment
+        {{
+            class   => 'vector',
+            name    => $item{vname},
+            type    => $item{vtype},
+            value   => $item{vvalue},
+            comment => $item{comment}
+         }}
+    | vname vtype vvalue 
+        {{
+            class   => 'vector',
+            name    => $item{vname},
+            type    => $item{vtype},
+            value   => $item{vvalue},
+         }}
+
+multi_declare:
+    name '*' end_of_line
+        {{
+            class   => 'multi_declare',
+            name    => $item{name}, 
+            comment => $item{end_of_line},
+        }}
+
+name:
+    /[a-z][.\w]*/i
+
+vname:
+    /\@[a-z][.\w]*/i
+
+type: 
+    vtype | 'STR' | 'STRING'
+
+vtype: 
+    'S8'
+    | 'S16'
+    | 'S32'
+    | 'S64'
+    | 'U8' 
+    | 'U16'
+    | 'U32'
+    | 'U64'
+    | 'F32'
+    | 'F64'
+    | 'C32'
+    | 'C64'
+    | 'BOOL'
+
+value:
+    primitive | string
+
+
+vvalue:
+    vvalue_(s)
+        { [ map { @$_ } @{$item[1]} ] }
+
+# backtracking optimization
+vvalue_:
+    primitive vector_sep(?)
+        { [ $item[1] ] }
+
+vector_sep:
+    /,|\s+/
+
+primitive:
+    bool | float | int
+
+int:
+    # $RE{num}{int} from Regexp::Common::number
+    /(?:(?:[+-]?)(?:[0-9]+))/
+
+float:
+    # based on $RE{num}{real} from Regexp::Common::number
+    /(?:(?i)(?:[+-]?)(?:(?=[0-9]|[.])(?:[0-9]*)(?:(?:[.])(?:[0-9]{0,}))?)(?:(?:[Ee])(?:(?:[+-]?)(?:[0-9]+))|))/
+
+bool:
+    /[tf]\s+?/i
+        { $item[1] =~ /t/i ? 1 : 0 }
+
+string:
+    /\S[^#\n]*/
+
+end_of_line:
+    /[^\n]*/