#!/usr/bin/perl
my %data;
my %externalized_functions;
my %datatypes;

sub meta::define_form {
  my ($namespace, $delegate) = @_;
  $datatypes{$namespace} = $delegate;
  *{"meta::${namespace}::implementation"} = $delegate;
  *{"meta::$namespace"} = sub {
    my ($name, $value) = @_;
    chomp $value;
    $data{"${namespace}::$name"} = $value;
    $delegate->($name, $value);
  };
}

meta::define_form 'meta', sub {
  my ($name, $value) = @_;
  eval $value;
};

meta::meta('externalize', <<'EOF');
sub meta::externalize {
  my ($name, $attribute, $implementation) = @_;
  $externalized_functions{$name} = $attribute;
  *{$name} = $implementation;
}
EOF

meta::meta('type::bootstrap', <<'EOF');
meta::define_form 'bootstrap', sub {};
EOF

meta::meta('type::function', <<'EOF');
meta::define_form 'function', sub {
  my ($name, $body) = @_;
  meta::externalize $name, "function::$name", eval "sub {\n$body\n}";
};
EOF

meta::meta('type::internal_function', <<'EOF');
meta::define_form 'internal_function', sub {
  my ($name, $value) = @_;
  *{$name} = eval "sub {\n$value\n}";
};
EOF

meta::meta('type::data', <<'EOF');
meta::define_form 'data', sub {
  # Define a basic editing interface:
  my ($name, $value) = @_;
  meta::externalize $name, "data::$name", sub {
    my ($command, $value) = @_;
    return $data{"data::$name"} unless @_;
    $data{"data::$name"} = $value if $command eq '=';
  };
};
EOF

meta::bootstrap('initialization', <<'EOF');
#!/usr/bin/perl
my %data;
my %externalized_functions;
my %datatypes;

sub meta::define_form {
  my ($namespace, $delegate) = @_;
  $datatypes{$namespace} = $delegate;
  *{"meta::${namespace}::implementation"} = $delegate;
  *{"meta::$namespace"} = sub {
    my ($name, $value) = @_;
    chomp $value;
    $data{"${namespace}::$name"} = $value;
    $delegate->($name, $value);
  };
}

meta::define_form 'meta', sub {
  my ($name, $value) = @_;
  eval $value;
};
EOF

meta::data('default-action', <<'EOF');
shell
EOF

meta::internal_function('namespace', <<'EOF');
my ($name) = @_;
$name =~ s/::.*$//;
$name;
EOF

meta::internal_function('attribute', <<'EOF');
my ($name) = @_;
$name =~ s/^[^:]*:://;
$name;
EOF

meta::internal_function('retrieve', <<'EOF');
my @results = map defined $data{$_} ? $data{$_} : file::read($_), @_;
wantarray ? @results : $results[0];
EOF

meta::internal_function('associate', <<'EOF');
my ($name, $value, %options) = @_;
my $namespace = namespace($name);
die "Namespace $namespace does not exist" unless $datatypes{$namespace};
$data{$name} = $value;
execute($name) if $options{'execute'};
EOF

meta::internal_function('execute', <<'EOF');
my ($name, %options) = @_;
my $namespace = namespace($name);
eval {&{"meta::$namespace"}(attribute($name), retrieve($name))};
warn $@ if $@ && $options{'carp'};
EOF

meta::function('serialize', <<'EOF');
my @keys = sort keys %data;
join "\n", $data{'bootstrap::initialization'},
           map(serialize_single($_),
             grep( /^meta::/, @keys),
             grep(!/^meta::/, @keys)),
           "internal::main();",
           "__END__";
EOF

meta::function('serialize_single', <<'EOF');
my ($namespace, $name) = split /::/, $_[0], 2;
my $marker = '__' . fast_hash($data{$_[0]});
"meta::$namespace('$name', <<'$marker');\n$data{$_[0]}\n$marker";
EOF

meta::function('fnv_hash', <<'EOF');
my ($data) = @_;
my ($fnv_prime, $fnv_offset) = (16777619, 2166136261);
my $hash                     = $fnv_offset;
my $modulus                  = 2 ** 32;
$hash = ($hash ^ ($_ & 0xffff) ^ ($_ >> 16)) * $fnv_prime % $modulus
  for unpack 'L*', $data . substr($data, -4) x 8;
$hash;
EOF

