LambdaCore Compatible Dump of Composed

composed.moo

@create $root_class named Composed, Component Library:
@prop __OBJECT__."packages" {} "" __PROGRAMMER__
;;__OBJECT__.("packages") = {}
@prop __OBJECT__."provides_cache" [] "" __PROGRAMMER__
@prop __OBJECT__."requires_cache" [] "" __PROGRAMMER__
@prop __OBJECT__."last_fetch_index" 1529767110 "" __PROGRAMMER__
@prop __OBJECT__."archived" [] "" __PROGRAMMER__
@prop __OBJECT__."cached" [] "" __PROGRAMMER__
@prop __OBJECT__."archive_sources" {} "" __PROGRAMMER__
;;__OBJECT__.("archive_sources") = {"http://stunt.io/v2/packages.json"}

@verb __OBJECT__:"_log" this none this xd __WIZARD__
@program __OBJECT__:_log
(caller != this) && raise(E_PERM);

/* Log args -- for debugging. */

notify(player, tostr(@args));
.

@verb __OBJECT__:"_notify" this none this xd __WIZARD__
@program __OBJECT__:_notify
(caller != this) && raise(E_PERM);

{what, @messages} = args;

/* Send `messages' to `what' for output. Prefer a `notify()' verb over
 * the `notify()' built-in, but remember that this still has to work
 * during bootstrapping and with legacy code.
 */

