That patch was bad; somehow a newline disappeard in my old copy. Also, the 2nd chunk seems to now be already applied.
Trying again:
--- old/Everything.pm 2004-11-07 08:36:56.562504000 -0800
+++ new/Everything.pm 2004-11-07 08:36:26.088684800 -0800
@@ -256,71 +256,202 @@ sub unescape
1;
}
-
#####################################################################
+########
-sub getVars
+#####################################################################
+########
{
- my ($NODE) = @_;
- getRef $NODE;
- return if ($NODE == -1);
-
- return {} unless $NODE->{vars};
-
- my %vars = map { split /=/ } split (/&/, $$NODE{vars});
- foreach (keys %vars) {
- unescape $vars{$_};
- if ($vars{$_} eq ' ') { $vars{$_} = ""; }
- }
+ # "$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 nest
+ed refs.
+ unless ($vars_str =~ s/^(==\d\d)://) {
+ # 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";
+ }
+ }
- return \%vars;
+ my $vars;
+ my ($type,$split);
+ ($type,$split) = ($1,$2) if $vars_str =~ s/^([AHUV])(.)?//;
+
+ 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 ".g
+etId($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 upda
+te...
+
+ # 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 );
+ };
}
-
-
#####################################################################
+########
-# 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
-{
- my ($NODE, $varsref) = @_;
- my $str;
-
- getRef($NODE);
-
- 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");
- }
-
- # Clean out the keys that have do not have a value.
- foreach (keys %$varsref) {
- $$varsref{$_} = " " unless $$varsref{$_};
- }
-
- $str = join("&", map( $_."=".escape($$varsref{$_}), keys %$varsre
+f) );
-
- return unless ($str ne $$NODE{vars}); #we don't need to update...
+#####################################################################
+########
- # 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);
-}
#####################################################################
+########
|