Changeset 27756 for trunk/PS-IPP-Metadata-Config/lib/PS/IPP/Metadata/Config.pm

Timestamp:

Apr 23, 2010, 12:15:45 PM (16 years ago)

Author:

Paul Price

Message:

Adding function to parse a list of METADATAs. Breaking them up makes the parsing MUCH faster!

File:

• trunk/PS-IPP-Metadata-Config/lib/PS/IPP/Metadata/Config.pm (modified) (3 diffs)

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

@@ -59 +59 @@
 }
 
+# Parse a list of METADATAs
+sub parse_list
+{
+    my $self = shift;           # This parser
+
+    # Split input into separate METADATAs because the parser seems to take forever handling those together
+    my @whole = split /\n/, join( '', @_ ); # The whole input
+    my @single;                             # A single METADATA element
+    my @output;                             # Output
+    foreach my $value (@whole) {
+        push @single, $value;
+        if ($value =~ /^\s*END\s*$/) {
+            push @single, "\n";
+
+            my $md = join("\n", @single); # Metadata to parse
+            my $parsed = $self->parse($md) or (carp "Unable to parse input: $md\n" and next);
+            (carp "More than one entry in input: $md\n" and next) if scalar @$parsed > 1;
+            my $metadata = shift @$parsed; # Metadata of interest
+            (carp "MD element is not of type METADATA: $md\n" and next) if $metadata->{class} ne "metadata";
+            my $components = $metadata->{value}; # Components of metadata
+            my %hash;           # Hash for entry
+            foreach my $comp (@$components) {
+                $hash{$comp->{name}} = $comp->{value};
+            }
+            push @output, \%hash;
+            @single = ();
+        }
+    }
+
+    return \@output;
+}
+
 sub _merge_duplicates {
     my ( $self, $tree ) = @_;
@@ -73 +105 @@
         # stop if the prevous pass removed the last element and called redo
         last unless defined $elem;
-                
+
         # recurse through nested metadata
         if ( $elem->{class} eq "metadata" ) {
@@ -83 +115 @@
             delete $elem->{multi};
             next;
-        } 
+        }
 
         if ( defined $names{ $elem->{name} } ) {