Rate   old  new
old   115/s    -- -47%
new   215/s   87%   --

##</code><code>##

     Rate  old  new
old 107/s   -- -61%
new 271/s 153%   --

##</code><code>##

L: 11549>external_user=demerphq&scratchpublic=%20
L: 6902 >==01:H&DomainNodeletExtras=&allow_dupe_p

##</code><code>##


use Data::Dump::Streamer;
use strict;
use warnings;

{
no warnings 'uninitialized';

#===
sub escape
{
    my ($esc) = @_;

    $esc =~ s/(\W)/sprintf("%%%02x",ord($1))/ge;

    return $esc;
}

sub unescape
{
    foreach my $arg (@_)
    {
        tr/+/ /;
        $arg =~ s/\%(..)/chr(hex($1))/ge;
    }

    1;
}

#############################################################################
sub gVars
{
    my $varstr=shift;
    my %vars = map { split /=/ } split (/&/, $varstr);
    foreach (keys %vars) {
        unescape $vars{$_};
        if ($vars{$_} eq ' ') { $vars{$_} = ""; }
    }
    return \%vars;
}

sub sVars
{
    my ($varsref) = @_;

    # Clean out the keys that have do not have a value.
    foreach (keys %$varsref) {
        $$varsref{$_} = " " unless $$varsref{$_};
    }

    return join("&", map( $_."=".escape($$varsref{$_}), keys %$varsref) );

}
}
#===



my $PackVer="==01";

sub packVars
{
    my $varsref = $_[0];
    my $seenref = $_[1];

    return unless $varsref;
    return if $seenref->{0+$varsref}++;

    if (eval { ($varsref->[0]||1) }) {
      return join "^","$PackVer:A",
             map {
              my $typ;
              my $v=ref $_ ? packVars( $_, $seenref )  : defined($_) ? $_ : '';
              $v=~s/([~^=])/sprintf '~%02x', ord($1)/ge;
              $v;
             } @$varsref;
    } elsif (eval { ($varsref->{''}||1) }) {
      return join "&", "$PackVer:H",
        map {
            my $v = $varsref->{$_};
            $v=ref $v ? packVars( $v, $seenref )  : defined($v) ? $v : '';
            join '=',
                map {s/([%&=])/ sprintf '%%%02x', ord($1) /ge; $_}
                    $_, $v;
        } sort keys %$varsref;
    } else {
      die "Can't handle vars of type ".ref($varsref)."\n";
    }
}

sub unpackVars
{
    my $vars_str = $_[0];
    return {} unless $vars_str;

    # version 00: original format
    # version 01: keys are escaped, not just values, handles nested refs.

    my $vars;

    #print "$vars_str\n";

    $vars_str =~ s/^(==\d\d):([AH])(.)//;
    my ($format_version,$type,$split)=($1,$2,$3);

    #print "$format_version : $type : $split\n";

    unless (defined $format_version) {
        # 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 ($format_version le $PackVer) {
      if ($type eq 'H') {
          for (split /\Q$split\E/, $vars_str) {
              my ($k,$v) = map { s/%(\w\w)/ chr(hex($1)) /ge; $_ }
                           split /=/, $_, -1;

              # special data to unpack?
              if ($v=~/^==\d\d:[AH]/) {
                  # nested value
                  $v = unpackVars($v);
              }
              $vars->{$k} = $v;

          }
      } elsif ($type eq 'A') {
          for (split /\Q$split\E/, $vars_str) {
            s/~(\w\w)/ chr(hex($1)) /ge;
            # special data to unpack?
            if (/^==\d\d:[AH]/) {
                # nested value
                $_ = unpackVars($_);
            }
            push @{$vars},$_;
          }
      } else {
        return "Unknown type! $type";
      }
    } else {
      return "Version number too high! ($format_version gt $PackVer)";
    }
    return $vars;
}

sub cmpVars
{
    my ($var1str, $var2str) = @_;

    my $v1new=$var1str =~ /^==\d\d:[AH]/;
    my $v2new=$var2str =~ /^==\d\d:[AH]/;

    if ($v1new eq $v2new) {
      return $var1str cmp $var2str;
    } else {
      return ( $v1new ? $var1str : packVars( unpackVars ( $var1str ) ) )
             cmp
             ( $v2new ? $var2str : packVars( unpackVars ( $var2str ) ) )
    }

}

sub _p_str {
  foreach my $str (@_) {
    print "L: ".length($str)." >".substr($str,0,40)."\n";
  }
}

$|++;
my $txt=do{open my $fh,"<","./dem_vars.txt"; local $/; <$fh>};
my $hash=unpackVars($txt);
my $newtxt=packVars($hash);
my $newhash=unpackVars($newtxt);
my $newpack=packVars($newhash);
my $newnewhash=unpackVars($newpack);
my $newnewpack=packVars($newnewhash);
_p_str($txt,$newtxt,$newpack,$newnewpack);
my $n_dump=Dump($newhash)->Out();
my $h_dump=Dump($hash)->Out();
my $nn_dump=Dump($newnewhash)->Out();

