Index: trunk/PS-IPP-Metadata-Config/lib/PS/IPP/Metadata/Config.pm
===================================================================
--- trunk/PS-IPP-Metadata-Config/lib/PS/IPP/Metadata/Config.pm	(revision 7865)
+++ trunk/PS-IPP-Metadata-Config/lib/PS/IPP/Metadata/Config.pm	(revision 8583)
@@ -1,5 +1,5 @@
 # Copyright (c) 2005  Joshua Hoblitt
 #
-# $Id: Config.pm,v 1.18 2006-07-12 02:49:53 jhoblitt Exp $
+# $Id: Config.pm,v 1.19 2006-08-25 03:08:56 jhoblitt Exp $
 
 package PS::IPP::Metadata::Config;
@@ -8,8 +8,8 @@
 use warnings FATAL => qw( all );
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 use Carp qw( carp );
-use Parse::RecDescent;
+use PS::IPP::Metadata::Parser;
 
 use base qw( Class::Accessor::Fast );
@@ -25,5 +25,5 @@
     my $class = shift;
 
-    my $self = { _parser => Parse::RecDescent->new( $grammar ) };
+    my $self = { _parser => PS::IPP::Metadata::Parser->new };
 
     bless $self, $class;
@@ -110,354 +110,3 @@
 1;
 
