Changeset 3456

Timestamp:

Mar 18, 2005, 2:45:37 PM (21 years ago)

Author:

jhoblitt

Message:

full 'TYPE' support
convert 'TYPE' typdefs into 'metadata's

Location:

trunk/PS-IPP-Metadata-Config

Files:

• lib/PS/IPP/Metadata/Config.pm (modified) (3 diffs)
• t/09_sdrs_type_example.t (modified) (4 diffs)

trunk/PS-IPP-Metadata-Config/lib/PS/IPP/Metadata/Config.pm

@@ -1 +1 @@
 # Copyright (c) 2005  Joshua Hoblitt
 #
-# $Id: Config.pm,v 1.6 2005-03-18 23:38:05 jhoblitt Exp $
+# $Id: Config.pm,v 1.7 2005-03-19 00:45:37 jhoblitt Exp $
 
 package PS::IPP::Metadata::Config;
@@ -155 +155 @@
 
 __DATA__
+
+{
+    use strict;
+    use warnings FATAL => qw( all );
+
+    use Carp qw( croak );
+}
 
 startrule: grammar
@@ -234 +241 @@
         {{
             class   => 'blank_line',
-            comment => $item{comment},
         }}
 
 typedef_declare:
-    <skip:'[ \t\r]*'> 'TYPE' <commit> name name(s) "\n"
+    <skip:'[ \t\r]*'> 'TYPE' <commit> name name(s) comment(?) "\n"
         {
             use Carp;
 
-            my $len = scalar @{ $item{'name(s)'} };
-
             if (defined $thisparser->{local}{typedef}{ $item{name} }) {
                 croak "refinition of TYPE $item{name}";    
             }
 
-            $thisparser->{local}{typedef}{ $item{name} } = $len;
-
-            $return = {
+            my $type = {
                 class   => 'typedef_declare',
                 name    => $item{name},
-                value   => $item{'name(s)'},
+                fields  => $item{'name(s)'},
+                length  => scalar @{ $item{'name(s)'} },
             };
-        }
-    | <skip:'[ \t\r]*'> 'TYPE' <commit> name name(s) comment "\n"
-        {{
-            class   => 'typedef_declare',
-            name    => $item{name},
-            value   => $item{'name(s)'},
-            comment => $item{comment},
-        }}
+
+            $thisparser->{local}{typedef}{ $item{name} } = $type;
+
+            # don't return anything in the parse tree
+            $return = { class => 'blank_line' };
+        }
 
 typedef:
-    <skip:'[ \t\r]*'> name typedef_type name(s) "\n"
+    <skip:'[ \t\r]*'> name typedef_type name(s) comment(?) "\n"
         {
+            my $type = $thisparser->{local}{typedef}{ $item{typedef_type} };
+
+            unless ( scalar @{ $item{'name(s)'} } == $type->{length} ) {
+                croak "\"$item{name} $item{typedef_type}\""
+                    . " does not have enough fields";
+            }
+
+            my @md;
+            my $i = 0;
+            foreach my $name ( @{ $type->{fields} } ) {
+                push @md, {
+                    name    => $name,
+                    class   => 'scalar',
+                    type    => 'STR',
+                    value   => $item{'name(s)'}[$i],
+                };
+
+                $i++;
+            }
+
             $return = {
-                class   => 'typedef',
+                class   => 'metadata',
                 name    => $item{name},
-                type    => $item{typedef_type},
-                value   => $item{'name(s)'},
+                value   => \@md,
             };
         }

trunk/PS-IPP-Metadata-Config/t/09_sdrs_type_example.t

@@ -3 +3 @@
 # Copyright (C) 2005  Joshua Hoblitt
 #
-# $Id: 09_sdrs_type_example.t,v 1.1 2005-03-15 04:41:44 jhoblitt Exp $
+# $Id: 09_sdrs_type_example.t,v 1.2 2005-03-19 00:45:37 jhoblitt Exp $
 
 use strict;
@@ -12 +12 @@
 #$::RD_TRACE = 1;
 
-use Test::More tests => 3;
+use Test::More tests => 5;
 use PS::IPP::Metadata::Config;
 
@@ -22 +22 @@
 
 {
-    my $pt = $config_parser->parse( $example[0] );
+    my $pt = $config_parser->parse( shift @example );
+    ok( defined( $pt ), "valid parase tree");
+}
+
+{
+    my $pt = $config_parser->parse( shift @example );
     ok( defined( $pt ), "valid parase tree");
 }
 
 eval {
-    my $pt = $config_parser->parse( $example[1] );
+    my $pt = $config_parser->parse( shift @example );
+};
+like( $@, qr/does not have enough fields/, "missing fields");
+
+eval {
+    my $pt = $config_parser->parse( shift @example );
 };
 like( $@, qr/refinition of TYPE/, "TYPE redefinition");
 
 eval {
-    my $pt = $config_parser->parse( $example[2] );
+    my $pt = $config_parser->parse( shift @example );
 };
 like( $@, qr/missing TYPE defintion/, "missing TYPE defnition");
@@ -39 +49 @@
 TYPE      CELL   EXTNAME   BIASSEC  CHIP
 CELL.00   CELL   CCD00     BSEC-00  CHIP.00
+CELL.01   CELL   CCD01     BSEC-01  CHIP.00
+%
+TYPE      CELL   EXTNAME   BIASSEC  CHIP    # comment
+CELL.00   CELL   CCD00     BSEC-00  CHIP.00 # foo
+CELL.01   CELL   CCD01     BSEC-01  CHIP.00 #
+%
+TYPE      CELL   EXTNAME   BIASSEC  CHIP
+CELL.00   CELL   CCD00     BSEC-00
 CELL.01   CELL   CCD01     BSEC-01  CHIP.00
 %