if ($n_dump ne $h_dump) {
  print "N - H: Different!\n";
} else {
  print "N - H: Same!\n";
}
if ($nn_dump ne $h_dump) {
  print "NN - H: Different!\n";
} else {
  print "NN - H: Same!\n";
}
if ($nn_dump ne $n_dump) {
  print "NN - N: Different!\n";
} else {
  print "NN - N: Same!\n";
}
use Benchmark qw(cmpthese);
cmpthese -5,{
              old => sub { my $h=gVars($txt); my $str=sVars($h); },
              new_c => sub { my $h=unpackVars($txt); my $str=packVars($h); },
              new => sub { my $h=unpackVars($txt); my $str=packVars($h); },
            };

##</code><code>##

my $PackVer="==01";

local *unescape=*Everything::unescape;
local *packVars=sub
{
    my $varsref = $_[0];
    my $seenref = $_[1];

    return unless $varsref;
    return if $seenref->{0+$varsref}++;

    if (eval { ($varsref->[0]||1) }) {
      return join "^","$PackVer:A",
             map {
              my $typ;
              my $v=ref $_ ? packVars( $_, $seenref )  : defined($_) ? $_ : '';
              $v=~s/([~^=])/sprintf '~%02x', ord($1)/ge;
              $v;
             } @$varsref;
    } elsif (eval { ($varsref->{''}||1) }) {
      return join "&", "$PackVer:H",
        map {
            my $v = $varsref->{$_};
            $v=ref $v ? packVars( $v, $seenref )  : defined($v) ? $v : '';
            join '=',
                map {s/([%&=])/ sprintf '%%%02x', ord($1) /ge; $_}
                    $_, $v;
        } sort keys %$varsref;
    } else {
      die "Can't handle vars of type ".ref($varsref)."\n";
    }
};

local *unpackVars=sub
{
    my $vars_str = $_[0];
    return {} unless $vars_str;

    # version 00: original format
    # version 01: keys are escaped, not just values, handles nested refs.

    my $vars;

    #print "$vars_str\n";

    $vars_str =~ s/^(==\d\d):([AH])(.)//;
    my ($format_version,$type,$split)=($1,$2,$3);

    #print "$format_version : $type : $split\n";

    unless (defined $format_version) {
        # 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 ($format_version le $PackVer) {
      if ($type eq 'H') {
          for (split /\Q$split\E/, $vars_str) {
              my ($k,$v) = map { s/%(\w\w)/ chr(hex($1)) /ge; $_ }
                           split /=/, $_, -1;

              # special data to unpack?
              if ($v=~/^==\d\d:[AH]/) {
                  # nested value
                  $v = unpackVars($v);
              }
              $vars->{$k} = $v;

          }
      } elsif ($type eq 'A') {
          for (split /\Q$split\E/, $vars_str) {
            s/~(\w\w)/ chr(hex($1)) /ge;
            # special data to unpack?
            if (/^==\d\d:[AH]/) {
                # nested value
                $_ = unpackVars($_);
            }
            push @{$vars},$_;
          }
      } else {
        return "Unknown type! $type";
      }
    } else {
      return "Version number too high! ($format_version gt $PackVer)";
    }
    return $vars;
};

local *cmpVars=sub
{
    my ($var1str, $var2str) = @_;

    my $v1new=$var1str =~ /^==\d\d:[AH]/;
    my $v2new=$var2str =~ /^==\d\d:[AH]/;

    if ($v1new eq $v2new) {
      return $var1str cmp $var2str;
    } else {
      return ( $v1new ? $var1str : packVars( unpackVars ( $var1str ) ) )
             cmp
             ( $v2new ? $var2str : packVars( unpackVars ( $var2str ) ) )
    }

};

local *_p_str=sub  {
  foreach my $str (@_) {
    print "L: ".length($str)." >".substr($str,0,40)."\n";
  }
};

local *new_getVars=sub
{
    my ($NODE) = @_;
    getRef $NODE;

    return if ($NODE == -1);

    return unpackVars($NODE->{vars});
};

local *new_setVars=sub
{
    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");
    }

    $str = packVars($varsref);

    return unless ($str ne $$NODE{vars}); #we don't need to update...

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

#[id://399747]
#[id://396815]

my $NODE1=getNodeById(399747);
my $NODE2=getNodeById(396815);
use Benchmark qw(cmpthese);
cmpthese -1,
{
 old => sub { my $h=getVars($NODE1); $h->{_test}++; setVars($NODE1,$h); },
 new => sub { my $h=new_getVars($NODE2); $h->{_test}++; new_setVars($NODE2,$h); },
};