Nodal-hash.pl
From Organic Design wiki
#!/usr/bin/perl
# The main peerd script could load the space, then insert a peer-init sequence
# - INIT does servicate/daemonise, config, server... even peer-ctl
# - thats how the nodal core becomes the guts of peerd
# - ROOT contains the main "daemons": CRON, serverIterate, POP etc
# WE still need our own tie (not Tie:RefHash) because our structure contains SUBJECT,OBJECT,CONTENT
use Carp;
use Scalar::Util qw( refaddr );
use strict;
# Constants used internally by tied-array
use constant SUBJECT => 0;
use constant CONTENT => 1;
use constant OBJECT => 2;
# Nodes needed for nodal operation
use constant ROOT => 0;
use constant GUID => 1;
use constant NAME => 2;
use constant CODE => 3;
use constant LANG => 4;
use constant PERL => 5;
use constant PEER => 6;
use constant FILE => 7;
use constant TEXT => 8;
use constant NODE => 9;
use constant INIT => 10;
use constant ONCREATE => 11;
use constant ONDELETE => 12;
use constant ONCHANGE => 13;
use constant ONREAD => 14;
use constant ONSHIFT => 15;
use constant ONPUSH => 16;
use constant ONEXTEND => 17;
# Space used internally by NodalHash and its functions
our %data = ();
# ----------------------------------------------------------------------------------------------------------- #
package NodalHash;
sub TIEHASH {
my $class = shift;
my $this = [];
bless $this, $class;
$this->STORE(shift, shift) while @_;
return $this;
}
sub FETCH {
my ( $this, $key ) = @_;
if ( ref $key ) { defined $$this[0]{$key} ? $$this[0]{$key}[1] : undef }
else { $$this[1]{$key} }
}
sub STORE {
my ( $this, $key, $val ) = @_;
if ( ref $val eq 'HASH' and not tied %$val ) {
my @elems = %$val;
tie %$val, ref $this, @elems;
}
ref $key ? $$this[0]{$key} = [ $key, $val ] : $$this[1]{$key} = $val;
$val;
}
sub DELETE {
my( $this, $key ) = @_;
ref $key
? ( delete( $$this[0]{$key} ) || [])->[1]
: delete( $this->[1]{$key} );
}
sub EXISTS {
my ( $this, $key ) = @_;
ref $key ? exists( $$this[0]{$key} ) : exists( $$this[1]{$key} );
}
sub FIRSTKEY {
my $this = shift;
keys %{ $$this[0] }; # reset iterator
keys %{ $$this[1] }; # reset iterator
$$this[2] = 0; # flag for iteration, see NEXTKEY
$this->NEXTKEY;
}
sub NEXTKEY {
my $this = shift;
my ( $key, $val );
if ( !$$this[2] ) { return $$val[0] if ( $key, $val ) = each %{ $$this[0] } }
else { $$this[2] = 1 }
return each %{ $$this[1] };
}
sub CLEAR {
my $this = shift;
$this->[2] = 0;
%{ $this->[0] } = ();
%{ $this->[1] } = ();
}
sub shift {
# Reduce from %root
}
sub push {
}
sub save {
}
sub load {
}
# ----------------------------------------------------------------------------------------------------------- #
package main;
my $y = tie my %root, 'NodalHash';
#my $y = \%root;
my $x = \ "hello";
$root{$x} = 'world';
$y->push;
#print "$$_\n" for keys %root;