LambdaCore Compatible Dump of Composed

composed.moo

; create($nothing)

@prop #102."packages" 0 ""
@prop #102."provides_cache" 0 ""
@prop #102."requires_cache" 0 ""
@prop #102."last_fetch_index" 0 ""
@prop #102."archived" 0 ""
@prop #102."cached" 0 ""
@prop #102."archive_host" "207.210.101.162" ""
@prop #102."archive_port" 80 ""
@prop #102."archive_base_uri" "/v1" ""

; #102.packages = {}
; #102.provides_cache = []
; #102.requires_cache = []
; #102.archived = []
; #102.cached = []

@prop #102."shapes" #101 "r"
@prop #102."composed" #102 "r"

@verb #102:"_log" this none this xd
@program #102:_log
notify(player, tostr(@args));
.

@verb #102:"_move" this none this xd
@program #102:_move
{what, where} = args;
`move(what, where) ! ANY';
.

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

@verb #102:"_parse_specifier" this none this xd
@program #102:_parse_specifier
{specifier} = args;
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 #102:"_parse_operation" this none this xd
@program #102:_parse_operation
{operation} = args;
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 #102:"_parse_version" this none this xd
@program #102:_parse_version
{version} = args;
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 #102:"_compare_versions" this none this xd
@program #102:_compare_versions
{ver1, ver2} = args;
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 #102:"_sort_versions" this none this xd
@program #102:_sort_versions
{vers} = args;
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 #102:"_match match" this none this xd
@program #102:_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 => #-1') == #-1)
return {#-3};
endif
operations = {};
for pattern in (patterns)
this:_suspend_if_necessary();
operations = {@operations, this:_parse_operation(pattern)};
endfor
for version in (mapkeys(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 {#-3};
elseif (length(versions) > 1)
return {#-2};
else
version = mapkeys(versions)[1];
object = mapvalues(versions)[1][1];
return {object, identifier, version};
endif
.

@verb #102:"_map_specifier" this none this xd
@program #102:_map_specifier
{MAP, specifier, object} = args;
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 #102:"_unmap_specifier" this none this xd
@program #102:_unmap_specifier
{MAP, specifier, object} = args;
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 #102:"_install" this none this xd
@program #102:_install
{identifier, version, object} = args;
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
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
.

@verb #102:"_uninstall" this none this xd
@program #102:_uninstall
{identifier, version, object} = args;
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
for requires in (`object.requires ! E_INVIND, E_TYPE, E_PROPNF => {}')
if (provider = this:_find_requires_provider(requires[1], object))
this.requires_cache = this:_unmap_specifier(this.requires_cache, provider[2..3], object);
endif
endfor
.

@verb #102:"_find_requires_provider" this none this xd
@program #102:_find_requires_provider
{identifier, object} = args;
for version in (mapkeys(this.requires_cache[identifier]))
if (object in this.requires_cache[identifier][version])
return {this.provides_cache[identifier][version][1], identifier, version};
endif
endfor
.

@verb #102:"reinitialize" this none this xd
@program #102:reinitialize
objects = args;
this.packages = {};
this.provides_cache = [];
this.requires_cache = [];
for object in (objects)
this:_install(object.identifier, object.version, object);
endfor
.

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