-__DATA__
-
-{
-    use strict;
-
-    use Carp qw( carp );
-
-    our @scope_stack;
-}
-
-startrule: grammar eofile
-    { $item{grammar} }
-
-grammar:
-    statement(s)
-        {
-            $thisparser->{local} = pop @scope_stack;
-            [ grep $_->{class} !~ /comment_line/, @{$item[1]} ];
-        }
-
-statement:
-    scalar
-    | vector
-    | comment_line
-    | typedef
-    | metadata
-    | typedef_declare
-    | multi_declare
-    | time
-    | <error:unmatched statement: $text>
-
-scalar:
-    <skip:'[ \t\r]*'> name type <matchrule:$item{type}> comment(?) "\n"
-        {
-            $thisparser->{local}{name}{ $item{name} }++
-                unless defined $thisparser->{local}{name}{ $item{name} };
-
-            $return = {
-                class   => 'scalar',
-                name    => $item{name},
-                type    => $item{type},
-                value   => $item[4],
-            };
-
-            $return->{comment} = $item{'comment(?)'}[0]
-                if $item{'comment(?)'}[0];
-
-            if ( defined $thisparser->{local}{name}{ $item{name} } ) {
-                $return->{multi}++
-                    if $thisparser->{local}{name}{ $item{name} } =~ /MULTI/;
-            } else {
-                $thisparser->{local}{name}{ $item{name} }++;
-            }
-        }
-
-vector:
-     <skip:'[ \t\r]*'> vname vtype vvalue[ $item{vtype} ] comment(?) "\n"
-        {
-            $thisparser->{local}{name}{ $item{vname} }++
-                unless defined $thisparser->{local}{name}{ $item{vname} };
-
-            $return = {
-                class   => 'vector',
-                name    => $item{vname},
-                type    => $item{vtype},
-                value   => $item{vvalue},
-                comment => $item{comment}
-            };
-
-            $return->{comment} = $item{'comment(?)'}[0]
-                if $item{'comment(?)'}[0];
-        }
-
-multi_declare:
-    <skip:'[ \t\r]*'> name /MULTI/i <commit> comment(?) "\n"
-        {
-            if ( ! defined $thisparser->{local}{name}{ $item{name} } ) {
-                $thisparser->{local}{name}{ $item{name} } = "MULTI";
-                $return = { class   => 'comment_line' };
-            } else {
-                $return = undef;
-            }
-        }
-    | <error?:redefinition of MULTI> <reject>
-
-metadata:
-    metadata_name <commit> 
-    { push @scope_stack, $thisparser->{local}; $thisparser->{local} = {} }
-    grammar
-    metadata_end
-        {
-            my $text = $item[2];
-            
-            if ( defined( $text ) ) {
-                $return = {
-                    class   => 'metadata',
-                    name    => $item{metadata_name},
-                    value   => $item{grammar},
-                };
-            } else {
-                $return = undef;
-            }
-
-            if ( defined $thisparser->{local}{name}{ $item{metadata_name} } ) {
-                $return->{multi}++
-                    if $thisparser->{local}{name}{ $item{metadata_name} } =~ /MULTI/;
-            } else {
-                $thisparser->{local}{name}{ $item{metadata_name} }++;
-            }
-        } 
-    | <error?:bad METADATA syntax: $text> <reject>
-
-comment_line:
-    <skip:'[ \t\r]*'> comment(?) "\n"
-        {{ class   => 'comment_line' }}
-
-time:
-    <skip:'[ \t\r]*'> name ttype <matchrule:$item{ttype}> comment(?) "\n"
-        {
-            use DateTime::Format::ISO8601;
-
-            $return = {
-                class   => 'time',
-                name    => $item{name},
-                type    => $item{ttype},
-                value   => $item[4],
-            };
-
-            $return->{comment} = $item{'comment(?)'}[0]
-                if $item{'comment(?)'}[0];
-        }
-
-typedef_declare:
-    <skip:'[ \t\r]*'> 'TYPE' <commit> name name(s) comment(?) "\n"
-        {
-            if (defined $thisparser->{local}{typedef}{ $item{name} }) {
-                carp "refinition of TYPE $item{name}";    
-                $return = undef;
-            } else {
-
-                my $type = {
-                    class   => 'typedef_declare',
-                    name    => $item{name},
-                    fields  => $item{'name(s)'},
-                    length  => scalar @{ $item{'name(s)'} },
-                };
-
-                $thisparser->{local}{typedef}{ $item{name} } = $type;
-
-                # don't return anything in the parse tree
-                $return = { class => 'comment_line' };
-            }
-        }
-    | <error?:redefinition of TYPE> <reject>
-
-typedef:
-    <skip:'[ \t\r]*'> name typedef_type <commit> word(s) comment(?) "\n"
-        {
-            my $type = $thisparser->{local}{typedef}{ $item{typedef_type} };
-
-            unless ( scalar @{ $item{'word(s)'} } == $type->{length} ) {
-                my $expect = $type->{length};
-                my $got = scalar @{ $item{'word(s)'} };
-                carp "\"$item{name} $item{typedef_type}\""
-                    . " does not have enough fields, epected: $expect, got: $got";
-                $return = undef;
-            } else {
-                my @md;
-                my $i = 0;
-                foreach my $name ( @{ $type->{fields} } ) {
-                    push @md, {
-                        name    => $name,
-                        class   => 'scalar',
-                        type    => 'STR',
-                        value   => $item{'word(s)'}[$i],
-                    };
-
-                    $i++;
-                }
-
-                $return = {
-                    class   => 'metadata',
-                    name    => $item{name},
-                    value   => \@md,
-                };
-            }
-        }
-    | <error?:'TYPE' does not have enough parameters: $text> <reject>
-
-
-typedef_type: name
-        {
-            if ( ! defined $thisparser->{local}{typedef}{ $item{name} } ) {
-                $return = undef;
-            } else {
-                $return = $item{name};
-            }
-        }
-
-metadata_name:
-    <skip:'[ \t\r]*'> name /METADATA/i comment(?) "\n"
-        { $item{name} } 
-    
-metadata_end:
-     <skip:'[ \t\r]*'> /END/i comment(?) "\n"
-
-comment:
-    '#' to_end_of_line
-        { $item{to_end_of_line} }
-
-vname:
-    '@' name
-        { $item{name} }
-
-name:
-    /[a-z][.\w-]*/i
-        {
-            if ( $item[1] =~ /^(METADATA|END|TYPE)$/i ) {
-                $return = undef;
-            } else {
-                $return = $item[1];
-            }
-        }
-
-# 'STR' seems to be the most common type, trying to match it first is a simple
-# optimization.
-type: 
-    'STR'
-    | 'STRING'
-    | vtype
-
-vtype: 
-    'S8'
-    | 'S16'
-    | 'S32'
-    | 'S64'
-    | 'U8' 
-    | 'U16'
-    | 'U32'
-    | 'U64'
-    | 'F32'
-    | 'F64'
-    | 'C32'
-    | 'C64'
-    | 'BOOL'
-
-ttype:
-    'UTC'
-    | 'UT1'
-    | 'TAI'
-    | 'TT'
-
-S8: int
-S16: int
-S32: int
-S64: int
-U8 : int
-U16: int
-U32: int
-U64: int
-F32: float
-F64: float
-C32: float
-C64: float
-BOOL: bool
-STR: string
-STRING: string
-
-vvalue:
-    _vvalue[%arg](s)
-        { [ map { @$_ } @{$item[1]} ] }
-
-tvalue:
-    iso8601
-    | epoch
-
-# backtracking optimization
-_vvalue:
-    <matchrule:$arg[0]> vector_sep(?)
-        { [ $item[1] ] }
-
-vector_sep:
-    /,|\s+/
-
-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]/i
-        { $item[1] =~ /t/i ? 1 : 0 }
-
-string:
-    /(?:\S[^#\n]*)?[^#\n ]/
-
-word:
-    /(?:[^#\s\n]+)/
-
-to_end_of_line:
-    /[^\n]*/
-        {
-            my $comment = $item[1];
-            # remove leading whitespace
-            $comment =~ s/^\s+//;
-            # remove trailing whitespace
-            $comment =~ s/\s+$//;
-
-            $return = $comment;
-        }
-
-UTC:
-    iso8601
-    | utc_epoch
-
-UT1:
-    iso8601
-    | epoch
-
-TAI:
-    iso8601
-    | epoch
-
-TT:
-    iso8601
-    | epoch
-
-iso8601:
-    # based on code from DateTime::Format::ISO8601
-    / (\d{4}) - (\d\d) - (\d\d) T (\d\d) : (\d\d) : (\d\d) Z /x
-        { DateTime::Format::ISO8601->parse_datetime( $item[1] ) }
-
-utc_epoch:
-    / (-?\d{1,19}) \s*,\s* (\d{1,9}) (?:\s*,\s* (\d))? /x
-        {{
-            sec         => $1,
-            nsec        => $2,
-            leapsecond  => $3,
-        }}
-
-epoch:
-    / (-?\d{1,19}) \s*,\s* (\d{1,9}) /x
-        {{
-            sec     => $1,
-            nsec    => $2,
-        }}
-
-eofile:
-    /^\z/
+__END__