meta::function('fast_hash', <<'EOF');
my ($data)     = @_;
my $piece_size = length($data) >> 3;
my @pieces     = (substr($data, $piece_size * 8) . length($data),
                  map(substr($data, $piece_size * $_, $piece_size), 0 .. 7));
my @hashes     = (fnv_hash($pieces[0]));
push @hashes, fnv_hash($pieces[$_ + 1] . $hashes[$_]) for 0 .. 7;
$hashes[$_] ^= $hashes[$_ + 4] >> 16 | ($hashes[$_ + 4] & 0xffff) << 16 for 0 .. 3;
$hashes[0]  ^= $hashes[8];
sprintf '%08x' x 4, @hashes[0 .. 3];
EOF

meta::function('state', <<'EOF');
fast_hash(serialize());
EOF

meta::function('verify', <<'EOF');
my $serialized_data = serialize();
my $state           = state();

my $temporary_filename = "$0.$state";
open my $file, '>', $temporary_filename;
print $file $serialized_data;
close $file;
chmod 0700, $temporary_filename;
chomp(my $observed_state = join '', qx|perl '$temporary_filename' state|);
my $result = $observed_state eq $state;
unlink $temporary_filename if $result;
$result;
EOF

meta::function('save', <<'EOF');
if (verify()) {
  open my $file, '>', $0;
  print $file serialize();
  close $file;
  chmod 0744, $0;
} else {
  warn 'Verification failed';
}
EOF

meta::function('ls', <<'EOF');
join "\n", sort keys %data;
EOF

meta::function('cp', <<'EOF');
associate($_[1], retrieve($_[0]));
EOF

meta::function('rm', <<'EOF');
delete @data{@_};
EOF

meta::function('cat', <<'EOF');
join "\n", @data{@_};
EOF

meta::function('create', <<'EOF');
return edit($_[0]) if exists $data{$_[0]};
associate($_[0], $_[1] || "# Attribute $_[0]");
edit($_[0]);
EOF

meta::function('set', <<'EOF');
$data{$_[0]} = join '', <STDIN>;
EOF

meta::function('complete', <<'EOF');
my @functions  = sort keys %externalized_functions;
my @attributes = sort keys %data;
sub match {
  my ($text, @options) = @_;
  my @matches = sort grep /^$text/, @options;
  if    (@matches == 0) {return undef;}
  elsif (@matches == 1) {return $matches [0];}
  elsif (@matches >  1) {
    return ((longest ($matches [0], $matches [@matches - 1])), @matches);
  }
}
sub longest {
  my ($s1, $s2) = @_; 
  return substr ($s1, 0, length $1) if ($s1 ^ $s2) =~ /^(\0*)/;
  return ''; 
}
my ($text, $line) = @_;
if ($line =~ / /) {
  # Start matching attribute names.
  match ($text, @attributes);
} else {
  # Start of line, so it's a function.
  match ($text, @functions);
}
EOF

meta::internal_function('shell', <<'EOF');
use Term::ReadLine;
my $term = new Term::ReadLine "$0 shell";
$term->ornaments(0);
my $output = $term->OUT || \*STDOUT;
$term->Attribs->{attempted_completion_function} = \&complete;
while (defined($_ = $term->readline("$0\$ "))) {
  my @args = grep length, split /\s+|("[^"\\]*(?:\\.)?")/o;
  my $function_name = shift @args;
  s/^"(.*)"$/\1/o, s/\\\\"/"/go for @args;

  if ($function_name) {
    if ($externalized_functions{$function_name}) {
      chomp(my $result = eval {&$function_name(@args)});
      warn $@ if $@;
      print $output $result, "\n" unless $@;
    } else {
      warn "Command not found: '$function_name' (use 'ls' to see available commands)";
    }
  }
}
EOF

meta::function('edit', <<'EOF');
my $filename = '/tmp/' . rand();
open my $file, '>', $filename;
print $file retrieve($_[0]);
close $file;
system($ENV{EDITOR} || $ENV{VISUAL} || '/usr/bin/nano', $filename);
open my $file, '<', $filename;
associate($_[0]}, join '', <$file>);
close $file;
EOF

meta::internal_function('internal::main', <<'EOF');
my $initial_state = state();
my $command = shift @ARGV || retrieve('data::default-action');
print &$command(@ARGV);
save() if state() ne $initial_state;
EOF

internal::main();

__END__