@verb #102:"_check_provided_requires" this none this xd
@program #102:_check_provided_requires
{provided} = args;
for package in (provided)
{identifier, version} = package;
object = `this.requires_cache[identifier][version][1] ! E_RANGE => #-3';
if (!valid(object))
provided = setremove(provided, package);
endif
endfor
return provided;
.

@verb #102:"_generate_global_mapping_keyed_on_object_number" this none this xd
@program #102:_generate_global_mapping_keyed_on_object_number
{specifiers} = args;
global = [];
for specifier in (specifiers)
this:_suspend_if_necessary();
{package, ?identifier, ?version} = this:_match(@specifier, this.provides_cache);
if (#-3 == package)
raise(E_INVARG, tostr("Failed match:  ", toliteral(specifier)));
elseif (#-2 == package)
raise(E_INVARG, tostr("Ambiguous match:  ", toliteral(specifier)));
endif
for item in (`package.manifest ! E_PROPNF => {}')
{object, label} = item;
global[object] = tostr(label, "|", identifier);
endfor
endfor
global[#-1] = "__nothing__";
return global;
.

@verb #102:"_generate_global_mapping_keyed_on_identifier" this none this xd
@program #102:_generate_global_mapping_keyed_on_identifier
{specifiers} = args;
global = [];
for specifier in (specifiers)
this:_suspend_if_necessary();
{package, ?identifier, ?version} = this:_match(@specifier, this.provides_cache);
if (#-3 == package)
raise(E_INVARG, tostr("Failed match:  ", toliteral(specifier)));
elseif (#-2 == package)
raise(E_INVARG, tostr("Ambiguous match:  ", toliteral(specifier)));
endif
for item in (`package.manifest ! E_PROPNF => {}')
{object, label} = item;
global[tostr(label, "|", identifier)] = object;
endfor
endfor
global["__nothing__"] = #-1;
return global;
.

@verb #102:"_map" this none this xd
@program #102:_map
{verb, LIST, @options} = args;
for i in [1..length(LIST)]
this:_suspend_if_necessary();
LIST[i] = this:(verb)(LIST[i], @options);
endfor
return LIST;
.

@verb #102:"_lookup_by_object_number" this none this xd
@program #102:_lookup_by_object_number
{object, global, local, package, ?target = ""} = args;
if (typeof(object) == LIST)
return this:_map(verb, @args);
endif
if (`ret = local[object] ! E_RANGE' != E_RANGE)
return ret;
elseif (`ret = global[object] ! E_RANGE' != 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 #102:"_lookup_by_label" this none this xd
@program #102:_lookup_by_label
{label, global, local, package} = args;
if (typeof(label) == LIST)
return this:_map(verb, @args);
endif
if ("__nothing__" == label)
return 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]];
try
if (reference && identifier)
return global[label];
else
return local[label];
endif
except (E_RANGE)
endtry
endif
raise(E_INVARG, tostr("Lookup failed for:  ", toliteral(label)));
.

@verb #102:"_is_ancestor" this none this xd
@program #102:_is_ancestor
{subject, target, MAP} = args;
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 #102:"_contents" this none this xd
@program #102:_contents
{object} = args;
objects = {};
if (valid(object))
stack = {object};
while (stack)
top = stack[1];
stack = {@top.contents, @stack[2..$]};
objects = {@objects, top};
endwhile
endif
return objects;
.

@verb #102:"install" this none this xd
@program #102:install
`{package, ?identifier, ?version} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  package, ?identifier, ?version")';
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
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 #102:"uninstall" this none this xd
@program #102:uninstall
`{identifier, version} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  identifier, version")';
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
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 #102:"delete" this none this xd
@program #102:delete
args || raise(E_ARGS);
packages = this.packages;
set_task_perms(caller_perms());
if (length(args) == 1)
{object} = args;
identifier = version = "";
else
{identifier, version} = args;
object = this:_match(identifier, version)[1];
object == #-3 && raise(E_INVARG, tostr("Package is not installed:  identifier = ", identifier, ", version = ", version));
endif
object <= #2 && raise(E_INVARG, tostr("Privileged package:  identifier = ", object.identifier, ", version = ", object.version));
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
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 #102:"import" this none this xd
@program #102: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 == "0.1" || raise(E_INVARG, "Unsupported package version");
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 = {};
for label in (manifest)
label in mapkeys(objects) || raise(E_INVARG, tostr("Invalid manifest value:  ", 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[top] = create(#-1);
for label in (setremove(labels, top))
this:_suspend_if_necessary();
local[label] = create(#-1);
this:_move(local[label], local[top]);
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 = 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, local[top]);
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, local[top]);
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, local[top]);
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, local[top]);
definition["Values"][name] = ["Value" -> ["value" -> value]];
endif
endfor
endif
endfor
endif
for value in (mapkeys(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, local[top]);
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, local[top]);
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, local[top]);
else
definition["Properties"][index]["Property"] = mapdelete(definition["Properties"][index]["Property"], "owner");
endif
endif
endfor
definition = this.shapes:write_object(object, definition);
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 = local[label];
value = `locations[label] ! E_RANGE => "__package__"';
value = value == "__package__" ? local[top] | local[value];
this:_move(object, value);
endif
endfor
for entry in [1..`length(local[top].manifest) ! E_PROPNF => 0']
this:_suspend_if_necessary();
local[top].manifest[entry] = {local[local[top].manifest[entry]], local[top].manifest[entry]};
endfor
success = 1;
finally
success || this:delete(local[top]);
endtry
return local[top];
.

@verb #102:"export" this none this xd
@program #102: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);
definition = ["Configuration" -> ["Version" -> "0.1"], "Objects" -> []];
(missing = this:_check_required_provides(requires)) && raise(E_INVARG, tostr("Package requires:  ", toliteral(missing)));
global = this:_generate_global_mapping_keyed_on_object_number(requires);
for key in (`mapkeys(options["global"]) ! E_RANGE => {}')
this:_suspend_if_necessary();
global[key] = options["global"][key];
endfor
local = [];
for object in (objects)
this:_suspend_if_necessary();
label = tostr("__", toint(object), "__");
if (object == package)
label = "__package__";
endif
for entry in (manifest)
if (entry[1] == object)
label = entry[2];
break;
endif
endfor
local[object] = label;
definition["Objects"][label] = this.shapes:read_object(object);
if (object in strip)
values = [];
for name in ({"name", "owner", "location", "programmer", "wizard", "r", "w", "f"})
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"] = local[package];
labels = {};
for entry in (manifest)
this:_suspend_if_necessary();
labels = {@labels, entry[2]};
endfor
for object in (objects)
this:_suspend_if_necessary();
label = local[object];
for v in (mapkeys(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_number(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_number(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_number(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_number(definition["Objects"][label]["Values"]["owner"]["Value"]["value"], global, local, package, label);
endif
definition["Objects"][label]["Attributes"]["parents"]["Value"]["value"] = this:_lookup_by_object_number(definition["Objects"][label]["Attributes"]["parents"]["Value"]["value"], global, local, package, label);
definition["Objects"][label]["Values"]["location"]["Value"]["value"] = this:_lookup_by_object_number(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")
definition["Objects"][r1]["Values"][r2]["Value"]["value"] = this:_lookup_by_object_number(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':  ", 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 = local[object];
values = [];
for value in (mapkeys(definition["Objects"][label]["Values"]))
this:_suspend_if_necessary();
if (value in {"name", "owner", "location", "programmer", "wizard", "r", "w", "f"})
values[value] = definition["Objects"][label]["Values"][value];
endif
endfor
definition["Objects"][label]["Values"] = values;
endif
endfor
if ("manifest" in mapkeys(definition["Objects"][top]["Values"]))
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 #102:"audit" this none this xd
@program #102:audit
{package, ?options = []} = args;
set_task_perms(caller_perms());
dictionary = `options["dictionary"] ! E_RANGE => ""';
no_properties = `options["no-properties"] ! E_RANGE => 0';
no_verbs = `options["no-verbs"] ! E_RANGE => 0';
errors = {};
warnings = {};
requires = `package.requires ! E_PROPNF => {}';
manifest = `package.manifest ! E_PROPNF => {}';
relocate = `package.relocate ! E_PROPNF => {}';
global = [];
for specifier in (requires)
this:_suspend_if_necessary();
{other, ?identifier, ?version} = this:_match(@specifier, this.provides_cache);
if (#-3 == package)
raise(E_INVARG, tostr("Failed match:  ", toliteral(specifier)));
elseif (#-2 == package)
raise(E_INVARG, tostr("Ambiguous match:  ", toliteral(specifier)));
endif
for item in (`other.manifest ! E_PROPNF => {}')
{object, label} = item;
global[object] = tostr(label, "|", identifier);
global[tostr(label, "|", identifier)] = object;
endfor
endfor
global[#-1] = "__nothing__";
global["__nothing__"] = #-1;
local = [];
for item in (manifest)
this:_suspend_if_necessary();
{object, label} = item;
local[object] = label;
local[label] = object;
endfor
for object in (this:_contents(package))
if (`local[object] ! E_RANGE' == E_RANGE)
local[object] = tostr("__", toint(object), "__");
local[tostr("__", toint(object), "__")] = object;
endif
endfor
if (dictionary)
dictionary = `this:_lookup_by_label(dictionary, global, local, package) ! E_INVARG => #-1';
endif
objects = this:_contents(package);
for item in (manifest)
{object, label} = item;
if (!(object in objects))
errors = {@errors, tostr(package, ".manifest lists non-member \"", label, "\"")};
endif
endfor
for item in (relocate)
if ((i = index(item, ".")) && (object = item[1..i - 1]) && (property = item[i + 1..$]))
if (valid(`object = this:_lookup_by_label(object, global, local, package) ! E_INVARG => #-1'))
if ("owner" == property || "parents" == property || "location" == property)
continue;
endif
try
info = property_info(object, property);
if (caller_perms().wizard || caller_perms() == info[1] || index(info[2], "w"))
continue;
endif
except (ANY)
endtry
endif
endif
errors = {@errors, tostr(package, ".relocate lists unknown reference \"", item, "\"")};
endfor
for object in (objects)
this:_suspend_if_necessary();
if (dictionary != object)
parents = parents(object);
try
value = this:_lookup_by_object_number(parents, global, local, package);
except (E_INVARG)
errors = {@errors, tostr(object, ".parents = ", toliteral(parents))};
endtry
endif
if (dictionary != object)
location = object.location;
try
value = this:_lookup_by_object_number(location, global, local, package);
except (E_INVARG)
errors = {@errors, tostr(object, ".location = ", location)};
endtry
endif
if (!no_properties)
properties = {};
ancestors = {object, @ancestors(object)};
for ancestor in (ancestors)
try
ancestor_properties = properties(ancestor);
for property in (ancestor_properties)
this:_suspend_if_necessary();
try
info = property_info(ancestor, property);
if (caller_perms().wizard || caller_perms() == info[1] || index(info[2], "w"))
properties = {@properties, property};
else
warnings = {@warnings, tostr("can't write property \"", property, "\" on ", ancestor)};
endif
except (E_PERM)
warnings = {@warnings, tostr("can't read property \"", property, "\" on ", ancestor)};
endtry
endfor
except (E_PERM)
warnings = {@warnings, tostr("can't read properties on ", ancestor)};
endtry
if (dictionary == object)
break;
endif
endfor
label = this:_lookup_by_object_number(object, global, local, package);
for property in (properties)
this:_suspend_if_necessary();
value = object.(property);
if (typeof(value) == OBJ)
if (!(tostr(label, ".", property) in relocate))
warnings = {@warnings, tostr("property \"", property, "\" on ", object, " references ", value, ", but relocate does not include \"", label, ".", property, "\"")};
elseif (!`this:_lookup_by_object_number(value, global, local, package) ! E_INVARG => 0')
warnings = {@warnings, tostr("property \"", property, "\" on ", object, " references ", value, " which can't be relocated because it can't be resolved locally or globally")};
endif
endif
endfor
endif
if (!no_verbs)
verbs = {};
try
object_verbs = verbs(object);
for verb in [1..length(object_verbs)]
this:_suspend_if_necessary();
try
info = verb_info(object, verb);
if (caller_perms().wizard || caller_perms() == info[1] || index(info[2], "w"))
verbs = {@verbs, verb};
else
warnings = {@warnings, tostr("can't write verb \"", object_verbs[verb], "\" on ", object)};
endif
except (E_PERM)
warnings = {@warnings, tostr("can't read verb \"", object_verbs[verb], "\" on ", object)};
endtry
endfor
except (E_PERM)
warnings = {@warnings, tostr("can't read verbs on ", object)};
endtry
for verb in (verbs)
this:_suspend_if_necessary();
info = verb_info(object, verb);
code = verb_code(object, verb, 0, 0);
for line in (code)
if (r = match(line, "#-?[0-9]+"))
warnings = {@warnings, tostr("verb \"", info[3], "\" on ", object, " references ", r[4][r[1]..r[2]], " (\"", line, "\")")};
endif
endfor
endfor
endif
endfor
out = [];
errors && (out["errors"] = errors);
warnings && (out["warnings"] = warnings);
return out;
.

@verb #102:"_fetch_from_archive" this none this xd
@program #102:_fetch_from_archive
{host, port, uri} = args;
cnct = 0;
try
cnct = open_network_connection(host, port);
set_connection_option(cnct, "hold-input", 1);
notify(cnct, tostr("GET ", uri, " HTTP/1.1"));
notify(cnct, tostr("Host: ", host, ":", port));
notify(cnct, "");
while (line = read(cnct))
endwhile
json = read(cnct);
return parse_json(json, "embedded-types");
finally
typeof(cnct) == OBJ && boot_player(cnct);
endtry
.

@verb #102:"fetch_index" this none this xd
@program #102:fetch_index
args && raise(E_ARGS);
index = this:_fetch_from_archive(this.archive_host, this.archive_port, this.archive_base_uri + "/packages.json");
packages = [];
for package in (index["Packages"])
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")
identifier = package["identifier"];
version = package["version"];
uri = package["link"]["uri"];
`packages[identifier] ! E_RANGE' || (packages[identifier] = []);
packages[identifier][version] = uri;
endif
endif
endfor
this.archived = packages;
this.last_fetch_index = time();
return packages;
.

@verb #102:"fetch_package_to_cache" this none this xd
@program #102:fetch_package_to_cache
{identifier, version} = args;
package = this:_fetch_from_archive(this.archive_host, this.archive_port, this.archive_base_uri + "/" + this.archived[identifier][version]);
packages = this.cached;
`packages[identifier] ! E_RANGE' || (packages[identifier] = []);
packages[identifier][version] = package;
this.cached = packages;
return package;
.

@verb #102:"import_package_from_archive" this none this xd
@program #102:import_package_from_archive
`{identifier, version, ?upgrade = 0} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  identifier, version, ?upgrade = 0")';
package = this:_fetch_from_archive(this.archive_host, this.archive_port, this.archive_base_uri + "/" + this.archived[identifier][version]);
try
package = this:import(package);
except ex ("E_PACKAGE")
package = ex[3];
endtry
return package;
.

@verb #102:"import_package_from_cache" this none this xd
@program #102:import_package_from_cache
`{identifier, version, ?upgrade = 0} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  identifier, version, ?upgrade = 0")';
package = this.cached[identifier][version];
try
package = this:import(package);
except ex ("E_PACKAGE")
package = ex[3];
endtry
return package;
.

@verb #102:"export_package_to_cache" this none this xd
@program #102:export_package_to_cache
`{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);
packages = this.cached;
`packages[identifier] ! E_RANGE' || (packages[identifier] = []);
packages[identifier][version] = package;
this.cached = packages;
return package;
.

@verb #102:"import_package_from_file" this none this xd
@program #102:import_package_from_file

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

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

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

return package;
.

@verb #102:"export_package_to_file" this none this xd
@program #102:export_package_to_file

`{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 = 0;
try
  fh = file_open(pathname, "w-tn");
  file_writeline(fh, generate_json(package, "embedded-types"));
finally
  fh && file_close(fh);
endtry

return package;
.

@verb #102:"pretty_print_cached_package" this none this xd
@program #102:pretty_print_cached_package
`{identifier, version} = args ! E_ARGS => raise(E_ARGS, "Incorrect number of arguments:  identifier, version")';
package = this.cached[identifier][version];
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 #102:"@install" any with this xd
@program #102:@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]+%)? *$"))
notify(player, "Updating...");
this:fetch_index();
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)
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 (typeof(package) == OBJ)
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
this:install(package);
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, "."));
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 #102:"@uninstall" any with this xd
@program #102:@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];
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
this:delete(package);
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 #102:"@list" any with this xd
@program #102:@list
if (callers() && caller_perms() != player)
raise(E_PERM);
endif
if (!player.wizard)
notify(player, "Only wizards can do that!");
return;
endif
if (dobjstr != "packages")
notify(player, tostr("Correct usage is:  @list packages with $composed"));
return;
endif
notify(player, "Updating...");
this:fetch_index();
cached = this.cached;
archived = this.archived;
notify(player, "Installed packages");
for identifier in (mapkeys(this.provides_cache))
for version in (mapkeys(this.provides_cache[identifier]))
if (version in `mapkeys(cached[identifier]) ! E_RANGE => []' || version in `mapkeys(archived[identifier]) ! E_RANGE => {}')
flags = "   ";
else
flags = " ! ";
endif
notify(player, tostr(flags, identifier, ", ", version, " (", objnum = this.provides_cache[identifier][version][1], ") ", objnum.name));
endfor
endfor
notify(player, "Cached packages [local]");
for identifier in (mapkeys(this.cached))
versions = "";
for version in (mapkeys(this.cached[identifier]))
versions = versions + ", " + version;
endfor
notify(player, tostr("   ", identifier, versions));
endfor
notify(player, msg = tostr("Archived packages [", this.archive_host, "]"));
for identifier in (mapkeys(this.archived))
versions = "";
for version in (mapkeys(this.archived[identifier]))
versions = versions + ", " + version;
endfor
notify(player, tostr("   ", identifier, versions));
endfor
notify(player, "(done)");
.

"***finished***