#!/usr/bin/perl
# 99aeabc9ec7fe80b1b39f5e53dc7e49e      <- self-modifying Perl magic

# This is a self-modifying Perl file. I'm sorry you're viewing the source (it's
# really gnarly). If you're curious what it's made of, I recommend reading
# http://github.com/spencertipping/writing-self-modifying-perl.
#
# If you got one of these from someone and don't know what to do with it, send
# it to spencer@spencertipping.com and I'll see if I can figure out what it
# does.

# For the benefit of HTML viewers (this is hack):
# <div id='cover' style='position: absolute; left: 0; top: 0; width: 10000px; height: 10000px; background: white'></div>

$|++;

my %data;
my %transient;
my %externalized_functions;
my %datatypes;

my %locations;          # Maps eval-numbers to attribute names

sub meta::define_form {
  my ($namespace, $delegate) = @_;
  $datatypes{$namespace} = $delegate;
  *{"meta::${namespace}::implementation"} = $delegate;
  *{"meta::$namespace"} = sub {
    my ($name, $value, %options) = @_;
    chomp $value;
    $data{"${namespace}::$name"} = $value unless $options{no_binding};
    &$delegate($name, $value) unless $options{no_delegate}}}

sub meta::eval_in {
  my ($what, $where) = @_;

  # Obtain next eval-number and alias it to the designated location
  @locations{eval('__FILE__') =~ /\(eval (\d+)\)/} = ($where);

  my $result = eval $what;
  $@ =~ s/\(eval \d+\)/$where/ if $@;
  warn $@ if $@;
  $result}

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

meta::meta('configure', <<'__');
# A function to configure transients. Transients can be used to store any number of
# different things, but one of the more common usages is type descriptors.

sub meta::configure {
  my ($datatype, %options) = @_;
  $transient{$_}{$datatype} = $options{$_} for keys %options;
}
__
meta::meta('externalize', <<'__');
# Function externalization. Data types should call this method when defining a function
# that has an external interface.

sub meta::externalize {
  my ($name, $attribute, $implementation) = @_;
  my $escaped = $name;
  $escaped =~ s/[^A-Za-z0-9:]/_/go;
  $externalized_functions{$name} = $externalized_functions{$escaped} = $attribute;
  *{"::$name"} = *{"::$escaped"} = $implementation || $attribute;
}

__
meta::meta('functor::editable', <<'__');
# An editable type. This creates a type whose default action is to open an editor
# on whichever value is mentioned. This can be changed using different flags.

sub meta::functor::editable {
  my ($typename, %options) = @_;

  meta::configure $typename, %options;
  meta::define_form $typename, sub {
    my ($name, $value) = @_;

    $options{on_bind} && &{$options{on_bind}}($name, $value);

    meta::externalize $options{prefix} . $name, "${typename}::$name", sub {
      my $attribute             = "${typename}::$name";
      my ($command, @new_value) = @_;

      return &{$options{default}}(retrieve($attribute)) if ref $options{default} eq 'CODE' and not defined $command;
      return edit($attribute) if $command eq 'edit' or $options{default} eq 'edit' and not defined $command;
      return associate($attribute, @new_value ? join(' ', @new_value) : join('', <STDIN>)) if $command eq '=' or $command eq 'import' or $options{default} eq 'import' and not defined $command;
      return retrieve($attribute)}}}
__
meta::meta('type::alias', <<'__');
meta::configure 'alias', inherit => 0;
meta::define_form 'alias', sub {
  my ($name, $value) = @_;
  meta::externalize $name, "alias::$name", sub {
    # Can't pre-tokenize because shell::tokenize doesn't exist until the library::
    # namespace has been evaluated (which will be after alias::).
    shell::run(shell::tokenize($value), shell::tokenize(@_));
  };
};
__
meta::meta('type::bootstrap', <<'__');
# Bootstrap attributes don't get executed. The reason for this is that because
# they are serialized directly into the header of the file (and later duplicated
# as regular data attributes), they will have already been executed when the
# file is loaded.

meta::configure 'bootstrap', extension => '.pl', inherit => 1;
meta::define_form 'bootstrap', sub {};
__
meta::meta('type::cache', <<'__');
meta::configure 'cache', inherit => 0;
meta::define_form 'cache', \&meta::bootstrap::implementation;
__
meta::meta('type::data', 'meta::functor::editable \'data\', extension => \'\', inherit => 0, default => \'cat\';');
meta::meta('type::function', <<'__');
meta::configure 'function', extension => '.pl', inherit => 1;
meta::define_form 'function', sub {
  my ($name, $value) = @_;
  meta::externalize $name, "function::$name", meta::eval_in("sub {\n$value\n}", "function::$name");
};
__
meta::meta('type::hook', <<'__');
meta::configure 'hook', extension => '.pl', inherit => 0;
meta::define_form 'hook', sub {
  my ($name, $value) = @_;
  *{"hook::$name"} = meta::eval_in("sub {\n$value\n}", "hook::$name");
};
__
meta::meta('type::inc', <<'__');
meta::configure 'inc', inherit => 1, extension => '.pl';
meta::define_form 'inc', sub {
  use File::Path 'mkpath';
  use File::Basename qw/basename dirname/;

  my ($name, $value) = @_;
  my $tmpdir   = basename($0) . '-' . $$;
  my $filename = "/tmp/$tmpdir/$name";

  push @INC, "/tmp/$tmpdir" unless grep /^\/tmp\/$tmpdir$/, @INC;

  mkpath(dirname($filename));
  unless (-e $filename) {
    open my $fh, '>', $filename;
    print $fh $value;
    close $fh;
  }
};
__
meta::meta('type::indicator', <<'__');
# Shell indicator function. The output of each of these is automatically
# appended to the shell prompt.