if (`what.alt_display_options ! E_PROPNF' == E_PROPNF)
  message = "";
  stack = messages;
  while (stack)
    {top, @stack} = stack;
    if (typeof(top) == LIST)
      {_, _, @body} = top;
      stack = {@body, @stack};
    else
      message = tostr(message, top);
    endif
  endwhile
  `notify(what, message) ! ANY';
else
  `what:notify(@messages) ! ANY';
endif
.

@verb __OBJECT__:"_move" this none this xd __WIZARD__
@program __OBJECT__:_move
(caller != this) && raise(E_PERM);

{what, where} = args;

/* Move `what' to `where'.  Runs with wiz-perms.  Won't raise an error. */

`move(what, where) ! ANY';
.

@verb __OBJECT__:"_suspend_if_necessary" this none this xd __PROGRAMMER__
@program __OBJECT__:_suspend_if_necessary
((ticks_left() < 5000) || (seconds_left() < 2)) && suspend(0);
.

@verb __OBJECT__:"_parse_specifier" this none this xd __PROGRAMMER__
@program __OBJECT__:_parse_specifier
{specifier} = args;
(caller != this) && raise(E_PERM);
if (r = match(specifier, "^%([0-9]+%.[0-9]+%.[0-9]+%),%([_a-zA-Z0-9]+%)$"))
  version = specifier[r[3][1][1]..r[3][1][2]];
  identifier = specifier[r[3][2][1]..r[3][2][2]];
  return {identifier, version};
else
  raise(E_INVARG, tostr("Invalid package specifier:  ", specifier));
endif
.

@verb __OBJECT__:"_parse_operation" this none this xd __PROGRAMMER__
@program __OBJECT__:_parse_operation
{operation} = args;
(caller != this) && raise(E_PERM);
if (r = match(operation, "^%(<=%|>=%|<%|>%|=%)? *%([0-9]+%)?%(%.%([0-9]+%)%)?%(%.%([0-9]+%)%)?$"))
  op = operation[r[3][1][1]..r[3][1][2]] || "=";
  major = operation[r[3][2][1]..r[3][2][2]];
  minor = operation[r[3][4][1]..r[3][4][2]];
  build = operation[r[3][6][1]..r[3][6][2]];
  return {op, major, minor, build};
else
  raise(E_INVARG, tostr("Invalid operation:  ", operation));
endif
.

@verb __OBJECT__:"_parse_version" this none this xd __PROGRAMMER__
@program __OBJECT__:_parse_version
{version} = args;
(caller != this) && raise(E_PERM);
if (r = match(version, "^%([0-9]+%)%(%.%([0-9]+%)%)%(%.%([0-9]+%)%)$"))
  major = version[r[3][1][1]..r[3][1][2]];
  minor = version[r[3][3][1]..r[3][3][2]];
  build = version[r[3][5][1]..r[3][5][2]];
  return {major, minor, build};
else
  raise(E_INVARG, tostr("Invalid version:  ", version));
endif
.

@verb __OBJECT__:"_compare_versions" this none this xd __PROGRAMMER__
@program __OBJECT__:_compare_versions
{ver1, ver2} = args;
(caller != this) && raise(E_PERM);
res = 0;
if (ver1[1] && ver2[1])
  if (((!(res = toint(ver1[1]) - toint(ver2[1]))) && ver1[2]) && ver2[2])
    if (((!(res = toint(ver1[2]) - toint(ver2[2]))) && ver1[3]) && ver2[3])
      res = toint(ver1[3]) - toint(ver2[3]);
    endif
  endif
endif
return res;
.

@verb __OBJECT__:"_sort_versions" this none this xd __PROGRAMMER__
@program __OBJECT__:_sort_versions
{vers} = args;
(caller != this) && raise(E_PERM);
l = length(vers);
i = 1;
while (i <= l)
  v = vers[i];
  j = i - 1;
  while (j > 0)
    if (this:_compare_versions(vers[j], v) >= 0)
      break;
    endif
    vers[j + 1] = vers[j];
    j = j - 1;
  endwhile
  vers[j + 1] = v;
  i = i + 1;
endwhile
return vers;
.

@verb __OBJECT__:"_match match" this none this xd __PROGRAMMER__
@program __OBJECT__:_match
{identifier, @args} = args;
if (args && (typeof(args[$]) == MAP))
  patterns = args[1..$ - 1];
  provides = args[$];
else
  patterns = args;
  provides = this.provides_cache;
endif
if ((patterns && (length(patterns) == 1)) && (typeof(patterns[1]) == LIST))
  patterns = patterns[1];
endif
if ((versions = `provides[identifier] ! E_RANGE => $nothing') == $nothing)
  return {$failed_match};
endif
operations = {};
for pattern in (patterns)
  this:_suspend_if_necessary();
  operations = {@operations, this:_parse_operation(pattern)};
endfor
for _, version in (versions)
  this:_suspend_if_necessary();
  v1 = this:_parse_version(version);
  for operation in (operations)
    this:_suspend_if_necessary();
    {op, @v2} = operation;
    if (((((("=" == op) && this:_compare_versions(v1, v2)) || ((">=" == op) && (this:_compare_versions(v1, v2) < 0))) || (("<=" == op) && (this:_compare_versions(v1, v2) > 0))) || ((">" == op) && (this:_compare_versions(v1, v2) <= 0))) || (("<" == op) && (this:_compare_versions(v1, v2) >= 0)))
      versions = mapdelete(versions, version);
      break;
    endif
  endfor
endfor
if (length(versions) < 1)
  return {$failed_match};
elseif (length(versions) > 1)
  return {$ambiguous_match};
else
  version = mapkeys(versions)[1];
  object = mapvalues(versions)[1][1];
  return {object, identifier, version};
endif
.

@verb __OBJECT__:"_map_specifier" this none this xd __PROGRAMMER__
@program __OBJECT__:_map_specifier
{MAP, specifier, object} = args;
(caller != this) && raise(E_PERM);
if (typeof(specifier) == LIST)
  {identifier, version} = specifier;
else
  {identifier, version} = this:_parse_specifier(specifier);
endif
(identifier in mapkeys(MAP)) || (MAP[identifier] = []);
(version in mapkeys(MAP[identifier])) || (MAP[identifier][version] = {});
MAP[identifier][version] = setadd(MAP[identifier][version], object);
return MAP;
.

@verb __OBJECT__:"_unmap_specifier" this none this xd __PROGRAMMER__
@program __OBJECT__:_unmap_specifier
{MAP, specifier, object} = args;
(caller != this) && raise(E_PERM);
if (typeof(specifier) == LIST)
  {identifier, version} = specifier;
else
  {identifier, version} = this:_parse_specifier(specifier);
endif
((identifier in mapkeys(MAP)) && (version in mapkeys(MAP[identifier]))) && (MAP[identifier][version] = setremove(MAP[identifier][version], object));
`MAP[identifier][version] ! E_RANGE => 1' || (MAP[identifier] = mapdelete(MAP[identifier], version));
`MAP[identifier] ! E_RANGE => 1' || (MAP = mapdelete(MAP, identifier));
return MAP;
.

@verb __OBJECT__:"_install" this none this xd __PROGRAMMER__
@program __OBJECT__:_install
/* Updates $composed data structures that track installed packages.
 * Assumes that all prerequisites have been checked and are met.
 * Rolls back changes if an error occurs.  Used by
 * $composed:install() and $composed:reinitialize().
 */
(caller != this) && raise(E_PERM);

{identifier, version, object} = args;

try
  error = 1;
  packages_backup = this.packages;
  provides_cache_backup = this.provides_cache;
  requires_cache_backup = this.requires_cache;

  this.packages = setadd(this.packages, object);
  this.provides_cache = this:_map_specifier(this.provides_cache, {identifier, version}, object);
  for provides in (`object.provides ! E_INVIND, E_TYPE, E_PROPNF => {}')
    this.provides_cache = this:_map_specifier(this.provides_cache, provides, object);
  endfor
  /* add a record for every installed package I require */
  /* match() must succeed because all prerequisites should have been checked */
  for requires in (`object.requires ! E_INVIND, E_TYPE, E_PROPNF => {}')
    provider = this:_match(@requires, this.provides_cache);
    this.requires_cache = this:_map_specifier(this.requires_cache, provider[2..3], object);
  endfor
  error = 0;
finally
  /* after cleanup, allow the error to propagate upward */
  if (error)
    this.packages = packages_backup;
    this.provides_cache = provides_cache_backup;
    this.requires_cache = requires_cache_backup;
  endif
endtry
.

@verb __OBJECT__:"_uninstall" this none this xd __PROGRAMMER__
@program __OBJECT__:_uninstall
/* Updates $composed data structures that track installed packages.
 * Assumes that all prerequisites have been checked and are met.
 * Rolls back changes if an error occurs.  Used by
 * $composed:uninstall() and $composed:delete().
 */
(caller != this) && raise(E_PERM);

{identifier, version, object} = args;

try
  error = 1;
  packages_backup = this.packages;
  provides_cache_backup = this.provides_cache;
  requires_cache_backup = this.requires_cache;

  this.packages = setremove(this.packages, object);
  this.provides_cache = this:_unmap_specifier(this.provides_cache, {identifier, version}, object);
  for provides in (`object.provides ! E_INVIND, E_TYPE, E_PROPNF => {}')
    this.provides_cache = this:_unmap_specifier(this.provides_cache, provides, object);
  endfor
  /* remove all records for all installed packages I require (don't use match here because we need to remove a specific record) */
  /* _find_requires_provider() must succeed because all prerequisites should have been checked */
  for requires in (`object.requires ! E_INVIND, E_TYPE, E_PROPNF => {}')
    provider = this:_find_requires_provider(requires[1], object);
    this.requires_cache = this:_unmap_specifier(this.requires_cache, provider[2..3], object);
  endfor
  error = 0;
finally
  /* after cleanup, allow the error to propagate upward */
  if (error)
    this.packages = packages_backup;
    this.provides_cache = provides_cache_backup;
    this.requires_cache = requires_cache_backup;
  endif
endtry
.

@verb __OBJECT__:"_find_requires_provider" this none this xd __PROGRAMMER__
@program __OBJECT__:_find_requires_provider
{identifier, object} = args;
(caller != this) && raise(E_PERM);
for _, version in (this.requires_cache[identifier])
  if (object in this.requires_cache[identifier][version])
    return {this.provides_cache[identifier][version][1], identifier, version};
  endif
endfor
.

@verb __OBJECT__:"reinitialize" this none this xd __PROGRAMMER__
@program __OBJECT__:reinitialize
caller_perms().wizard || raise(E_PERM);

/* Reinitializes the package caches from the specified list of
 * packages.  If the install fails (due to currently uninstalled
 * packages) it moves the package to the end of the list, continues,
 * and retries.
 */

if (args)
  objects = (length(args) == 1 && typeof(args[1]) == LIST) ? args[1] | args;
else
  objects = this.packages;
endif

for object in (objects)
  if (typeof(object) != OBJ)
    raise(E_INVARG, tostr("Invalid argument: ", object), object);
  endif
endfor

/* limit the iterations */
limit = length(objects) ^ 2;

packages_backup = this.packages;
requires_cache_backup = this.requires_cache;
provides_cache_backup = this.provides_cache;

this.packages = {};
this.requires_cache = [];
this.provides_cache = [];

while (objects && limit)
  {object, @objects} = objects;

  $suspend_if_necessary(0);

  limit = limit - 1;

  try
    this:_install(object.identifier, object.version, object);
  except (ANY)
    objects = {@objects, object};
  endtry
endwhile

if (objects)
  this.packages = packages_backup;
  this.requires_cache = requires_cache_backup;
  this.provides_cache = provides_cache_backup;
  failed = "";
  for object in (objects)
    failed = failed ? tostr(failed, ", ", object) | tostr(object);
  endfor
  raise(E_INVARG, tostr("Failed: ", failed), objects);
endif
.

@verb __OBJECT__:"_check_required_provides" this none this xd
@program __OBJECT__:_check_required_provides
{required} = args;
(caller != this) && raise(E_PERM);
for selector in (required)
  object = this:_match(@selector, this.provides_cache)[1];
  if (valid(object))
    required = setremove(required, selector);
  endif
endfor
return required;
.

@verb __OBJECT__:"_check_provided_requires" this none this xd __PROGRAMMER__
@program __OBJECT__:_check_provided_requires
{provided} = args;
(caller != this) && raise(E_PERM);
for package in (provided)
  {identifier, version} = package;
  object = `this.requires_cache[identifier][version][1] ! E_RANGE => $failed_match';
  if (!valid(object))
    provided = setremove(provided, package);
  endif
endfor
return provided;
.

@verb __OBJECT__:"_generate_global_mapping_keyed_on_object" this none this xd __WIZARD__
@program __OBJECT__:_generate_global_mapping_keyed_on_object
(caller != this) && raise(E_PERM);

{specifiers} = args;

/*
 * Take a list of package specifiers, ensure that the specified
 * packages are present/installed, and generate a mapping between
 * objects and identifiers based on the information in each
 * package manifest.
 *
 * $nothing maps to "__nothing__", and is included for free.
 */

global = {};

for specifier in (specifiers)
  this:_suspend_if_necessary();
  {package, ?identifier, ?version} = this:_match(@specifier, this.provides_cache);
  if ($failed_match == package)
    raise(E_INVARG, tostr("Failed match:  ", toliteral(specifier)));
  elseif ($ambiguous_match == package)
    raise(E_INVARG, tostr("Ambiguous match:  ", toliteral(specifier)));
  endif
  for item in (`package.manifest ! E_PROPNF => {}')
    {object, label} = item;
    global = {@global, {object, tostr(label, "|", identifier)}};
  endfor
endfor

global = {@global, {$nothing, "__nothing__"}};

return global;
.

@verb __OBJECT__:"_generate_global_mapping_keyed_on_identifier" this none this xd __WIZARD__
@program __OBJECT__:_generate_global_mapping_keyed_on_identifier
(caller != this) && raise(E_PERM);

{specifiers} = args;

/*
 * Take a list of package specifiers, ensure that the specified
 * packages are present/installed, and generate a mapping between
 * identifiers and objects based on the information in each
 * package manifest.
 *
 * "__nothing__" maps to $nothing, and is included for free.
 */

global = {};

for specifier in (specifiers)
  this:_suspend_if_necessary();
  {package, ?identifier, ?version} = this:_match(@specifier, this.provides_cache);
  if ($failed_match == package)
    raise(E_INVARG, tostr("Failed match:  ", toliteral(specifier)));
  elseif ($ambiguous_match == package)
    raise(E_INVARG, tostr("Ambiguous match:  ", toliteral(specifier)));
  endif
  for item in (`package.manifest ! E_PROPNF => {}')
    {object, label} = item;
    global = {@global, {tostr(label, "|", identifier), object}};
  endfor
endfor

global = {@global, {"__nothing__", $nothing}};

return global;
.

@verb __OBJECT__:"_map" this none this xd __PROGRAMMER__
@program __OBJECT__:_map
{verb, LIST, @options} = args;
(caller != this) && raise(E_PERM);
for i in [1..length(LIST)]
  this:_suspend_if_necessary();
  LIST[i] = this:(verb)(LIST[i], @options);
endfor
return LIST;
.

@verb __OBJECT__:"_lookup" this none this x __PROGRAMMER__
@program __OBJECT__:_lookup
(caller != this) && raise(E_PERM);

{collection, index} = args;

if (typeof(collection) == MAP)
  return collection[index];
else
  for item in (collection)
    if (item[1] == index)
      return item[2];
    endif
  endfor
endif

return E_RANGE;
.

@verb __OBJECT__:"_lookup_by_object" this none this xd __PROGRAMMER__
@program __OBJECT__:_lookup_by_object
(caller != this) && raise(E_PERM);

{object, global, local, package, ?target = ""} = args;

/* Given an object look up the corresponding reference/label. */

if (typeof(object) == LIST)
  return this:_map(verb, @args);
endif

if ((ret = this:_lookup(local, object)) != E_RANGE)
  return ret;
elseif ((ret = this:_lookup(global, object)) != E_RANGE)
  return ret;
elseif (`object.wizard ! E_INVIND')
  return "__wizard__";
elseif (object == caller_perms())
  return "__owner__";
elseif (object == package)
  return "__package__";
endif

if (target)
  raise(E_INVARG, tostr("Lookup failed for:  ", object, " on ", target));
else
  raise(E_INVARG, tostr("Lookup failed for:  ", object));
endif
.

@verb __OBJECT__:"_lookup_by_label" this none this xd __PROGRAMMER__
@program __OBJECT__:_lookup_by_label
(caller != this) && raise(E_PERM);

{label, global, local, package} = args;

/* Given a reference/label look up the corresponding object. */

if (typeof(label) == LIST)
  return this:_map(verb, @args);
endif

if ("__nothing__" == label)
  return this:_lookup(global, "__nothing__");
elseif ("__wizard__" == label)
  return caller_perms();
elseif ("__owner__" == label)
  return caller_perms();
elseif ("__package__" == label)
  return package;
elseif (r = match(label, "^%([a-z_][a-z0-9_]*%)%(|%([a-z][a-z0-9_]*%)%)?$"))
  reference = label[r[3][1][1]..r[3][1][2]];
  identifier = label[r[3][3][1]..r[3][3][2]];
  if (reference && identifier)
    if ((ret = this:_lookup(global, label)) != E_RANGE)
      return ret;
    endif
  else
    if ((ret = this:_lookup(local, label)) != E_RANGE)
      return ret;
    endif
  endif
endif

raise(E_INVARG, tostr("Lookup failed for:  ", toliteral(label)));
.

@verb __OBJECT__:"_is_ancestor" this none this xd __PROGRAMMER__
@program __OBJECT__:_is_ancestor
{subject, target, MAP} = args;
(caller != this) && raise(E_PERM);
keys = mapkeys(MAP);
stack = {target};
while (stack)
  this:_suspend_if_necessary();
  {target, @stack} = stack;
  if (target in keys)
    parents = `MAP[target]["Attributes"]["parents"]["Value"]["value"] ! E_RANGE => "__nothing__"';
    if (typeof(parents) == LIST)
      if (subject in parents)
        return 1;
      else
        stack = {@parents, @stack};
      endif
    else
      if (subject == parents)
        return 1;
      else
        stack = {parents, @stack};
      endif
    endif
  endif
endwhile
return 0;
.

@verb __OBJECT__:"_contents" this none this xd __PROGRAMMER__
@program __OBJECT__:_contents
{object} = args;
(caller != this) && raise(E_PERM);
objects = {};
if (valid(object))
  stack = {object};
  while (stack)
    top = stack[1];
    stack = {@top.contents, @stack[2..$]};
    objects = {@objects, top};
  endwhile
endif
return objects;
.

@verb __OBJECT__:"install" this none this xd __WIZARD__
@program __OBJECT__:install
caller_perms().wizard || raise(E_PERM);
`{package, @options} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  package, @options")';
if (options)
  if (typeof(options[1]) != MAP)
    {?identifier, ?version, ?options = []} = options;
  else
    options = options[1];
  endif
endif
try
  identifier;
  version;
except (E_VARNF)
  identifier = package.identifier;
  version = package.version;
endtry
(!valid(package.location)) || raise(E_INVARG, "Not in $nothing");
(package in this.packages) && raise(E_INVARG, "Package is already installed");
provides = `package.provides ! E_PROPNF => {}';
provides = {{identifier, version}, @provides};
for p in (provides)
  {id, v} = p;
  valid(this:_match(id, v)[1]) && raise(E_INVARG, tostr("Package is already installed:  identifier = ", id, ", version = ", v));
endfor
requires = `package.requires ! E_PROPNF => {}';
(requires = this:_check_required_provides(requires)) && raise(E_INVARG, tostr("Package requires:  ", toliteral(requires)));
errors = [];
if (respond_to(package, "before_install"))
  try
    package:before_install();
  except ex (ANY)
    errors["before_install"] = ex;
  endtry
endif
if (`options["follow-instructions"] ! ANY')
  this:_do_instructions(identifier, version, package);
endif
this:_install(identifier, version, package);
if (respond_to(package, "after_install"))
  try
    package:after_install();
  except ex (ANY)
    errors["after_install"] = ex;
  endtry
endif
return errors || 0;
.

@verb __OBJECT__:"uninstall" this none this xd __WIZARD__
@program __OBJECT__:uninstall
caller_perms().wizard || raise(E_PERM);
`{identifier, version, ?options = []} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  identifier, version, ?options")';
valid(object = this:_match(identifier, version)[1]) || raise(E_INVARG, tostr("Package is not installed:  identifier = ", identifier, ", version = ", version));
provides = `object.provides ! E_PROPNF => {}';
provides = {{identifier, version}, @provides};
(provides = this:_check_provided_requires(provides)) && raise(E_INVARG, tostr("Package provides:  ", toliteral(provides)));
errors = [];
if (respond_to(object, "before_uninstall"))
  try
    object:before_uninstall();
  except ex (ANY)
    errors["before_uninstall"] = ex;
  endtry
endif
if (`options["follow-instructions"] ! ANY')
  this:_undo_instructions(identifier, version, object);
endif
this:_uninstall(identifier, version, object);
if (respond_to(object, "after_uninstall"))
  try
    object:after_uninstall();
  except ex (ANY)
    errors["after_uninstall"] = ex;
  endtry
endif
return errors || 0;
.

@verb __OBJECT__:"delete" this none this xd __WIZARD__
@program __OBJECT__:delete
args || raise(E_ARGS);
packages = this.packages;
set_task_perms(caller_perms());
if (((t = typeof(args[1])) == OBJ) || (t == ANON))
  {object, ?options = []} = args;
  identifier = version = "";
else
  {identifier, version, ?options = []} = args;
  object = this:_match(identifier, version)[1];
  (object == $failed_match) && raise(E_INVARG, tostr("Package is not installed:  identifier = ", identifier, ", version = ", version));
endif
(object == $lookup("__package__")) && raise(E_INVARG, tostr("Can't delete privileged package:  identifier = ", object.identifier, ", version = ", object.version));
p = caller_perms();
while (valid(p))
  (p == object) && raise(E_INVARG, tostr(caller_perms(), " is/is inside of ", object));
  p = p.location;
endwhile
errors = [];
if (object in packages)
  identifier = identifier || object.identifier;
  version = version || object.version;
  provides = {{identifier, version}};
  (provides = this:_check_provided_requires(provides)) && raise(E_INVARG, tostr("Package provides:  ", toliteral(provides)));
  if (valid(object) && respond_to(object, "before_uninstall"))
    try
      object:before_uninstall();
    except ex (ANY)
      errors["before_uninstall"] = ex;
    endtry
  endif
  if (`options["follow-instructions"] ! ANY')
    this:_undo_instructions(identifier, version, object);
  endif
  this:_uninstall(identifier, version, object);
  if (valid(object) && respond_to(object, "after_uninstall"))
    try
      object:after_uninstall();
    except ex (ANY)
      errors["after_uninstall"] = ex;
    endtry
  endif
endif
if (valid(object))
  for item in (this:_contents(object))
    `recycle(item) ! ANY => 0';
  endfor
endif
return errors || 0;
.

@verb __OBJECT__:"_set_seconds_and_ticks" this none this xd __WIZARD__
@program __OBJECT__:_set_seconds_and_ticks
(caller != this) && raise(E_PERM);
bg_seconds = $server_options.bg_seconds;
bg_ticks = $server_options.bg_ticks;
$server_options.bg_seconds = 60 * 60;
$server_options.bg_ticks = (1024 * 1024) * 1024;
suspend(0);
return {bg_seconds, bg_ticks};
.

@verb __OBJECT__:"_reset_seconds_and_ticks" this none this xd __WIZARD__
@program __OBJECT__:_reset_seconds_and_ticks
(caller != this) && raise(E_PERM);
{args} = args;
{bg_seconds, bg_ticks} = args;
$server_options.bg_seconds = bg_seconds;
$server_options.bg_ticks = bg_ticks;
.

@verb __OBJECT__:"import" this none this xd __WIZARD__
@program __OBJECT__:import
{package} = args;
set_task_perms(caller_perms());
try
  configuration = package["Configuration"];
  version = configuration["version"];
  top = configuration["top"];
  objects = package["Objects"];
  objects[top];
except ex (E_TYPE, E_RANGE)
  raise(E_INVARG, "Incompatible package format");
endtry
(version in {"0.1", "0.2"}) || raise(E_INVARG, "Unsupported package version");
anonymous = (version == "0.2") ? configuration["anonymous"] | {};
requires = `objects[top]["Values"]["requires"]["Value"]["value"] ! E_RANGE => {}';
manifest = `objects[top]["Values"]["manifest"]["Value"]["value"] ! E_RANGE => {}';
relocate = `objects[top]["Values"]["relocate"]["Value"]["value"] ! E_RANGE => {}';
(missing = this:_check_required_provides(requires)) && raise(E_INVARG, tostr("Package requires:  ", toliteral(missing)));
global = this:_generate_global_mapping_keyed_on_identifier(requires);
labels = {};
mapkeys_objects = mapkeys(objects);
for label in (manifest)
  (label in mapkeys_objects) || raise(E_INVARG, tostr("Invalid value in `manifest':  ", label));
  labels = setadd(labels, label);
endfor
for label in (mapkeys_objects)
  labels = setadd(labels, label);
endfor
unsorted = labels;
labels = {};
for label in (unsorted)
  i = 1;
  for target in (labels)
    if (this:_is_ancestor(label, target, objects))
      break;
    endif
    i = i + 1;
  endfor
  labels = {@labels[1..i - 1], label, @labels[i..$]};
endfor
success = 0;
try
  local = {};
  locations = [];
  local = {@local, {top, top_object = create($nothing, top in anonymous)}};
  for label in (setremove(labels, top))
    this:_suspend_if_necessary();
    local = {@local, {label, object = create($nothing, label in anonymous)}};
    this:_move(object, top_object);
  endfor
  relocate_map = [];
  for reference in (relocate)
    this:_suspend_if_necessary();
    if (r = match(reference, "^%([a-z_][a-z0-9_]*%)%.%([a-z_][a-z0-9_]*%)$"))
      r1 = reference[r[3][1][1]..r[3][1][2]];
      r2 = reference[r[3][2][1]..r[3][2][2]];
      if (!(r2 in {"owner", "parents", "location"}))
        (r1 in mapkeys(relocate_map)) || (relocate_map[r1] = {});
        relocate_map[r1] = {@relocate_map[r1], r2};
      endif
    else
      raise(E_INVARG, tostr("Invalid reference in `relocate':  ", reference));
    endif
  endfor
  for label in (labels)
    this:_suspend_if_necessary();
    object = this:_lookup(local, label);
    definition = objects[label];
    if (`definition["Values"]["owner"] ! E_RANGE' != E_RANGE)
      if (caller_perms().wizard)
        definition["Values"]["owner"]["Value"]["value"] = this:_lookup_by_label(definition["Values"]["owner"]["Value"]["value"], global, local, top_object);
      else
        definition["Values"] = mapdelete(definition["Values"], "owner");
      endif
    endif
    if (`definition["Attributes"]["parents"] ! E_RANGE' != E_RANGE)
      definition["Attributes"]["parents"]["Value"]["value"] = this:_lookup_by_label(definition["Attributes"]["parents"]["Value"]["value"], global, local, top_object);
    endif
    if (`definition["Values"]["location"] ! E_RANGE' != E_RANGE)
      locations[label] = definition["Values"]["location"]["Value"]["value"];
      definition["Values"] = mapdelete(definition["Values"], "location");
    endif
    if (`relocate_map[label] ! E_RANGE => 0')
      for name in (relocate_map[label])
        this:_suspend_if_necessary();
        if (`definition["Values"][name]["Value"]["value"] ! E_RANGE => 0')
          definition["Values"][name]["Value"]["value"] = this:_lookup_by_label(definition["Values"][name]["Value"]["value"], global, local, top_object);
        else
          for property in (definition["Properties"])
            this:_suspend_if_necessary();
            if (property["Property"]["name"] == name)
              value = this:_lookup_by_label(property["Property"]["value"], global, local, top_object);
              definition["Values"][name] = ["Value" -> ["value" -> value]];
            endif
          endfor
        endif
      endfor
    endif
    for _, value in (definition["Values"])
      this:_suspend_if_necessary();
      if (`definition["Values"][value]["Value"]["owner"] ! E_RANGE' != E_RANGE)
        if (caller_perms().wizard)
          definition["Values"][value]["Value"]["owner"] = this:_lookup_by_label(definition["Values"][value]["Value"]["owner"], global, local, top_object);
        else
          definition["Values"][value]["Value"] = mapdelete(definition["Values"][value]["Value"], "owner");
        endif
      endif
    endfor
    for index in [1..length(definition["Verbs"])]
      this:_suspend_if_necessary();
      if (`definition["Verbs"][index]["Verb"]["owner"] ! E_RANGE' != E_RANGE)
        if (caller_perms().wizard)
          definition["Verbs"][index]["Verb"]["owner"] = this:_lookup_by_label(definition["Verbs"][index]["Verb"]["owner"], global, local, top_object);
        else
          definition["Verbs"][index]["Verb"] = mapdelete(definition["Verbs"][index]["Verb"], "owner");
        endif
      endif
    endfor
    for index in [1..length(definition["Properties"])]
      this:_suspend_if_necessary();
      if (`definition["Properties"][index]["Property"]["owner"] ! E_RANGE' != E_RANGE)
        if (caller_perms().wizard)
          definition["Properties"][index]["Property"]["owner"] = this:_lookup_by_label(definition["Properties"][index]["Property"]["owner"], global, local, top_object);
        else
          definition["Properties"][index]["Property"] = mapdelete(definition["Properties"][index]["Property"], "owner");
        endif
      endif
    endfor
    definition = __SHAPES__:write_object(object, definition, ["verbs" -> ["do-not-version" -> 1, "do-not-stamp" -> 1]]);
    objects[label] = definition;
    package["Objects"] = objects;
  endfor
  for label in (labels)
    this:_suspend_if_necessary();
    if ("Error" in mapkeys(package["Objects"][label]))
      raise("E_PACKAGE", "Error in package operation", package);
    endif
  endfor
  for label in (labels)
    this:_suspend_if_necessary();
    if (label != top)
      object = this:_lookup(local, label);
      value = `locations[label] ! E_RANGE => "__package__"';
      value = (value == "__package__") ? top_object | this:_lookup(local, value);
      this:_move(object, value);
    endif
  endfor
  for entry in [1..`length(top_object.manifest) ! E_PROPNF => 0']
    this:_suspend_if_necessary();
    top_object.manifest[entry] = {this:_lookup(local, top_object.manifest[entry]), top_object.manifest[entry]};
  endfor
  success = 1;
finally
  success || this:delete(top_object);
endtry
return top_object;
.

@verb __OBJECT__:"export" this none this xd __WIZARD__
@program __OBJECT__:export
{package, ?options = []} = args;
set_task_perms(caller_perms());
strip = `options["strip"] ! E_RANGE => {}';
truncate = `options["truncate"] ! E_RANGE => {}';
`valid(package) ! E_TYPE => 0' || raise(E_INVARG, "Not a valid package");
(!valid(package.location)) || raise(E_INVARG, "Not a valid package:  must not have a location");
requires = `package.requires ! E_PROPNF => {}';
manifest = `package.manifest ! E_PROPNF => {}';
relocate = `package.relocate ! E_PROPNF => {}';
objects = this:_contents(package);
for item in (manifest)
  {object, label} = item;
  `valid(object) ! E_TYPE' || raise(E_INVARG, tostr("Invalid object in manifest:  ", label));
  (caller_perms().wizard || (package.owner == object.owner)) || raise(E_PERM, tostr("Invalid object in manifest:  ", label));
  objects = setadd(objects, object);
endfor
definition = ["Configuration" -> ["Version" -> "0.2"], "Objects" -> []];
(missing = this:_check_required_provides(requires)) && raise(E_INVARG, tostr("Package requires:  ", toliteral(missing)));
global = this:_generate_global_mapping_keyed_on_object(requires);
for key in (`mapkeys(options["global"]) ! E_RANGE => {}')
  this:_suspend_if_necessary();
  global = {@global, {key, options["global"][key]}};
endfor
local = {};
anonymous = {};
for object in (objects)
  this:_suspend_if_necessary();
  if ((t = typeof(object)) == OBJ)
    label = tostr("__", toint(object), "__");
  else
    label = tostr("__", random(), "__");
  endif
  if (object == package)
    label = "__package__";
  endif
  for entry in (manifest)
    if (entry[1] == object)
      label = entry[2];
      break;
    endif
  endfor
  local = {@local, {object, label}};
  if (t == ANON)
    anonymous = {@anonymous, label};
  endif
  definition["Objects"][label] = __SHAPES__:read_object(object, ["strip_clear_values" -> 1]);
  if (object in strip)
    values = [];
    for name in ({"name", "owner", "location", "programmer", "wizard", "r", "w", "f", "a"})
      values[name] = definition["Objects"][label]["Values"][name];
    endfor
    for index in [1..length(definition["Objects"][label]["Properties"])]
      name = definition["Objects"][label]["Properties"][index]["property"]["name"];
      values[name] = definition["Objects"][label]["Values"][name];
    endfor
    definition["Objects"][label]["Values"] = values;
  endif
endfor
top = definition["Configuration"]["top"] = this:_lookup(local, package);
definition["Configuration"]["anonymous"] = anonymous;
labels = {};
for entry in (manifest)
  this:_suspend_if_necessary();
  labels = {@labels, entry[2]};
endfor
for object in (objects)
  this:_suspend_if_necessary();
  label = this:_lookup(local, object);
  for _, v in (definition["Objects"][label]["Values"])
    this:_suspend_if_necessary();
    if (`"owner" in mapkeys(definition["Objects"][label]["Values"][v]["Value"]) ! E_RANGE')
      definition["Objects"][label]["Values"][v]["Value"]["owner"] = this:_lookup_by_object(definition["Objects"][label]["Values"][v]["Value"]["owner"], global, local, package, label);
    endif
  endfor
  for i in [1..length(definition["Objects"][label]["Properties"])]
    this:_suspend_if_necessary();
    definition["Objects"][label]["Properties"][i]["Property"]["owner"] = this:_lookup_by_object(definition["Objects"][label]["Properties"][i]["Property"]["owner"], global, local, package, label);
  endfor
  for i in [1..length(definition["Objects"][label]["Verbs"])]
    this:_suspend_if_necessary();
    definition["Objects"][label]["Verbs"][i]["Verb"]["owner"] = this:_lookup_by_object(definition["Objects"][label]["Verbs"][i]["Verb"]["owner"], global, local, package, label);
  endfor
  if ("owner" in mapkeys(definition["Objects"][label]["Values"]))
    definition["Objects"][label]["Values"]["owner"]["Value"]["value"] = this:_lookup_by_object(definition["Objects"][label]["Values"]["owner"]["Value"]["value"], global, local, package, label);
  endif
  definition["Objects"][label]["Attributes"]["parents"]["Value"]["value"] = this:_lookup_by_object(definition["Objects"][label]["Attributes"]["parents"]["Value"]["value"], global, local, package, label);
  definition["Objects"][label]["Values"]["location"]["Value"]["value"] = this:_lookup_by_object(definition["Objects"][label]["Values"]["location"]["Value"]["value"], global, local, package, label);
endfor
for reference in (relocate)
  this:_suspend_if_necessary();
  if (r = match(reference, "^%([a-z_][a-z0-9_]*%)%.%([a-z_][a-z0-9_]*%)$"))
    r1 = reference[r[3][1][1]..r[3][1][2]];
    r2 = reference[r[3][2][1]..r[3][2][2]];
    if (r1 in labels)
      if (((r2 != "parents") && (r2 != "location")) && (r2 != "owner"))
        try
          definition["Objects"][r1]["Values"][r2]["Value"]["value"];
        except (E_RANGE)
          raise(E_INVARG, tostr("Invalid reference in `relocate':  \"", r2, "\" in \"", reference, "\""));
        endtry
        definition["Objects"][r1]["Values"][r2]["Value"]["value"] = this:_lookup_by_object(definition["Objects"][r1]["Values"][r2]["Value"]["value"], global, local, package, r1);
        for property in [1..length(definition["Objects"][r1]["Properties"])]
          this:_suspend_if_necessary();
          if (definition["Objects"][r1]["Properties"][property]["Property"]["name"] == r2)
            definition["Objects"][r1]["Properties"][property]["Property"]["value"] = definition["Objects"][r1]["Values"][r2]["Value"]["value"];
            break property;
          endif
        endfor
      endif
    else
      raise(E_INVARG, tostr("Invalid reference in `relocate':  \"", r1, "\" in \"", reference, "\""));
    endif
  else
    raise(E_INVARG, tostr("Invalid reference in `relocate':  ", reference));
  endif
endfor
for object in (truncate)
  this:_suspend_if_necessary();
  if (object in objects)
    label = this:_lookup(local, object);
    values = [];
    for _, value in (definition["Objects"][label]["Values"])
      this:_suspend_if_necessary();
      if (value in {"name", "owner", "location", "programmer", "wizard", "r", "w", "f", "a"})
        values[value] = definition["Objects"][label]["Values"][value];
      endif
    endfor
    definition["Objects"][label]["Values"] = values;
  endif
endfor
if (("manifest" in mapkeys(definition["Objects"][top]["Values"])) && (!definition["Objects"][top]["Values"]["manifest"]["Value"]["clear"]))
  for entry in [1..length(definition["Objects"][top]["Values"]["manifest"]["Value"]["value"])]
    this:_suspend_if_necessary();
    definition["Objects"][top]["Values"]["manifest"]["Value"]["value"][entry] = definition["Objects"][top]["Values"]["manifest"]["Value"]["value"][entry][2];
  endfor
endif
for property in [1..length(definition["Objects"][top]["Properties"])]
  this:_suspend_if_necessary();
  if (definition["Objects"][top]["Properties"][property]["Property"]["name"] == "manifest")
    for entry in [1..length(definition["Objects"][top]["Properties"][property]["Property"]["value"])]
      this:_suspend_if_necessary();
      definition["Objects"][top]["Properties"][property]["Property"]["value"][entry] = definition["Objects"][top]["Properties"][property]["Property"]["value"][entry][2];
    endfor
    break;
  endif
endfor
return definition;
.

@verb __OBJECT__:"_parse_url" this none this x __PROGRAMMER__
@program __OBJECT__:_parse_url
(caller != this) && raise(E_PERM);

{url} = args;

if ((r = match(url, "^http://%([^/:]+%)%(:[0-9]+%)?%(.*%)$")))
  host = url[r[3][1][1]..r[3][1][2]];
  port = toint(url[r[3][2][1] + 1..r[3][2][2]]) || 80;
  path = url[r[3][3][1]..r[3][3][2]];
  return {host, port, path};
else
  return 0;
endif
.

@verb __OBJECT__:"_fetch" this none this xd __WIZARD__
@program __OBJECT__:_fetch
(caller != this) && raise(E_PERM);

{url} = args;

/* Attempt an HTTP connection; handle success, follow redirects and
 * raise errors on everything else.  Note: this verb is optimized for
 * fetching package lists/packages, and takes a few short-cuts.  In
 * particular, it simply uses `strsub()' to encode/decode the MOO
 * binary string representation of tilde ("~"), relying on the fact
 * that packages _should not have_ any binary (non-printable)
 * characters in them.
 */

while redirect (1)
  try
    connection = 0;

    url = strsub(url, "~", "~7E");

    if ((r = this:_parse_url(url)))
      {host, port, path} = r;
    else
      raise(E_INVARG, "Bad URL");
    endif

    try
      connection = open_network_connection(host, port);
    except (E_INVARG)
      raise(E_INVARG, "Open network connection failed");
    endtry

    set_connection_option(connection, "hold-input", 1);
    set_connection_option(connection, "binary", 1);

    notify(connection, tostr("GET ", path, " HTTP/1.1~0D~0A"));
    notify(connection, (port != 80) ? tostr("Host: ", host, ":", port, "~0D~0A") | tostr("Host: ", host, "~0D~0A"));
    notify(connection, "Accept: application/json~0D~0A");
    notify(connection, "~0D~0A");

    response = read_http("response", connection);

    if (`reason = response["error"] ! E_RANGE')
      raise(E_INVARG, tostr("Fetch failed: ", reason[2]));
    elseif (!((status = response["status"]) in {200, 301, 302, 303, 307}))
      raise(E_INVARG, tostr("Fetch failed: invalid HTTP status: ", status));
    elseif (status / 100 == 3)
      try
        url = response["headers"]["location"];
        continue redirect;
      except (E_RANGE)
        raise(E_INVARG, "Fetch failed: missing HTTP header: Location");
      endtry
    endif

    json = strsub(response["body"], "~7E", "~");

    try
      return parse_json(json, "embedded-types");
    except (E_RANGE, E_INVARG)
      raise(E_INVARG, "Bad JSON");
    endtry

  finally
    `boot_player(connection) ! ANY';
  endtry

endwhile
.

@verb __OBJECT__:"fetch_index" this none this xd __PROGRAMMER__
@program __OBJECT__:fetch_index
caller_perms().wizard || raise(E_PERM);

args && raise(E_ARGS);

sources = this.archive_sources;

this:_notify(player, {"h2", [], "Updating index from archive sources"});

indexes = [];

for source in (sources)
  try
    this:_suspend_if_necessary();
    indexes[source] = this:_fetch(source);
    this:_notify(player, "   ", source);
  except ex (E_INVARG)
    this:_notify(player, "   ", source, " ... ", {"span", ["class" -> "error"], ex[2]});
  endtry
endfor

this:_notify(player);

archived = [];

while (sources)

  /* Fetch in reverse order.  The packages in the archives in
   * `archive_sources' will take precedence in order, first to last by
   * source.
   */

  source = sources[$];
  sources = sources[^ .. ($ - 1)];

  try
    index = indexes[source];
  except (E_RANGE)
    /* there must have been a fetch error */
    continue;
  endtry

  /* Handle both the old and new index formats.  Look for "_links" at
   * the top-level to distinguish the two.  See the HAL JSON
   * specification for details on the format.
   */

  if (`index["_links"] ! E_RANGE')
    for package in (index["_embedded"]["packages"])
      this:_suspend_if_necessary();
      mk = mapkeys(package);
      if ("identifier" in mk && "version" in mk && "_links" in mk)
        if (`href = package["_links"]["self"]["href"] ! E_RANGE')
          if ((r = this:_parse_url(href)))
            /* full URL -- use it as is */
          else
            r = this:_parse_url(source);
            if (href[1] == "/")              /* absolute URL */
              href = tostr("http://", r[1], ":", r[2], href);
            else                             /* relative URL */
              if ((i = rindex(r[3], "/")))
                href = tostr("http://", r[1], ":", r[2], r[3][1..i], href);
              else
                href = tostr("http://", r[1], ":", r[2], "/", href);
              endif
            endif
          endif
          identifier = package["identifier"];
          version = package["version"];
          requires = `package["requires"] ! E_RANGE => {}';
          `archived[identifier] ! E_RANGE' || (archived[identifier] = []);
          archived[identifier][version] = ["href" -> href, "requires" -> requires];
        endif
      endif
    endfor
  else
    for package in (index["Packages"])
      this:_suspend_if_necessary();
      mk = mapkeys(package);
      if ("identifier" in mk && "version" in mk && "link" in mk)
        mk = mapkeys(package["link"]);
        if ("uri" in mk && "rel" in mk && package["link"]["rel"] == "package")
          /* old style is relative URLs */
          uri = package["link"]["uri"];
          r = this:_parse_url(source);
          if ((i = rindex(r[3], "/")))
            href = tostr("http://", r[1], ":", r[2], r[3][1..i], uri);
          else
            href = tostr("http://", r[1], ":", r[2], "/", uri);
          endif
          identifier = package["identifier"];
          version = package["version"];
          requires = `package["requires"] ! E_RANGE => {}';
          `archived[identifier] ! E_RANGE' || (archived[identifier] = []);
          archived[identifier][version] = ["href" -> href, "requires" -> requires];
        endif
      endif
    endfor
  endif
endwhile

this.archived = archived;

this.last_fetch_index = time();

return archived;
.

@verb __OBJECT__:"fetch_package_to_cache" this none this xd __PROGRAMMER__
@program __OBJECT__:fetch_package_to_cache
caller_perms().wizard || raise(E_PERM);

`{identifier, version} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  identifier, version")';

package = this:_fetch(this.archived[identifier][version]["href"]);

top = package["Configuration"]["top"];

requires = `package["Objects"][top]["Values"]["requires"]["Value"]["value"] ! E_RANGE => {}';

packages = this.cached;

`packages[identifier] ! E_RANGE' || (packages[identifier] = []);
 packages[identifier][version] = ["definition" -> package, "requires" -> requires];

this.cached = packages;

return package;
.

@verb __OBJECT__:"import_package_from_archive" this none this xd __WIZARD__
@program __OBJECT__:import_package_from_archive
caller_perms().wizard || raise(E_PERM);

`{identifier, version, ?upgrade = 0} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  identifier, version, ?upgrade = 0")';

package = this:_fetch(this.archived[identifier][version]["href"]);

try
  package = this:import(package);
except ex ("E_PACKAGE")
  package = ex[3];
endtry

return package;
.

@verb __OBJECT__:"import_package_from_cache" this none this xd __WIZARD__
@program __OBJECT__:import_package_from_cache
caller_perms().wizard || raise(E_PERM);

`{identifier, version, ?upgrade = 0} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  identifier, version, ?upgrade = 0")';

package = this.cached[identifier][version]["definition"];

try
  package = this:import(package);
except ex ("E_PACKAGE")
  package = ex[3];
endtry

return package;
.

@verb __OBJECT__:"export_package_to_cache" this none this xd __WIZARD__
@program __OBJECT__:export_package_to_cache
caller_perms().wizard || raise(E_PERM);

`{identifier, version, ?force = 1} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  identifier, version, ?force = 1")';

package = this:_match(identifier, version)[1];

package = this:export(package);

top = package["Configuration"]["top"];

requires = `package["Objects"][top]["Values"]["requires"]["Value"]["value"] ! E_RANGE => {}';

packages = this.cached;

`packages[identifier] ! E_RANGE' || (packages[identifier] = []);
packages[identifier][version] = ["definition" -> package, "requires" -> requires];

this.cached = packages;

return package;
.

@verb __OBJECT__:"import_package_from_file" this none this xd __WIZARD__
@program __OBJECT__:import_package_from_file
caller_perms().wizard || raise(E_PERM);

`{pathname, ?options = []} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  pathname, ?options")';

fh = -1;
try
  fh = file_open(pathname, "r-tn");
  package = parse_json(file_readline(fh), "embedded-types");
finally
  (fh > -1) && file_close(fh);
endtry

try
  package = this:import(package);
except ex ("E_PACKAGE")
  package = ex[3];
endtry

return package;
.

@verb __OBJECT__:"export_package_to_file" this none this xd __WIZARD__
@program __OBJECT__:export_package_to_file
caller_perms().wizard || raise(E_PERM);

`{identifier, version, pathname, ?options = []} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  identifier, version, pathname, ?options")';

package = this:_match(identifier, version)[1];

package = this:export(package, options);

fh = -1;
try
  fh = file_open(pathname, "w-tn");
  file_writeline(fh, generate_json(package, "embedded-types"));
finally
  (fh > -1) && file_close(fh);
endtry

return package;
.

@verb __OBJECT__:"pretty_print_cached_package" this none this xd __WIZARD__
@program __OBJECT__:pretty_print_cached_package
caller_perms().wizard || raise(E_PERM);

`{identifier, version} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  identifier, version")';

package = this.cached[identifier][version]["definition"];

json = generate_json(package, "embedded-types");

suspend(0);

while (len = length(json))
  suspend(0);
  len = len > 60000 ? 60000 | len;
  line = json[1..len];
  json[1..len] = "";
  while (buffered_output_length(player))
    suspend(0);
  endwhile
  notify(player, line);
endwhile
.

@verb __OBJECT__:"@install" any with this xd __WIZARD__
@program __OBJECT__:@install
if (callers() && caller_perms() != player)
  raise(E_PERM);
endif
if (!player.wizard)
  notify(player, "Only wizards can do that!");
  return;
endif
if (r = match(dobjstr, "^ *%([_a-z0-9]+%) *%([0-9]+%.[0-9]+%.[0-9]+%)? *$"))
  /* Modify the execution limits to give this (potentially)
   * long-running task some breathing room, and to keep things
   * atomic.
   */
  seconds_and_ticks = 0;
  try
    seconds_and_ticks = this:_set_seconds_and_ticks();

    identifier = dobjstr[r[3][1][1]..r[3][1][2]];
    version = dobjstr[r[3][2][1]..r[3][2][2]];

    if (`this.provides_cache[identifier] ! E_RANGE' != E_RANGE)
      notify(player, tostr("Package \"", identifier, "\" is already installed."));
      return;
    elseif (`this.archived[identifier] ! E_RANGE' == E_RANGE && `this.cached[identifier] ! E_RANGE' == E_RANGE)
      notify(player, tostr("Package \"", identifier, "\" doesn't exist in either the remote archive or local cache."));
      return;
    else
      if (version)
        if (`this.archived[identifier][version] ! E_RANGE' == E_RANGE && `this.cached[identifier][version] ! E_RANGE' == E_RANGE)
          notify(player, tostr("Version \"", version, "\" of package \"", identifier, "\" doesn't exist in either the remote archive or local cache."));
          return;
        endif
      else
        cached = `mapkeys(this.cached[identifier]) ! E_RANGE => {}';
        archived = `mapkeys(this.archived[identifier]) ! E_RANGE => {}';
        versions = {@cached, @archived};
        versions = this:_map("_parse_version", versions);
        versions = this:_sort_versions(versions);
        version = versions[1];
        version = tostr(version[1], ".", version[2], ".", version[3]);
      endif
    endif

    if (`this.cached[identifier][version] ! E_RANGE' != E_RANGE)
      requires = `this.cached[identifier][version]["requires"] ! E_RANGE => {}';
    else
      requires = `this.archived[identifier][version]["requires"] ! E_RANGE => {}';
    endif

    if (requires && (requires = this:_check_required_provides(requires)))
      notify(player, tostr("Version \"", version, "\" of package \"", identifier, "\" couldn't be installed because it requires:"));
      sep = "";
      line = "  ";
      for require in (requires)
        {ispec, ?vspec = ""} = require;
        if (vspec)
          line = tostr(line, sep, ispec, " ", vspec);
        else
          line = tostr(line, sep, ispec);
        endif
        sep = ", ";
      endfor
      notify(player, line);
      return;
    endif

    if (`this.cached[identifier][version] ! E_RANGE' != E_RANGE)
      notify(player, tostr("Installing version \"", version, "\" of package \"", identifier, "\" from the local cache..."));
      package = this:import_package_from_cache(identifier, version);
    else
      notify(player, tostr("Installing version \"", version, "\" of package \"", identifier, "\" from the remote archive..."));
      package = this:import_package_from_archive(identifier, version);
    endif

    if ((t = typeof(package)) == OBJ || t == ANON)
      this:install(package, ["follow-instructions" -> 1]);

    else
      notify(player, tostr("Version \"", version, "\" of package \"", identifier, "\" couldn't be installed (raw package below)."));
      notify(player, toliteral(package));
      return;
    endif

    notify(player, tostr("Version \"", version, "\" of package \"", identifier, "\" (", package.name, ") was successfully installed as ", package, "."));

  finally
    this:_reset_seconds_and_ticks(seconds_and_ticks);
  endtry

else
  notify(player, tostr("Correct usage is:  @install <package identifier> <package version> with $composed"));
  notify(player, tostr("     for example:  @install foobar 1.2.3 with $composed"));
endif
.

@verb __OBJECT__:"@uninstall" any with this xd __WIZARD__
@program __OBJECT__:@uninstall
if (callers() && caller_perms() != player)
  raise(E_PERM);
endif
if (!player.wizard)
  notify(player, "Only wizards can do that!");
  return;
endif
if (r = match(dobjstr, "^ *%([_a-z0-9]+%) *%([0-9]+%.[0-9]+%.[0-9]+%) *$"))
  identifier = dobjstr[r[3][1][1]..r[3][1][2]];
  version = dobjstr[r[3][2][1]..r[3][2][2]];

  if (`this.provides_cache[identifier][version] ! E_RANGE' == E_RANGE)
    notify(player, tostr("Version \"", version, "\" of package \"", identifier, "\" is not installed."));
    return;
  endif

  package = this.provides_cache[identifier][version][1];

  this:delete(package, ["follow-instructions" -> 1]);

  notify(player, tostr("Version \"", version, "\" of package \"", identifier, "\" was successfully uninstalled."));

else
  notify(player, tostr("Correct usage is:  @uninstall <package identifier> <package version> with $composed"));
  notify(player, tostr("     for example:  @uninstall foobar 1.2.3 with $composed"));
endif
.

@verb __OBJECT__:"@list*-packages" any with this xd __WIZARD__
@program __OBJECT__:@list-packages
if (callers() && caller_perms() != player)
  raise(E_PERM);
endif
if (!player.wizard)
  this:_notify(player, "Only wizards can do that!");
  return;
endif
if (dobjstr && dobjstr != "packages")
  this:_notify(player, "I couldn't list that.");
  this:_notify(player, "Usage: ", {"code", [], verb, " packages with $composed"});
  this:_notify(player, "       ", {"code", [], verb, " with $composed"});
  return;
endif

this:fetch_index();

cached = this.cached;
archived = this.archived;

this:_notify(player, {"h2", [], "Installed packages"});
for _, identifier in (this.provides_cache)
  for _, version in (this.provides_cache[identifier])
    this:_suspend_if_necessary();
    if (`version in mapkeys(cached[identifier]) ! E_RANGE' || `version in mapkeys(archived[identifier]) ! E_RANGE')
      this:_notify(player, {"span", [], "   ", identifier, ", ", version, " (", objnum = this.provides_cache[identifier][version][1], ") ", objnum.name});
    else
      this:_notify(player, {"span", ["class" -> "information"], " ! ", identifier, ", ", version, " (", objnum = this.provides_cache[identifier][version][1], ") ", objnum.name});
    endif
  endfor
endfor
this:_notify(player);

this:_notify(player, {"h2", [], "Packages available from cache"});
for _, identifier in (this.cached)
  this:_suspend_if_necessary();
  versions = "";
  for _, version in (this.cached[identifier])
    versions = versions + ", " + version;
  endfor
  this:_notify(player, "   ", identifier, versions);
endfor
this:_notify(player);

this:_notify(player, {"h2", [], "Packages available from archives"});
for _, identifier in (this.archived)
  this:_suspend_if_necessary();
  versions = "";
  for _, version in (this.archived[identifier])
    versions = versions + ", " + version;
  endfor
  this:_notify(player, "   ", identifier, versions);
endfor
this:_notify(player);

this:_notify(player, "(done)");
.

@verb __OBJECT__:"_do_instructions" this none this xd __WIZARD__
@program __OBJECT__:_do_instructions
(caller != this) && raise(E_PERM);

{identifier, version, package} = args;

manifest = `package.manifest ! E_PROPNF => {}';
instructions = `package.instructions ! E_PROPNF => {}';
if ("install-dictionary" in instructions)
  for item in (manifest)
    {object, label} = item;
    if ("dictionary" == label)
      notify(player, tostr("Adding package dictionary (", object.name, ") to parents of $system..."));
      parents = {@parents($system), object};
      chparents($system, parents);
      break;
    endif
  endfor
endif
if ("install-namespace" in instructions)
  for item in (manifest)
    {object, label} = item;
    if ("dictionary" == label)
      notify(player, tostr("Adding namespace (", identifier, ") as a property on $system..."));
      add_property($system, identifier, object, {package, "r"});
      break;
    endif
  endfor
endif
for instruction in (instructions)
  if (typeof(`$sysobj ! ANY') == OBJ && (r = match(instruction, "^install-%([_a-z0-9]+%)-on-legacy-core$")))
    property = instruction[r[3][1][1]..r[3][1][2]];
    for item in (manifest)
      {object, label} = item;
      if (property == label)
        notify(player, tostr("Adding property (", label, ") to $sysobj..."));
        add_property($sysobj, label, object, {package, "r"});
      endif
    endfor
  endif
endfor
.

@verb __OBJECT__:"_undo_instructions" this none this xd __WIZARD__
@program __OBJECT__:_undo_instructions
(caller != this) && raise(E_PERM);

{identifier, version, package} = args;

manifest = `package.manifest ! E_PROPNF => {}';
instructions = `package.instructions ! E_PROPNF => {}';
if ("install-dictionary" in instructions)
  for item in (manifest)
    {object, label} = item;
    if ("dictionary" == label && object in parents($system))
      notify(player, tostr("Removing package dictionary (", object.name, ") from parents of $system..."));
      parents = setremove(parents($system), object);
      chparents($system, parents);
      break;
    endif
  endfor
endif
if ("install-namespace" in instructions)
  for item in (manifest)
    {object, label} = item;
    if ("dictionary" == label && identifier in properties($system))
      notify(player, tostr("Removing namespace (", identifier, ") as a property on $system..."));
      delete_property($system, identifier);
      break;
    endif
  endfor
endif
for instruction in (instructions)
  if (typeof(`$sysobj ! ANY') == OBJ && (r = match(instruction, "^install-%([_a-z0-9]+%)-on-legacy-core$")))
    property = instruction[r[3][1][1]..r[3][1][2]];
    for item in (manifest)
      {object, label} = item;
      if (property == label && property in properties($sysobj))
        notify(player, tostr("Removing property (", label, ") from $sysobj..."));
        delete_property($sysobj, label);
      endif
    endfor
  endif
endfor
.

"***finished***