< connected: Amber_Guest. Total: 24 >
@dump #8355 with create
@create $feature named MOO Statistics Feature:MOO Statistics Feature
@prop #8355."domains" {} r
;#8355.("domains") = {{"com", "Commercial", 133}, {"edu", "Educational (USA)",
590}, {"us", "Misc (USA)", 11}, {"au", "Australia", 20}, {"net", "", 13}, {"za", "South Africa", 9}, {"uk", "United Kingdom", 33}, {"at", "Austria", 8}, {"ca", "Canada", 72}, {"org", "Nonprofit organization", 8}, {"bitnet", "Bitnet", 5}, {"il", "Israel", 8}, {"mil", "Military (USA)", 7}, {"no", "Norway", 12}, {"gov", "Government (USA)", 10}, {"se", "Sweden", 4}, {"fi", "Finland", 3}, {"it", "Italy", 3}, {"be", "Belgium", 1}, {"jp", "Japan", 8}, {"de", "Germany", 6}, {"pt", "Portugal", 2}, {"sg", "Singapore", 2}, {"ie", "Ireland", 2}, {"br", "Brazil", 3}, {"nl", "The Netherlands", 2}, {"gr", "Greece", 1}, {"ch", "Switzerland", 1}, {"pl", "Poland", 1}, {"nz", "New Zealand", 1}, {"<none>", "Guests, etc.", 39}}
@prop #8355."domain_update_interval" 86400 r
@prop #8355."domain_last_update" 762630269 r
@prop #8355."domains_alpha" {} r
;#8355.("domains_alpha") = {}
@prop #8355."domains_num" {} r
;#8355.("domains_num") = {}
@prop #8355."bad_domains" {} r
;#8355:set_feature_verbs({"@domains", "@name-domain"})
;#8355.("aliases") = {"MOO Statistics Feature"}
;#8355.("description") = "Provides some statistics about MediaMOO."

@verb #8355:"update_domains" this none this rxd #2
@program #8355:update_domains
"Syntax: update_domains()";
"Updates the current tally of how many users come from each domain.";
player:tell("Domain tally was last updated on ",
ctime(this.domain_last_update));
player:tell("Updating the tally takes a few minutes.");
if (!$command_utils:yes_or_no("Would you like to update it?"))
  player:tell("Tally not updated.");
  return;
endif
player:tell("Updating the domains tally...");
domains = this.domains;
"Clear existing domain count";
for d in [1..length(domains)]
  domains[d][3] = 0;
endfor
this.bad_domains = {};
"The bad domains property stores email addresses without a . in them";
for p in (players())
  $command_utils:suspend_if_needed(0, "... " + tostr(p));
  if (index(p.email_address, "@uk."))
    domain = "uk";
  else
    domain_start = (rindex(p.email_address, ".") + 1);
    if (domain_start > 1)
      domain_end = length(p.email_address);
      domain = p.email_address[domain_start..domain_end];
    elseif (p.email_address == "")
      domain = "<none>";
    else
      this.bad_domains = {@this.bad_domains, p};
      domain = "<bad>";
    endif
  endif
  known = (domain in $list_utils:slice(domains));
  if (known)
    domains[known][3] = (domains[known][3] + 1);
  else
    domains = {@domains, {domain, "", 1}};
  endif
endfor
this.domains = domains;
this.domains_alpha = $list_utils:sort(domains, $list_utils:slice(domains));
this.domains_num = $list_utils:reverse($list_utils:sort(domains, $list_utils:slice(domains, 3)));
this.domain_last_update = time();
"Note: this verb requires wiz perms";
.

@verb #8355:"@domains" any none none rxd
@program #8355:@domains
"Syntax: @domains([alphabetical, number, unsorted])";
"Provides statistics on how many users are from each domain.";
"Defaults to numerical order.";
if ((t = time()) > (this.domain_last_update + this.domain_update_interval))
  this:update_domains();
endif
if (args && (args[1] in {"alphabetical", "alpha"}))
  domains = this.domains_alpha;
elseif (args && (args[1] == "unsorted"))
  domains = this.domains;
else
  domains = this.domains_num;
endif
column2 = 10;
column3 = 40;
player:tell();
player:tell("Total number of domains: ", length(domains));
player:tell("As of ", ctime(this.domain_last_update));
player:tell();
player:tell($string_utils:left("DOMAIN", column2), "NAME",
$string_utils:right("NUMBER OF USERS", column3 - 4));
for domain_number in [1..length(domains)]
  space1 = $string_utils:space(column2 - length(domains[domain_number][1]));
  NUM = $string_utils:right(domains[domain_number][3], column3 -
length(domains[domain_number][2]));
  player:tell(domains[domain_number][1], space1, domains[domain_number][2],
NUM);
endfor
player:tell();
.

@verb #8355:"@name-domain" any as any rxd
@program #8355:@name-domain
"Syntax: @name-domain <domain> as <domain name>";
"Associates a name with a domain code.";
"Domains may only be named by a janitor/wizard or this feature's owner.";
if ((player != this.owner) && (!player.wizard))
  player:tell("Permission denied.");
  player:tell("Please send mail to ", $string_utils:nn(this.owner), " to add a
domain name.");
  return;
endif
domain = dobjstr;
domain_name = iobjstr;
known = (domain in $list_utils:slice(this.domains));
if (known)
  if (this.domains[known][2] == "")
    this.domains[known][2] = domain_name;
    player:tell("Domain ", domain, " is now called ", domain_name, ".");
  else
    if ($command_utils:yes_or_no(((((("Change name of " + domain) + " from ") +
this.domains[known][2]) + " to ") + domain_name) + "?"))
      this.domains[known][2] = domain_name;
      player:tell("Domain ", domain, " is now called ", domain_name, ".");
    else
      player:tell("Domain name unchanged.");
      return;
    endif
  endif
else
  if ($command_utils:yes_or_no("Domain not known.  Add it?"))
    this.domains = {@this.domains, {domain, domain_name, 0}};
    player:tell("Domain added.");
  else
    player:tell("Domain not added.");
    return;
  endif
endif
"This is a lazy way to update the alphabetically and numerically sorted lists";
this.domains_alpha = $list_utils:sort(this.domains, $list_utils:slice(this.domains));
this.domains_num = $list_utils:reverse($list_utils:sort(this.domains, $list_utils:slice(this.domains, 3)));
.