meta::configure 'indicator', inherit => 1, extension => '.pl';
meta::define_form 'indicator', sub {
  my ($name, $value) = @_;
  *{"indicator::$name"} = meta::eval_in("sub {\n$value\n}", "indicator::$name");
};
__
meta::meta('type::internal_function', <<'__');
meta::configure 'internal_function', extension => '.pl', inherit => 1;
meta::define_form 'internal_function', sub {
  my ($name, $value) = @_;
  *{$name} = meta::eval_in("sub {\n$value\n}", "internal_function::$name");
};
__
meta::meta('type::library', <<'__');
meta::configure 'library', extension => '.pl', inherit => 1;
meta::define_form 'library', sub {
  my ($name, $value) = @_;
  meta::eval_in($value, "library::$name");
};
__
meta::meta('type::message_color', <<'__');
meta::configure 'message_color', extension => '', inherit => 1;
meta::define_form 'message_color', sub {
  my ($name, $value) = @_;
  terminal::color($name, $value);
};
__
meta::meta('type::meta', <<'__');
# This doesn't define a new type. It customizes the existing 'meta' type
# defined in bootstrap::initialization. Note that horrible things will
# happen if you redefine it using the editable functor.

meta::configure 'meta', extension => '.pl', inherit => 1;
__
meta::meta('type::parent', <<'__');
meta::define_form 'parent', \&meta::bootstrap::implementation;
meta::configure 'parent', extension => '', inherit => 1;
__
meta::meta('type::retriever', <<'__');
meta::configure 'retriever', extension => '.pl', inherit => 1;
meta::define_form 'retriever', sub {
  my ($name, $value) = @_;
  $transient{retrievers}{$name} = meta::eval_in("sub {\n$value\n}", "retriever::$name");
};
__
meta::meta('type::state', <<'__');
# Allows temporary or long-term storage of states. Nothing particularly insightful
# is done about compression, so storing alternative states will cause a large
# increase in size. Also, states don't contain other states -- otherwise the size
# increase would be exponential.

# States are created with the save-state function.

meta::configure 'state', inherit => 0, extension => '.pl';
meta::define_form 'state', \&meta::bootstrap::implementation;
__
meta::bootstrap('html', <<'__');
<html>
  <head>
  <meta http-equiv='content-type' content='text/html; charset=UTF-8' />
  <link rel='stylesheet' href='http://spencertipping.com/perl-objects/web/style.css'/>

  <script src='http://ajax.googleapis.com/ajax/libs/jquery/1.5.2/jquery.min.js'></script>
  <script src='http://spencertipping.com/caterwaul/caterwaul.all.min.js'></script>
  <script src='http://spencertipping.com/montenegro/montenegro.client.js'></script>
  <script src='http://spencertipping.com/perl-objects/web/attribute-parser.js'></script>
  <script src='http://spencertipping.com/perl-objects/web/interface.js'></script>
  </head>
  <body></body>
</html>

__
meta::bootstrap('initialization', <<'__');
#!/usr/bin/perl
# 99aeabc9ec7fe80b1b39f5e53dc7e49e      <- self-modifying Perl magic

# This is a self-modifying Perl file. I'm sorry you're viewing the source (it's
# really gnarly). If you're curious what it's made of, I recommend reading
# http://github.com/spencertipping/writing-self-modifying-perl.
#
# If you got one of these from someone and don't know what to do with it, send
# it to spencer@spencertipping.com and I'll see if I can figure out what it
# does.

# For the benefit of HTML viewers (this is hack):
# <div id='cover' style='position: absolute; left: 0; top: 0; width: 10000px; height: 10000px; background: white'></div>

$|++;

my %data;
my %transient;
my %externalized_functions;
my %datatypes;

my %locations;          # Maps eval-numbers to attribute names

sub meta::define_form {
  my ($namespace, $delegate) = @_;
  $datatypes{$namespace} = $delegate;
  *{"meta::${namespace}::implementation"} = $delegate;
  *{"meta::$namespace"} = sub {
    my ($name, $value, %options) = @_;
    chomp $value;
    $data{"${namespace}::$name"} = $value unless $options{no_binding};
    &$delegate($name, $value) unless $options{no_delegate}}}

sub meta::eval_in {
  my ($what, $where) = @_;

  # Obtain next eval-number and alias it to the designated location
  @locations{eval('__FILE__') =~ /\(eval (\d+)\)/} = ($where);

  my $result = eval $what;
  $@ =~ s/\(eval \d+\)/$where/ if $@;
  warn $@ if $@;
  $result}

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

__
meta::bootstrap('perldoc', <<'__');
=head1 Self-modifying Perl script

