#!/usr/bin/perl
my %data;
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 'bootstrap', sub {};
meta::define_form 'function', sub {
  my ($name, $body) = @_;
  *{$name} = eval "sub {\n$body\n}";
};
meta::define_form 'code', sub {
  my ($name, $value) = @_;
  eval $value;
};
meta::define_form 'data', sub {
  # Define a basic editing interface:
  my ($name, $value) = @_;
  *{$name} = sub {
    my ($command, $value) = @_;
    return $data{"data::$name"} unless @_;
    $data{"data::$name"} = $value if $command eq '=';
  };
};

meta::bootstrap('initialization', <<'EOF');
#!/usr/bin/perl
my %data;
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 'bootstrap', sub {};
meta::define_form 'function', sub {
  my ($name, $body) = @_;
  *{$name} = eval "sub {\n$body\n}";
};
meta::define_form 'code', sub {
  my ($name, $value) = @_;
  eval $value;
};
meta::define_form 'data', sub {
  # Define a basic editing interface:
  my ($name, $value) = @_;
  *{$name} = sub {
    my ($command, $value) = @_;
    return $data{"data::$name"} unless @_;
    $data{"data::$name"} = $value if $command eq '=';
  };
};
EOF

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

meta::function('serialize', <<'EOF');
my @keys = sort keys %data;
join "\n", $data{'bootstrap::initialization'},
           map(serialize_single($_), grep !/^code::/, @keys),
           map(serialize_single($_), grep  /^code::/, @keys),
           "\n__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('cat', <<'EOF');
join "\n", @data{@_};
EOF

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

meta::function('complete', <<'EOF');
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) = @_;
match ($text, @attributes);
EOF

meta::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) {
    chomp(my $result = eval {&$function_name(@args)});
    warn $@ if $@;
    print $output $result, "\n" unless $@;
  }
}
EOF

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

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

__END__