Changeset 2607 in ProjectBuilder for devel/pb-modules/lib/ProjectBuilder/YAML.pm

Timestamp:

Apr 7, 2020, 1:03:01 AM (4 years ago)

Author:

Bruno Cornec

Message:

Fix YAML pb_Dump function, adds a test for embedded YAML, export PBCONFVER from Version and fix sles 10 sudoers

File:

• devel/pb-modules/lib/ProjectBuilder/YAML.pm (modified) (13 diffs)

devel/pb-modules/lib/ProjectBuilder/YAML.pm

@@ -7 +7 @@
 # We rename it here to allow embedded usage during setupv 
 # when no YAML implementation is available on the target system
+# We also made modifications to avoid object usage conflicting in setupv
+# and changed pb_Dump to adapt to new parameters
 #
 package ProjectBuilder::YAML;
@@ -116 +118 @@
 sub _load_file {
     # Check the file
-    #print("SPECIAL: loadfile ".Dumper(@_)."\n");
+    #print("SPECIAL: loadfile ".Data::Dumper::Dumper(@_)."\n");
     my $file = shift or _error( 'You did not specify a file name' );
     _error( "File '$file' does not exist" )
@@ -157 +159 @@
 # Create an object from a string
 sub _load_string {
-        #print("SPECIAL: loadstring ".Dumper(@_)."\n");
+        #print("SPECIAL: loadstring ".Data::Dumper::Dumper(@_)."\n");
     my $self   = [];
     my $string = $_[0];
@@ -271 +273 @@
 # Load a YAML scalar string to the actual Perl scalar
 sub _load_scalar {
-        #print("SPECIAL: loadscalar ".Dumper(@_)."\n");
+        #print("SPECIAL: loadscalar ".Data::Dumper::Dumper(@_)."\n");
     my ($string, $indent, $lines) = @_;
 
@@ -341 +343 @@
 # Load an array
 sub _load_array {
-        #print("SPECIAL: loadarray ".Dumper(@_)."\n");
+        #print("SPECIAL: loadarray ".Data::Dumper::Dumper(@_)."\n");
     my ($array, $indent, $lines) = @_;
 
@@ -424 +426 @@
 # Load a hash
 sub _load_hash {
-        #print("SPECIAL: loadhash ".Dumper(@_)."\n");
+        #print("SPECIAL: loadhash ".Data::Dumper::Dumper(@_)."\n");
     my ($hash, $indent, $lines) = @_;
 
@@ -512 +514 @@
 
 
-###
-# Dumper functions:
-
 # Save an object to a string
 sub _dump_string {
-        #print("SPECIAL: dumpstring ".Dumper(@_)."\n");
-    my $self = shift;
-    return '' unless ref $self && @$self;
+    my $self = $_[0];
+    return '' unless ref $self && %$self;
+
+    #print("SPECIAL: dumpstring ".Data::Dumper::Dumper($self)."\n");
 
     # Iterate over the documents
     my $indent = 0;
     my @lines  = ();
+    push @lines, '---';
 
     eval {
-        foreach my $cursor ( @$self ) {
-            push @lines, '---';
+        foreach my $c ( sort keys %$self ) {
+            my $cursor = $self->{$c};
+            #print("SPECIAL: c, cursor ".Data::Dumper::Dumper($c,$cursor)."\n");
+            push(@lines, _dump_scalar( $c, $cursor).':');
+            $indent += 1;
 
             # An empty document
@@ -535 +539 @@
             # A scalar document
             } elsif ( ! ref $cursor ) {
-                $lines[-1] .= ' ' . _dump_scalar( $cursor );
+                    #print("SPECIAL: found scalar \n");
+                $lines[-1] .= ' ' . _dump_scalar( $c, $cursor );
+                #print("SPECIAL: dumpscalar returns".Data::Dumper::Dumper($lines[-1])."\n");
 
             # A list at the root
             } elsif ( ref $cursor eq 'ARRAY' ) {
+                    #print("SPECIAL: found array \n");
                 unless ( @$cursor ) {
                     $lines[-1] .= ' []';
                     next;
                 }
-                push @lines, _dump_array( $cursor, $indent, {} );
+                push @lines, _dump_array( $c, $cursor, $indent, {} );
 
             # A hash at the root
             } elsif ( ref $cursor eq 'HASH' ) {
+                    #print("SPECIAL: found hash \n");
                 unless ( %$cursor ) {
                     $lines[-1] .= ' {}';
                     next;
                 }
-                push @lines, _dump_hash( $cursor, $indent, {} );
+                push @lines, _dump_hash( $c, $cursor, $indent, {} );
 
             } else {
                 die \("Cannot serialize " . ref($cursor));
             }
+            #print("SPECIAL: lines ".Data::Dumper::Dumper(@lines)."\n");
+            $indent -= 1;
         }
     };
@@ -574 +584 @@
 
 sub _dump_scalar {
-        #print("SPECIAL: dumpscalar ".Dumper(@_)."\n");
-    my $string = $_[1];
-    my $is_key = $_[2];
+        #print("SPECIAL: dumpscalar ".Data::Dumper::Dumper(@_)."\n");
+    my $string = $_[0];
+    #print("SPECIAL: string ".Data::Dumper::Dumper($string)."\n");
+    my $is_key = $_[1];
     # Check this before checking length or it winds up looking like a string!
     my $has_string_flag = _has_internal_string_value($string);
+    #print("SPECIAL: hasstring ".Data::Dumper::Dumper($has_string_flag)."\n");
     return '~'  unless defined $string;
     return "''" unless length  $string;
@@ -608 +620 @@
 
 sub _dump_array {
-        #print("SPECIAL: dumparray ".Dumper(@_)."\n");
+        #print("SPECIAL: dumparray ".Data::Dumper::Dumper(@_)."\n");
     my ($array, $indent, $seen) = @_;
     if ( $seen->{refaddr($array)}++ ) {
@@ -648 +660 @@
 
 sub _dump_hash {
-        #print("SPECIAL: dumphash ".Dumper(@_)."\n");
-    my ($hash, $indent, $seen) = @_;
+        #print("SPECIAL: dumphash ".Data::Dumper::Dumper(@_)."\n");
+    my ($c, $hash, $indent, $seen) = @_;
     if ( $seen->{refaddr($hash)}++ ) {
         die \"ProjectBuilder::YAML does not support circular references";
@@ -683 +695 @@
             die \"ProjectBuilder::YAML does not support $type references";
         }
+        #print("SPECIAL: lines ".Data::Dumper::Dumper(@lines)."\n");
     }
 
@@ -700 +713 @@
     require Carp;
     $errstr = $_[0];
-    #print("SPECIAL: error: ".Dumper(@_)."\n");
+    #print("SPECIAL: error: ".Data::Dumper::Dumper(@_)."\n");
     #$errstr =~ s/ at \S+ line \d+.*//;
     Carp::croak( $errstr );