=head2 Original implementation by Spencer Tipping L<http://spencertipping.com>

The prototype for this script is licensed under the terms of the MIT source code license.
However, this script in particular may be under different licensing terms. To find out how
this script is licensed, please contact whoever sent it to you. Alternatively, you may
run it with the 'license' argument if they have specified a license that way.

You should not edit this file directly. For information about how it was constructed, go
to L<http://spencertipping.com/writing-self-modifying-perl>. For quick usage guidelines,
run this script with the 'usage' argument.

=cut

__
meta::data('author', 'Spencer Tipping');
meta::data('default-action', 'shell');
meta::data('license', <<'__');
MIT License
Copyright (c) 2010 Spencer Tipping

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
__
meta::data('permanent-identity', '99aeabc9ec7fe80b1b39f5e53dc7e49e');
meta::function('ad', <<'__');
return @{$transient{path}} = () unless @_;
push @{$transient{path}}, @_;

__
meta::function('alias', <<'__');
my ($name, @stuff) = @_;
@_ ? @stuff ? around_hook('alias', @_, sub {associate("alias::$name", join(' ', @stuff), execute => 1)})
            : retrieve("alias::$name") // "Undefined alias $name"
   : table_display([select_keys('--namespace' => 'alias')], [map retrieve($_), select_keys('--namespace' => 'alias')]);

__
meta::function('cat', 'join "\\n", retrieve(@_);');
meta::function('cc', <<'__');
# Stashes a quick one-line continuation. (Used to remind me what I was doing.)
@_ ? associate('data::current-continuation', hook('set-cc', join(' ', @_))) : retrieve('data::current-continuation');
__
meta::function('ccc', 'rm(\'data::current-continuation\');');
meta::function('child', <<'__');
around_hook('child', @_, sub {
  my ($child_name) = @_;
  clone($child_name);
  enable();
  qx($child_name update-from $0 -n);
  disable()});
__
meta::function('clone', <<'__');
for (grep length, @_) {
  around_hook('clone', $_, sub {
    hypothetically(sub {
      rm('data::permanent-identity');
      file::write($_, serialize(), noclobber => 1);
      chmod(0700, $_)})})}
__
meta::function('cp', <<'__');
my $from = shift @_;
my $value = retrieve($from);
associate($_, $value) for @_;
__
meta::function('create', <<'__');
my ($name, $value) = @_;
around_hook('create', $name, $value, sub {
  return edit($name) if exists $data{$name};
  associate($name, defined $value ? $value : '');
  edit($name) unless defined $value});
__
meta::function('current-state', 'serialize(\'-pS\');');
meta::function('disable', 'hook(\'disable\', chmod_self(sub {$_[0] & 0666}));');
meta::function('edit', <<'__');
my ($name, %options) = @_;
my $extension = extension_for($name);

die "$name is virtual or does not exist" unless exists $data{$name};
die "$name is inherited; use 'edit $name -f' to edit anyway" unless is($name, '-u') || is($name, '-d') || exists $options{'-f'};

