######################################################################
+#######
######################################################################
+#######
{

  # "$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.
  #

  my $PackVer = '==01';

######################################################################
+#######
  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 neste
+d 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 cmpVarsStrs
  {
      my ($var1str, $var2str) = @_;

      return 0 if $var1str eq $var2str;

      # 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};
  };

######################################################################
+#######
  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 ".ge
+tId($NODE)
               ."perhaps it doesn't join on the table?\n");
      }

      my $str = packVars($varsref);

      return unless ($str ne $NODE->{$field}); #we don't need to updat
+e...

      # The new vars are different from what this user node contains, 
+force
      # an update on the user info.
      $NODE->{$field} = $str;
      $DB->updateNode( $NODE, $user );
  };
}
######################################################################
+#######
######################################################################
+#######
[download]