--- Everything.pm.orig    2004-10-24 13:22:35.843801600 +0200
+++ Everything.pm    2004-10-24 13:28:43.953116800 +0200
@@ -258,68 +258,202 @@
 
 
 #####################################################################
+########
-sub getVars
+#####################################################################
+########
 {
-    my ($NODE) = @_;
-    getRef $NODE;
 
-    return if ($NODE == -1);
+  # "$VARS" handling code
+  # -- Base operations
+  # $vars_string=packVars($ref);
+  # $ref=unpackVars($vars_string);
+  # -- Comparison
+  # If (cmpVarsStrs($a,$b)) { print "different" )
+  #
+  # -- Work with nodes
+  # my $ref=getVars($NODE,$field);
+  # my $update_ok=setVars($NODE,$ref,$field,$user);
+  # -- Compare at Node Level, promote as needed
+  # if (cmpVars($a,$b,$a_field,$b_field,$user)) { print "different" }
+  #
+  # For all routines, $user defaults to -1,
+  # $field type paramaters default to 'vars',
+  # all other parameters are required.
+  #
 
-    return {} unless $NODE->{vars};
+  my $PackVer = '==01';
 
-    my %vars = map { split /=/ } split (/&/, $$NODE{vars});
-    foreach (keys %vars) {
-        unescape $vars{$_};
-        if ($vars{$_} eq ' ') { $vars{$_} = ""; }
+#####################################################################
+########
+  sub packVars
+  {
+      my $varsref = $_[0];
+      return unless $varsref;
+
+      my $seenref = $_[1];
+
+      my $PV=!$seenref ? "$PackVer:" : "";
+      return if $seenref->{0+$varsref}++;
+
+      if (ref $varsref eq "HASH") {
+          return join "*", $PV."H",
+              map {
+                  my $v = $varsref->{$_};
+                  $v = ref $v
+                      ? packVars( $v, $seenref )
+                      : defined($v) ? "V$v" : "U";
+                  join '!',
+                      map { s/([*!#])/ sprintf '#%02x', ord($1) /ge; 
+$_}
+                          "V$_", $v;
+              } sort keys %$varsref;
+      } elsif (ref $varsref eq "ARRAY") {
+          return join "^", $PV."A",
+              map {
+                  my $v = ref $_
+                      ? packVars( $_, $seenref )
+                      : defined($_) ? "V$_" : "U";
+                  $v =~ s/([~^])/sprintf '~%02x', ord($1)/ge;
+                  $v;
+              } @$varsref;
+      } else {
+        printLog("Can't handle vars of type ".ref($varsref)."\n");
+        die "Can't handle vars of type ".ref($varsref)."\n";
     }
+  };
 
+#####################################################################
+########
+  sub unpackVars
+  {
+      my $vars_str = $_[0];
+      return {} unless defined $_[0] and length $vars_str;
+
+      my $depth    = $_[1]||0;
+
+
+      unless ($depth) {
+        # version 00: original format
+        # version 01: keys are escaped, not just values, handles nest
+ed refs.
+        $vars_str =~ s/^(==\d\d)://;
+        unless (defined $1) {
+          # No format/format version "00"
+          my %vars = map split(/=/, $_, 2), split /&/, $vars_str;
+          unescape( values %vars );
+          $vars{$_} eq ' ' and $vars{$_} = '' for keys %vars;
     return \%vars;
+        } elsif ($1 gt $PackVer) {
+          printLog("Version Error! $1 / $PackVer");
+          return "Version Error! $1 / $PackVer";
+        }
+      }
+
+      my $vars;
+      $vars_str =~ s/^([AHUV])(.)?//;
+      my ($type,$split)=($1,$2);
+
+      unless (defined $type) {
+          printLog("Undefined type in unpackVars()");
+          return "Error undef type";
+      } elsif ($type eq 'H') {
+          for (split /\Q$split\E/, $vars_str) {
+            my ($k,$v)= split /!/, $_, 2;
+            for ( $k,$v ) {
+              s/#(\w\w)/ chr(hex($1)) /ge;
+              if ($_ eq 'U') {
+                $_ = undef;
+              } elsif (substr($_,0,1) eq 'V') {
+                $_ = substr($_,1);
+              } else {
+                $_= unpackVars($_,$depth+1);
+              }
+            }
+            $vars->{$k} = $v;
+          }
+      } elsif ($type eq 'A') {
+          for (split /\Q$split\E/, $vars_str) {
+              s/~(\w\w)/ chr(hex($1)) /ge;
+              push @$vars, $_ eq 'U'
+                           ? undef
+                           : substr($_,0,1) eq 'V'
+                             ? substr($_,1)
+                             : unpackVars($_,$depth+1);
 }
+      } elsif ($type eq 'U') {
+        return undef;
+      } elsif ($type eq 'V') {
+        return $split.$vars_str;
+      } else {
+        printLog("unknown type '$type' in unpackVars()");
+        return "unknown type '$type' in unpackVars()";
+      }
+      return $vars;
+  };
 
 #####################################################################
+########
-#   Sub
-#       setVars
-#
-#   Purpose
-#       This takes a hash of variables and assigns it to the 'vars' o
+f the
-#       given node.  If the new vars are different, we will update th
+e
-#       node.
-#
-#   Parameters
-#       $NODE - a node id or hash of a node that joins on the
-#       "settings" table which has a "vars" field to assign the vars 
+to.
-#       $varsref - the hashref to get the vars from
-#
-#   Returns
-#       Nothing
-#
-sub setVars
+  sub cmpVarsStrs
 {
-    my ($NODE, $varsref) = @_;
-    my $str;
+      my ($var1str, $var2str) = @_;
 
-    getRef($NODE);
+      return 0 if $var1str eq $var2str;
 
-    unless (exists $$NODE{vars}) {
-        warn ("setVars:\t'vars' field does not exist for node ".getId
+($NODE)."
-        perhaps it doesn't join on the settings table?\n");
+      # upgrade to new version
+      /^$PackVer:/ or $_ = packVars( unpackVars( $_ ) )
+          for ($var1str, $var2str);
+
+      return $var1str cmp $var2str;
+  };
+
+#####################################################################
+########
+  sub cmpVars
+  {
+      my ($vars1, $vars2, $field1, $field2, $user) = @_;
+      $field1='vars' unless defined $field1;
+      $field2='vars' unless defined $field2;
+
+      return 0 if $vars1->{$field1} eq $vars2->{$field2};
+      # upgrade to new version
+      unless ($vars1->{$field1}=~/^$PackVer:/) {
+        setVars($vars1, unpackVars($vars1->{$field1}), $field1, $user
+);
     }
+      unless ($vars2->{$field2}=~/^$PackVer:/) {
+        setVars($vars2, unpackVars($vars2->{$field2}), $field2, $user
+);
+      }
+      return $vars1->{$field1} cmp $vars2->{$field2};
+  };
 
-    # Clean out the keys that have do not have a value.
-    foreach (keys %$varsref) {
-        $$varsref{$_} = " " unless $$varsref{$_};
+#####################################################################
+########
+  sub getVars
+  {
+      my ($NODE,$field) = @_;
+      $field||='vars';
+
+      getRef $NODE unless ref $NODE;
+      return if ($NODE == -1);
+     return unpackVars($NODE->{$field});
+  };
+
+#####################################################################
+########
+  sub setVars
+  {
+      my ($NODE, $varsref, $field, $user) = @_;
+      $field = 'vars' unless defined $field;
+      $user  = -1 unless defined $user;
+
+      getRef $NODE unless ref $NODE;
+      unless (exists $NODE->{$field}) {
+          warn ("setVars:\t'$field' field does not exist for node ".g
+etId($NODE)
+               ."perhaps it doesn't join on the table?\n");
     }
 
-    $str = join("&", map( $_."=".escape($$varsref{$_}), keys %$varsre
+f) );
+      my $str = packVars($varsref);
 
-    return unless ($str ne $$NODE{vars}); #we don't need to update...
+      return unless ($str ne $NODE->{$field}); #we don't need to upda
+te...
 
     # The new vars are different from what this user node contains, f
+orce
     # an update on the user info.
-    $$NODE{vars} = $str;
-    my $superuser = -1;
-    $DB->updateNode($NODE, $superuser);
+      $NODE->{$field} = $str;
+      $DB->updateNode( $NODE, $user );
+  };
 }
+#####################################################################
+########
+#####################################################################
+########
+
 
 
 #####################################################################
+########
[download]