around_hook('edit', @_, sub {
  associate($name, invoke_editor_on($data{$name} // '', %options, attribute => $name, extension => $extension), execute => 1)});
save() unless $data{'data::edit::no-save'};
'';
__
meta::function('enable', 'hook(\'enable\', chmod_self(sub {$_[0] | $_[0] >> 2}));');
meta::function('export', <<'__');
# Exports data into a text file.
#   export attr1 attr2 attr3 ... file.txt
my $name = pop @_;
@_ or die 'Expected filename';
file::write($name, join "\n", retrieve(@_));
__
meta::function('extern', '&{$_[0]}(retrieve(@_[1 .. $#_]));');
meta::function('grep', <<'__');
# Looks through attributes for a pattern. Usage is grep pattern [options], where
# [options] is the format as provided to select_keys.

my ($pattern, @args)     = @_;
my ($options, @criteria) = separate_options(@args);
my @attributes           = select_keys(%$options, '--criteria' => join('|', @criteria));

$pattern = qr/$pattern/;

my @m_attributes;
my @m_line_numbers;
my @m_lines;

for my $k (@attributes) {
  next unless length $k;
  my @lines = split /\n/, retrieve($k);
  for (0 .. $#lines) {
    next unless $lines[$_] =~ $pattern;
    push @m_attributes,   $k;
    push @m_line_numbers, $_ + 1;
    push @m_lines,        '' . ($lines[$_] // '')}}

unless ($$options{'-C'}) {
  s/($pattern)/\033[1;31m\1\033[0;0m/g for @m_lines;
  s/^/\033[1;34m/o for @m_attributes;
  s/^/\033[1;32m/o && s/$/\033[0;0m/o for @m_line_numbers}

table_display([@m_attributes], [@m_line_numbers], [@m_lines]);
__
meta::function('hash', 'fast_hash(@_);');
meta::function('hook', <<'__');
my ($hook, @args) = @_;
$transient{active_hooks}{$hook} = 1;
dangerous('', sub {&$_(@args)}) for grep /^hook::${hook}::/, sort keys %data;
@args;
__
meta::function('hooks', 'join "\\n", sort keys %{$transient{active_hooks}};');
meta::function('identity', 'retrieve(\'data::permanent-identity\') || associate(\'data::permanent-identity\', fast_hash(rand() . name() . serialize()));');
meta::function('import', <<'__');
my $name = pop @_;
associate($name, @_ ? join('', map(file::read($_), @_)) : join('', <STDIN>)); 
__
meta::function('initial-state', '$transient{initial};');
meta::function('is', <<'__');
my ($attribute, @criteria) = @_;
my ($options, @stuff) = separate_options(@criteria);
exists $data{$attribute} and attribute_is($attribute, %$options);

__
meta::function('load-state', <<'__');
around_hook('load-state', @_, sub {
  my ($state_name) = @_;
  my $state = retrieve("state::$state_name");

  terminal::state('saving current state into _...');
  save_state('_');

  delete $data{$_} for grep ! /^state::/, keys %data;
  %externalized_functions = ();

  terminal::state("restoring state $state_name...");
  meta::eval_in($state, "state::$state_name");
  terminal::error(hook('load-state-failed', $@)) if $@;
  reload();
  verify()});

__
meta::function('lock', 'hook(\'lock\', chmod_self(sub {$_[0] & 0555}));');
meta::function('ls', <<'__');
my ($options, @criteria) = separate_options(@_);
my ($external, $shadows, $sizes, $flags, $long, $hashes, $parent_hashes) = @$options{qw(-e -s -z -f -l -h -p)};
$sizes = $flags = $hashes = $parent_hashes = 1 if $long;

return table_display([grep ! exists $data{$externalized_functions{$_}}, sort keys %externalized_functions]) if $shadows;

my $criteria    = join('|', @criteria);
my @definitions = select_keys('--criteria' => $criteria, '--path' => $transient{path}, %$options);

my %inverses  = map {$externalized_functions{$_} => $_} keys %externalized_functions;
my @externals = map $inverses{$_}, grep length, @definitions;
my @internals = grep length $inverses{$_}, @definitions;
my @sizes     = map sprintf('%6d %6d', length(serialize_single($_)), length(retrieve($_))), @{$external ? \@internals : \@definitions} if $sizes;

my @flags     = map {my $k = $_; join '', map(is($k, "-$_") ? $_ : '-', qw(d i m u))} @definitions if $flags;
my @hashes    = map fast_hash(retrieve($_)), @definitions if $hashes;

my %inherited     = parent_attributes(grep /^parent::/o, keys %data) if $parent_hashes;
my @parent_hashes = map $inherited{$_} || '-', @definitions if $parent_hashes;

join "\n", map strip($_), split /\n/, table_display($external ? [grep length, @externals] : [@definitions],
                                                    $sizes ? ([@sizes]) : (), $flags ? ([@flags]) : (), $hashes ? ([@hashes]) : (), $parent_hashes ? ([@parent_hashes]) : ());

__
meta::function('mv', <<'__');
my ($from, $to) = @_;
die "'$from' does not exist" unless exists $data{$from};
associate($to, retrieve($from));
rm($from);
__
meta::function('name', <<'__');
my $name = $0;
$name =~ s/^.*\///;
$name;
__
meta::function('parents', 'join "\\n", grep s/^parent:://o, sort keys %data;');
meta::function('perl', <<'__');
my $result = eval(join ' ', @_);
$@ ? terminal::error($@) : $result;
__
meta::function('rd', <<'__');
if (@_) {my $pattern = join '|', @_;
         @{$transient{path}} = grep $_ !~ /^$pattern$/, @{$transient{path}}}
else    {pop @{$transient{path}}}

__
meta::function('reload', 'around_hook(\'reload\', sub {execute($_) for grep ! /^bootstrap::/, keys %data});');
meta::function('rm', <<'__');
around_hook('rm', @_, sub {
  exists $data{$_} or terminal::warning("$_ does not exist") for @_;
  delete @data{@_}});
__
meta::function('rmparent', <<'__');
# Removes one or more parents.
my ($options, @parents) = separate_options(@_);
my $clobber_divergent = $$options{'-D'} || $$options{'--clobber-divergent'};

my %parents = map {$_ => 1} @parents;
my @other_parents = grep !$parents{$_}, grep s/^parent:://, select_keys('--namespace' => 'parent');
my %kept_by_another_parent;

$kept_by_another_parent{$_} = 1 for grep s/^(\S+)\s.*$/\1/, split /\n/o, cat(@other_parents);

for my $parent (@parents) {
  my $keep_parent_around = 0;

  for my $line (split /\n/, retrieve("parent::$parent")) {
    my ($name, $hash) = split /\s+/, $line;
    next unless exists $data{$name};

    my $local_hash = fast_hash(retrieve($name));
    if ($clobber_divergent or $hash eq $local_hash or ! defined $hash) {rm($name) unless $kept_by_another_parent{$name}}
    else {terminal::info("local attribute $name exists and is divergent; use rmparent -D $parent to delete it");
          $keep_parent_around = 1}}

  $keep_parent_around ? terminal::info("not deleting parent::$parent so that you can run", "rmparent -D $parent if you want to nuke divergent attributes too")
                      : rm("parent::$parent")}

__
meta::function('save', 'around_hook(\'save\', sub {dangerous(\'\', sub {file::write($0, serialize()); $transient{initial} = state()}) if verify()});');
meta::function('save-state', <<'__');
# Creates a named copy of the current state and stores it.
my ($state_name) = @_;
around_hook('save-state', $state_name, sub {
  associate("state::$state_name", current_state(), execute => 1)});

__
meta::function('serialize', <<'__');
my ($options, @criteria) = separate_options(@_);
my $partial     = $$options{'-p'};
my $criteria    = join '|', @criteria;
my @attributes  = map serialize_single($_), select_keys(%$options, '-m' => 1, '--criteria' => $criteria), select_keys(%$options, '-M' => 1, '--criteria' => $criteria);
my @final_array = @{$partial ? \@attributes : [retrieve('bootstrap::initialization'), @attributes, 'internal::main();', '', '__END__']};
join "\n", @final_array;
__
meta::function('serialize-single', <<'__');
# Serializes a single attribute and optimizes for content.

my $name          = $_[0] || $_;
my $contents      = $data{$name};
my $meta_function = 'meta::' . namespace($name);
my $invocation    = attribute($name);
my $escaped       = $contents;
$escaped =~ s/\\/\\\\/go;
$escaped =~ s/'/\\'/go;

return "$meta_function('$invocation', '$escaped');" unless $escaped =~ /\v/;

my $delimiter = '__' . fast_hash($contents);
my $chars     = 2;

++$chars until $chars >= length($delimiter) || index("\n$contents", "\n" . substr($delimiter, 0, $chars)) == -1;
$delimiter = substr($delimiter, 0, $chars);

"$meta_function('$invocation', <<'$delimiter');\n$contents\n$delimiter";
__
meta::function('sh', 'system(@_);');
meta::function('shb', <<'__');
# Backgrounded shell job.
exec(@_) unless fork;

__
meta::function('shell', <<'__');
my ($options, @arguments) = separate_options(@_);
$transient{repl_prefix} = $$options{'--repl-prefix'};

terminal::cc(retrieve('data::current-continuation')) if length $data{'data::current-continuation'};
around_hook('shell', sub {shell::repl(%$options)});

__
meta::function('size', <<'__');
my $size = 0;
$size += length $data{$_} for keys %data;
sprintf "% 7d % 7d % 7d", length(serialize()), $size, length(serialize('-up'));

__
meta::function('snapshot', <<'__');
my ($name) = @_;
file::write(my $finalname = temporary_name($name), serialize(), noclobber => 1);
chmod 0700, $finalname;
hook('snapshot', $finalname);
__
meta::function('state', <<'__');
my @keys = sort keys %data;
my $hash = fast_hash(fast_hash(scalar @keys) . join '|', @keys);
$hash = fast_hash("$data{$_}|$hash") for @keys;
$hash;
__
meta::function('touch', 'associate($_, \'\') for @_;');
meta::function('unlock', 'hook(\'unlock\', chmod_self(sub {$_[0] | 0200}));');
meta::function('update', <<'__');
update_from(@_, grep s/^parent:://o, sort keys %data);

__
meta::function('update-from', <<'__');
# Upgrade all attributes that aren't customized. Customization is defined when the data type is created,
# and we determine it here by checking for $transient{inherit}{$type}.

# Note that this assumes you trust the remote script. If you don't, then you shouldn't update from it.

around_hook('update-from-invocation', separate_options(@_), sub {
  my ($options, @targets) = @_;
  my %parent_id_cache = cache('parent-identification');
  my %already_seen;

  @targets or return;

  my @known_targets     = grep s/^parent:://, parent_ordering(map "parent::$_", grep exists $data{"parent::$_"}, @targets);
  my @unknown_targets   = grep ! exists $data{"parent::$_"}, @targets;
  @targets = (@known_targets, @unknown_targets);

  my $save_state        = ! ($$options{'-n'} || $$options{'--no-save'});
  my $no_parents        =    $$options{'-P'} || $$options{'--no-parent'} || $$options{'--no-parents'};
  my $force             =    $$options{'-f'} || $$options{'--force'};
  my $clobber_divergent =    $$options{'-D'} || $$options{'--clobber-divergent'};

  save_state('before-update') if $save_state;

  for my $target (@targets) {
    dangerous("updating from $target", sub {
    around_hook('update-from', $target, sub {
      my $identity = $parent_id_cache{$target} ||= join '', qx($target identity);
      next if $already_seen{$identity};
      $already_seen{$identity} = 1;

      my $attributes = join '', qx($target ls -ahiu);
      my %divergent;
      die "skipping unreachable $target" unless $attributes;

      for my $to_rm (split /\n/, retrieve("parent::$target")) {
        my ($name, $hash) = split(/\s+/, $to_rm);
        next unless exists $data{$name};

        my $local_hash = fast_hash(retrieve($name));
        if ($clobber_divergent or $hash eq $local_hash or ! defined $hash) {rm($name)}
        else {terminal::info("preserving local version of divergent attribute $name (use update -D to clobber it)");
              $divergent{$name} = retrieve($name)}}

      associate("parent::$target", $attributes) unless $no_parents;

      dangerous('', sub {eval qx($target serialize -ipmu)});
      dangerous('', sub {eval qx($target serialize -ipMu)});

      map associate($_, $divergent{$_}), keys %divergent unless $clobber_divergent;

      reload()})})}

  cache('parent-identification', %parent_id_cache);

  if (verify()) {hook('update-from-succeeded', $options, @targets);
                 terminal::info("Successfully updated. Run 'load-state before-update' to undo this change.") if $save_state}
  elsif ($force) {hook('update-from-failed', $options, @targets);
                  terminal::warning('Failed to verify: at this point your object will not save properly, though backup copies will be created.',
                                    'Run "load-state before-update" to undo the update and return to a working state.') if $save_state}
  else {hook('update-from-failed', $options, @targets);
        terminal::error('Verification failed after the upgrade was complete.');
        terminal::info("$0 has been reverted to its pre-upgrade state.", "If you want to upgrade and keep the failure state, then run 'update-from $target --force'.") if $save_state;
        return load_state('before-update') if $save_state}});

__
meta::function('usage', '"Usage: $0 action [arguments]\\nUnique actions (run \'$0 ls\' to see all actions):" . ls(\'-u\');');
meta::function('verify', <<'__');
file::write(my $other = $transient{temporary_filename} = temporary_name(), my $serialized_data = serialize());
chomp(my $observed = join '', qx|perl '$other' state|);

unlink $other if my $result = $observed eq (my $state = state());
terminal::error("Verification failed; expected $state but got $observed from $other") unless $result;
hook('after-verify', $result, observed => $observed, expected => $state);
$result;
__
meta::indicator('cc', 'length ::retrieve(\'data::current-continuation\') ? "\\033[1;36mcc\\033[0;0m" : \'\';');
meta::indicator('locked', 'is_locked() ? "\\033[1;31mlocked\\033[0;0m" : \'\';');
meta::indicator('path', <<'__');
join "\033[1;30m/\033[0;0m", @{$transient{path}};

__
meta::internal_function('around_hook', <<'__');
# around_hook('hookname', @args, sub {
#   stuff;
# });

# Invokes 'before-hookname' on @args before the sub runs, invokes the
# sub on @args, then invokes 'after-hookname' on @args afterwards.
# The after-hook is not invoked if the sub calls 'die' or otherwise
# unwinds the stack.

my $hook = shift @_;
my $f    = pop @_;

hook("before-$hook", @_);
my $result = &$f(@_);
hook("after-$hook", @_);
$result;
__
meta::internal_function('associate', <<'__');
my ($name, $value, %options) = @_;
die "Namespace does not exist" unless exists $datatypes{namespace($name)};
$data{$name} = $value;
execute($name) if $options{'execute'};
$value;
__
meta::internal_function('attribute', <<'__');
my ($name) = @_;
$name =~ s/^[^:]*:://;
$name;
__
meta::internal_function('attribute_is', <<'__');
my ($a, %options) = @_;
my %inherited     = parent_attributes(grep /^parent::/o, sort keys %data) if grep exists $options{$_}, qw/-u -U -d -D/;
my $criteria      = $options{'--criteria'} || $options{'--namespace'} && "^$options{'--namespace'}::" || '.';

my %tests = ('-u' => sub {! $inherited{$a}},
             '-d' => sub {$inherited{$a} && fast_hash(retrieve($a)) ne $inherited{$a}},
             '-i' => sub {$transient{inherit}{namespace($a)}},
             '-s' => sub {$a =~ /^state::/o},
             '-m' => sub {$a =~ /^meta::/o});

return 0 unless scalar keys %tests == scalar grep ! exists $options{$_}    ||   &{$tests{$_}}(), keys %tests;
return 0 unless scalar keys %tests == scalar grep ! exists $options{uc $_} || ! &{$tests{$_}}(), keys %tests;

$a =~ /$_/ || return 0 for @{$options{'--path'}};
$a =~ /$criteria/;

__
meta::internal_function('cache', <<'__');
my ($name, %pairs) = @_;
if (%pairs) {associate("cache::$name", join "\n", map {$pairs{$_} =~ s/\n//g; "$_ $pairs{$_}"} sort keys %pairs)}
else        {map split(/\s/, $_, 2), split /\n/, retrieve("cache::$name")}
__
meta::internal_function('chmod_self', <<'__');
my ($mode_function)      = @_;
my (undef, undef, $mode) = stat $0;
chmod &$mode_function($mode), $0;
__
meta::internal_function('dangerous', <<'__');
# Wraps a computation that may produce an error.
my ($message, $computation) = @_;
terminal::info($message) if $message;
my @result = eval {&$computation()};
terminal::warning(translate_backtrace($@)), return undef if $@;
wantarray ? @result : $result[0];
__
meta::internal_function('debug_trace', <<'__');
terminal::debug(join ', ', @_);
wantarray ? @_ : $_[0];
__
meta::internal_function('execute', <<'__');
my ($name, %options) = @_;
my $namespace = namespace($name);
eval {&{$datatypes{$namespace}}(attribute($name), retrieve($name))};
warn $@ if $@ && $options{'carp'};

__
meta::internal_function('exported', <<'__');
# Allocates a temporary file containing the concatenation of attributes you specify,
# and returns the filename. The filename will be safe for deletion anytime.
my $filename = temporary_name();
file::write($filename, cat(@_));
$filename;

__
meta::internal_function('extension_for', <<'__');
my $extension = $transient{extension}{namespace($_[0])};
$extension = &$extension($_[0]) if ref $extension eq 'CODE';
$extension || '';
__
meta::internal_function('fast_hash', <<'__');
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];
__
meta::internal_function('file::read', <<'__');
my $name = shift;
open my($handle), "<", $name;
my $result = join "", <$handle>;
close $handle;
$result;
__
meta::internal_function('file::write', <<'__');
use File::Path     'mkpath';
use File::Basename 'dirname';

my ($name, $contents, %options) = @_;
die "Choosing not to overwrite file $name" if $options{noclobber} and -f $name;
mkpath(dirname($name)) if $options{mkpath};

open my($handle), $options{append} ? '>>' : '>', $name or die "Can't open $name for writing";
print $handle $contents;
close $handle;
__
meta::internal_function('fnv_hash', <<'__');
# A rough approximation to the Fowler-No Voll hash. It's been 32-bit vectorized
# for efficiency, which may compromise its effectiveness for short strings.

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;
__
meta::internal_function('hypothetically', <<'__');
# Applies a temporary state and returns a serialized representation.
# The original state is restored after this, regardless of whether the
# temporary state was successful.

my %data_backup   = %data;
my ($side_effect) = @_;
my $return_value  = eval {&$side_effect()};
%data = %data_backup;

die $@ if $@;
$return_value;
__
meta::internal_function('internal::main', <<'__');
disable();

$SIG{'INT'} = sub {snapshot(); exit 1};

$transient{initial}      = state();
chomp(my $default_action = retrieve('data::default-action'));

my $function_name = shift(@ARGV) || $default_action || 'usage';
terminal::warning("unknown action: '$function_name'") and $function_name = 'usage' unless $externalized_functions{$function_name};

around_hook('main-function', $function_name, @ARGV, sub {
  dangerous('', sub {
    chomp(my $result = &$function_name(@ARGV));
    print "$result\n" if $result})});

save() unless state() eq $transient{initial};

END {
  enable();
}
__
meta::internal_function('invoke_editor_on', <<'__');
my ($data, %options) = @_;
my $editor    = $options{editor} || $ENV{VISUAL} || $ENV{EDITOR} || die 'Either the $VISUAL or $EDITOR environment variable should be set to a valid editor';
my $options   = $options{options} || $ENV{VISUAL_OPTS} || $ENV{EDITOR_OPTS} || '';
my $attribute = $options{attribute};
$attribute =~ s/\//-/g;
my $filename  = temporary_name() . "-$attribute$options{extension}";

file::write($filename, $data);
system("$editor $options '$filename'");

my $result = file::read($filename);
unlink $filename;
$result;
__
meta::internal_function('is_locked', '!((stat($0))[2] & 0222);');
meta::internal_function('namespace', <<'__');
my ($name) = @_;
$name =~ s/::.*$//;
$name;
__
meta::internal_function('parent_attributes', <<'__');
my $attributes = sub {my ($name, $value) = split /\s+/o, $_; $name => ($value || 1)};
map &$attributes(), split /\n/o, join("\n", retrieve(@_));
__
meta::internal_function('parent_ordering', <<'__');
# Topsorts the parents by dependency chain. The simplest way to do this is to
# transitively compute the number of parents referred to by each parent.

my @parents = @_;
my %all_parents = map {$_ => 1} @parents;

my %parents_of = map {
  my $t = $_;
  my %attributes = parent_attributes($_);
  $t => [grep /^parent::/, keys %attributes]} @parents;

my %parent_count;
my $parent_count;
$parent_count = sub {
  my ($key) = @_;
  return $parent_count{$key} if exists $parent_count{$key};
  my $count = 0;
  $count += $parent_count->($_) + exists $data{$_} for @{$parents_of{$key}};
  $parent_count{$key} = $count};

my %inverses;
push @{$inverses{$parent_count->($_)} ||= []}, $_ for @parents;
grep exists $all_parents{$_}, map @{$inverses{$_}}, sort keys %inverses;
__
meta::internal_function('retrieve', <<'__');
my @results = map defined $data{$_} ? $data{$_} : retrieve_with_hooks($_), @_;
wantarray ? @results : $results[0];
__
meta::internal_function('retrieve_with_hooks', <<'__');
# Uses the hooks defined in $transient{retrievers}, and returns undef if none work.
my ($attribute) = @_;
my $result      = undef;

defined($result = &$_($attribute)) and return $result for map $transient{retrievers}{$_}, sort keys %{$transient{retrievers}};
return undef;
__
meta::internal_function('select_keys', <<'__');
my %options = @_;
grep attribute_is($_, %options), sort keys %data;
__
meta::internal_function('separate_options', <<'__');
# Things with one dash are short-form options, two dashes are long-form.
# Characters after short-form are combined; so -auv4 becomes -a -u -v -4.
# Also finds equivalences; so --foo=bar separates into $$options{'--foo'} eq 'bar'.
# Stops processing at the -- option, and removes it. Everything after that
# is considered to be an 'other' argument.

# The only form not supported by this function is the short-form with argument.
# To pass keyed arguments, you need to use long-form options.

my @parseable;
push @parseable, shift @_ until ! @_ or $_[0] eq '--';

my @singles = grep /^-[^-]/, @parseable;
my @longs   = grep /^--/,    @parseable;
my @others  = grep ! /^-/,   @parseable;

my @singles = map /-(.{2,})/ ? map("-$_", split(//, $1)) : $_, @singles;

my %options;
/^([^=]+)=(.*)$/ and $options{$1} = $2 for @longs;
++$options{$_} for grep ! /=/, @singles, @longs;

({%options}, @others, @_);

__
meta::internal_function('strip', 'wantarray ? map {s/^\\s*|\\s*$//g; $_} @_ : $_[0] =~ /^\\s*(.*?)\\s*$/ && $1;');
meta::internal_function('table_display', <<'__');
# Displays an array of arrays as a table; that is, with alignment. Arrays are
# expected to be in column-major order.

sub maximum_length_in {
  my $maximum = 0;
  length > $maximum and $maximum = length for @_;
  $maximum;
}

my @arrays    = @_;
my @lengths   = map maximum_length_in(@$_), @arrays;
my @row_major = map {my $i = $_; [map $$_[$i], @arrays]} 0 .. $#{$arrays[0]};
my $format    = join '  ', map "%-${_}s", @lengths;

join "\n", map strip(sprintf($format, @$_)), @row_major;
__
meta::internal_function('temporary_name', <<'__');
use File::Temp 'tempfile';
my (undef, $temporary_filename) = tempfile("$0." . 'X' x 4, OPEN => 0);
$temporary_filename;
__
meta::internal_function('translate_backtrace', <<'__');
my ($trace) = @_;
$trace =~ s/\(eval (\d+)\)/$locations{$1 - 1}/g;
$trace;
__
meta::internal_function('with_exported', <<'__');
# Like exported(), but removes the file after running some function.
# Usage is with_exported(@files, sub {...});
my $f      = pop @_;
my $name   = exported(@_);
my $result = eval {&$f($name)};
terminal::warning("$@ when running with_exported()") if $@;
unlink $name;
$result;
__
meta::library('shell', <<'__');
# Functions for shell parsing and execution.
package shell;
use Term::ReadLine;

sub tokenize {grep length, split /\s+|("[^"\\]*(?:\\.)?")/o, join ' ', @_};

sub parse {
  my ($fn, @args) = @_;
  s/^"(.*)"$/\1/o, s/\\\\"/"/go for @args;
  {function => $fn, args => [@args]}}

sub execute {
  my %command = %{$_[0]};
  die "undefined command: $command{function}" unless exists $externalized_functions{$command{function}};
  &{"::$command{function}"}(@{$command{args}})}

sub run {execute(parse(tokenize(@_)))}

sub prompt {
  my %options = @_;
  my $name    = $options{name} // ::name();

  my $indicators = join '', map &{"::$_"}(), ::select_keys('--namespace' => 'indicator');
  my $prefix     = $transient{repl_prefix} // '';

  "$prefix\033[1;32m$name\033[0;0m$indicators "}

sub repl {
  my %options = @_;

  my $term = new Term::ReadLine "$0 shell";
  $term->ornaments(0);
  my $attribs = $term->Attribs;
  $attribs->{completion_entry_function} = $attribs->{list_completion_function};

  my $autocomplete = $options{autocomplete} || sub {[sort(keys %data), grep !/-/, sort keys %externalized_functions]};
  my $prompt       = $options{prompt}       || \&prompt;
  my $parse        = $options{parse}        || sub {parse(tokenize(@_))};
  my $command      = $options{command}      || sub {my ($command) = @_; ::around_hook('shell-command', $command, sub {print ::dangerous('', sub {execute($command)}), "\n"})};

  length $_ && &$command(&$parse($_)) while ($attribs->{completion_word} = &$autocomplete(), defined($_ = $term->readline(&$prompt())))}

__
meta::library('terminal', <<'__');
# Functions for nice-looking terminal output.
package terminal;

my $process = ::name();

sub message {print STDERR "[$_[0]] $_[1]\n"}
sub color {
  my ($name, $color) = @_;
  *{"terminal::$name"} = sub {chomp($_), print STDERR "\033[1;30m$process(\033[1;${color}m$name\033[1;30m)\033[0;0m $_\n" for map join('', $_), @_}}

my %preloaded = (info => 32, progress => 32, state => 34, debug => 34, warning => 33, error => 31);
color $_, $preloaded{$_} for keys %preloaded;
__
meta::message_color('cc', '36');
meta::message_color('state', 'purple');
meta::message_color('states', 'yellow');
meta::retriever('file', '-f $_[0] ? file::read($_[0]) : undef;');
meta::retriever('id', '$_[0] =~ /^id::/ ? substr($_[0], 4) : undef;');
meta::retriever('object', <<'__');
# Fetch a property from another Perl object. This uses the 'cat' function.
return undef unless $_[0] =~ /^object::(.*?)::(.*)$/ && -x $1 && qx|$1 is '$2'|;
join '', qx|$1 cat '$2'|;

__
meta::retriever('perl', <<'__');
# Lets you use the result of evaluating some Perl expression
return undef unless $_[0] =~ /^perl::(.*)$/;
eval $1;

__
internal::main();

__END__