Changeset 29679

Timestamp:

2015-01-09T14:50:58+13:00 (9 years ago)

Author:

Jeremy Symon

Message:

Switch to an Ordered Hash to stop the XML files from being scrambled

Location:

main/trunk/package-kits/scripts

Files:

• gs-servlet.pl (modified) (3 diffs)
• perllib/Greenstone/XML/Tidy.pm (modified) (7 diffs)
• perllib/Hash (added)
• perllib/Hash/Ordered (added)
• perllib/Hash/Ordered.pm (added)
• perllib/Hash/Ordered/Benchmarks.pod (added)

main/trunk/package-kits/scripts/gs-servlet.pl

@@ -11 +11 @@
 use Greenstone::XML::Tidy;
 
-my $hash;
+my $hash = Hash::Ordered->new;
 my %commands;
 # Command structure:
@@ -32 +32 @@
         'Clears the internal state',
         sub {
-            undef $hash;
-            $hash = {};
+            $hash = Hash::Ordered->new;
         }
     ],
@@ -41 +40 @@
             my $new = read_xml shift @ARGV;
             # Append the new data to the current data
-            for my $key (keys %$new) {
-                if ($key eq '.attr' and exists $hash->{'.attr'}) {
-                    for my $attr ($new->{'.attr'}) {
-                        $hash->{'.attr'}->{$attr} = $new->{'.attr'}->{$attr};
+            for my $key ($new->keys) {
+                if ($key eq '.attr' and $hash->exists ('.attr')) {
+                    my $existing_attr = $hash->get ('.attr');
+                    my $new_attr      = $new->get ('.attr');
+                    for my $attr ($new_attr->keys) {
+                        $existing_attr->set ($attr => $new_attr->get ($attr));
                     }
-                } elsif (exists $hash->{$key}) {
-                    if (ref $hash->{$key} ne 'ARRAY') {
-                        $hash->{$key} = [ $hash->{$key} ];
+                } elsif ($hash->exists ($key)) {
+                    my $existing = $hash->get ($key);
+                    if (ref $existing ne 'ARRAY') {
+                        $existing = [ $existing ];
+                        $hash->set ($key => $existing);
                     }
-                    push @{$hash->{$key}},
-                        (ref $new->{$key} eq 'ARRAY' ? @{$new->{$key}} : $new->{$key});
+                    my $new_val = $new->get ($key);
+                    push @{$existing},
+                        (ref $new_val eq 'ARRAY' ? @{$new_val} : $new_val);
                 } else {
-                    $hash->{$key} = $new->{$key};
+                    $hash->set ($key => $new->get ($key));
                 }
             }

main/trunk/package-kits/scripts/perllib/Greenstone/XML/Tidy.pm

@@ -6 +6 @@
 use XML::Parser;
 use POSIX 'isatty';
+use Hash::Ordered;
 use base 'Exporter';
 
@@ -70 +71 @@
 
     sub tidy {
-        my %hash;
+        my $hash = Hash::Ordered->new;
         # If the element has attributes, add them to the hash
         my $attr = shift;
         if (scalar keys %$attr > 0) {
-            $hash{'.attr'} = $attr;
+            $hash->set ('.attr' => Hash::Ordered->new ($attr));
         }
         # Read any child elements or text value
@@ -81 +82 @@
             my $value   = shift;
             if ($element eq 0) {
-                $value =~ /^\s*$/ || ($hash{'.value'} .= $value);
+                unless ($value =~ /^\s*$/) {
+                    my $existing = $hash->get ('.value');
+                    defined $existing and ($value .= $existing);
+                    $hash->set ('.value' => $value);
+                }
             } else {
                 # If there is more than one of a single tupe of child element,
                 # That child element must become an array
-                if (defined $hash{$element}) {
-                    unless (ref $hash{$element} eq 'ARRAY') {
-                        $hash{$element} = [ $hash{$element} ];
+                if ($hash->exists ($element)) {
+                    my $existing = $hash->get ($element);
+                    unless (ref $existing eq 'ARRAY') {
+                        $hash->set ($element => [ $existing ]);
                     }
-                    push @{$hash{$element}}, tidy (@{$value});
+                    push @{$hash->get ($element)}, tidy (@{$value});
                 } else {
-                    $hash{$element} = tidy (@{$value});
+                    $hash->set ($element => tidy (@{$value}));
                 }
             }
         }
         # If the element only has a value, it can become a scalar
-        if (scalar keys %hash == 1 and defined $hash{'.value'}) {
-            return $hash{'.value'};
+        if (scalar $hash->keys == 1 and $hash->exists ('.value')) {
+            return $hash->get ('.value');
         }
-        return \%hash;
+        return $hash;
     }
     return tidy (@{@$data[1]});
@@ -119 +125 @@
         print $indent, "<", $tag;
         if (defined $attr) {
-            for my $key (sort keys %$attr) {
-                print " ", $key, '="', $attr->{$key}, '"';
+            for my $key ($attr->keys) {
+                print " ", $key, '="', $attr->get ($key), '"';
             }
         }
@@ -127 +133 @@
     sub write_element {
         my ($indent, $hash) = @_;
-        for my $key (sort keys %$hash) {
+        for my $key ($hash->keys) {
             $key eq '.attr' && next;
-            my $val = $hash->{$key};
+            my $val = $hash->get ($key);
             $key eq '.value' && do {
                 print $val, "\n";
@@ -137 +143 @@
                 /^ARRAY$/ && do {
                     for my $element (@$val) {
-                        open_tag ($indent, $key, $element->{'.attr'});
+                        open_tag ($indent, $key, $element->get ('.attr'));
                         for (ref $element) {
-                            /^HASH$/ && do {
+                            /^Hash::Ordered$/ && do {
                                 print "\n";
                                 write_element ("  $indent", $element);
@@ -150 +156 @@
                     last;
                 };
-                /^HASH$/ && do {
-                    open_tag ($indent, $key, $val->{'.attr'});
+                /^Hash::Ordered$/ && do {
+                    open_tag ($indent, $key, $val->get ('.attr'));
                     # If the element only has a value with attributes,
                     # it can be formatted on one line
-                    if (scalar keys %$val == 2 and defined $val->{'.value'}) {
-                        print $val->{'.value'}, "</", $key, ">\n";
+                    if (scalar keys %$val == 2 and $val->exists ('.value')) {
+                        print $val->get ('.value'), "</", $key, ">\n";
                     } else {
                         print "\n";