view release on metacpan or  search on metacpan

lib/App/Phoebe/Ijirait.pm  view on Meta::CPAN

When you visit the URL using your Gemini browser, you're asked for a client
certificate. The common name of the certificate is the name of your character in
the game.

As the server doesn't know whether you're still active or not, it assumes a
10min timout. If you were active in the last 10min, other people in the same
"room". Similarly, if you "say" something, whatever you said hangs on the room
description for up to 10min as long as your character is still in the room.

There is no configuration. Simply add it to your F<config> file:

    use App::Phoebe::Ijirait;

By default, /play/ijirait on all hosts is the same game.

In a virtual host setup, this extension serves all the hosts. Here's how to
serve just one of them:

    package App::Phoebe::Ijirait;
    our $host = "campaignwiki.org";
    use App::Phoebe::Ijirait;

The help file, if you have one, is F<ijirait-help.gmi> in your wiki data
directory. Feel free to get a copy of
L<gemini://transjovian.org/ijiraq/page/Help>.

=cut

package App::Phoebe::Ijirait;
use App::Phoebe qw(@extensions $log $server @request_handlers success result);
use Modern::Perl;
use Archive::Tar;
use Encode qw(encode_utf8 decode_utf8);
use File::Slurper qw(read_binary write_binary read_text);
use Mojo::JSON qw(decode_json encode_json);
use Mojo::Util qw(gzip);
use List::Util qw(first none any);
use URI::Escape;
use utf8;

# See "load world on startup" for the small world generated if no save file is
# available.
my $data;

# By default, /play/ijirait on all hosts is the same game.
our $host = App::Phoebe::host_regex();

# Streamers are people connecting to /stream/ijirait.
my @streamers;

Mojo::IOLoop->next_tick(sub {
  $log->info("Serving Ijirait on $host") });

# global commands
our $commands = {
  help     => \&help,
  look     => \&look,
  type     => \&type,
  save     => \&save,
  backup   => \&backup,
  export   => \&export,
  say      => \&speak, # can't use say!
  who      => \&who,
  go       => \&go,
  examine  => \&examine,
  describe => \&describe,
  name     => \&name,
  create   => \&create,
  delete   => \&delete,
  rooms    => \&rooms,
  connect  => \&connect,
  emote    => \&emote,
  hide     => \&hide,
  reveal   => \&reveal,
  secrets  => \&secrets,
  home     => \&home,
  find     => \&find,
  id       => \&id,
  forget   => \&forget,
};

our $ijrait_commands_without_cert = {
  who      => \&who,
};

# load world on startup
Mojo::IOLoop->next_tick(sub {
  my $dir = $server->{wiki_dir};
  if (-f "$dir/ijirait.json") {
    my $bytes = read_binary("$dir/ijirait.json");
    $data = decode_json $bytes;
  } else {
    init();
  } } );

sub init {
  my $next = 1;
  $data = {
    people => [
      {
	id => $next++, # 1
	name => "Ijiraq",
	description => "A shape-shifter with red eyes.",
	fingerprint => "",
	location => $next, # 2
	seen => [],
	ts => time,
      } ],
    rooms => [
      {
	id => $next++, # 2
	name => "The Tent",
	description => "This is a large tent, illuminated by candles.",
	exits => [
	  {
	    id => $next++, # 3
	    name => "An exit leads outside.",
	    direction => "out",
	    destination => $next,
	  } ],

lib/App/Phoebe/Ijirait.pm  view on Meta::CPAN

    return;
  }
  $log->debug("Unknown target '$name'");
  $stream->write(encode_utf8 "# Unknown target “$name”\n");
  $stream->write("No such person or object is visible.\n");
  $stream->write("=> /play/ijirait Back\n");
}

sub speak {
  my ($stream, $p, $text) = @_;
  if ($text) {
    $text =~ s/^["“„«]//;
    $text =~ s/["”“»]$//;
    $text =~ s/^\s+//;
    $text =~ s/\s+$//;
  }
  if (not $text) {
    result($stream, "10", "You say");
    return;
  }
  my $w = {
    text => $text,
    by => $p->{id},
    ts => time,
  };
  my $room = first { $_->{id} == $p->{location} } @{$data->{rooms}};
  push(@{$room->{words}}, $w);
  notify($p, "$p->{name} says: “$text”");
  look($stream, $p);
}

sub save {
  my ($stream, $p) = @_;
  save_world();
  success($stream);
  $stream->write("# World Save\n");
  $stream->write("Data was saved.\n");
  $stream->write("=> /play/ijirait Back\n");
}

sub save_world {
  cleanup();
  my $bytes = encode_json $data;
  my $dir = $server->{wiki_dir};
  write_binary("$dir/ijirait.json", $bytes);
}

sub cleanup() {
  my $now = time;
  my %people = map { $_->{location} => 1 } @{$data->{people}};
  for my $room (@{$data->{rooms}}) {
    my @words;
    for my $word (@{$room->{words}}) {
      next if $now - $word->{ts} > 600; # don't show messages older than 10min
      push(@words, $word);
    }
    $room->{words} = \@words;
  }
}

sub backup() {
  my $stream = shift;
  my $bytes = encode_json $data;
  $bytes =~ s/"fingerprint":"[^"]+"/"fingerprint":""/g;
  success($stream, "application/json+gzip");
  $stream->write(gzip $bytes);
}

sub who {
  my ($stream) = @_;
  my $now = time;
  success($stream);
  $stream->write("# Who are the shape shifters?\n");
  for my $o (sort { $b->{ts} <=> $a->{ts} } @{$data->{people}}) {
    $o->{name} //= "";
    $stream->write(encode_utf8 "* $o->{name}, active " . timespan($now - $o->{ts}) . "\n");
  }
  $stream->write("=> /play/ijirait Back\n");
}

sub describe {
  my ($stream, $p, $text) = @_;
  if ($text) {
    my ($obj, $description) = split(/\s+/, $text, 2);
    if ($obj eq "me") {
      $log->debug("Describing $p->{name}");
      notify($p, "$p->{name} changes appearance.");
      $p->{description} = $description;
      my $name = uri_escape_utf8 $p->{name};
      result($stream, "30", "/play/ijirait/examine?$name");
      return;
    }
    my $room = first { $_->{id} == $p->{location} } @{$data->{rooms}};
    if ($obj eq "room") {
      $log->debug("Describing $room->{name}");
      notify($p, "$p->{name} changes the room’s description.");
      $room->{description} = $description;
      result($stream, "30", "/play/ijirait/look");
      return;
    }
    my $thing = first { $_->{short} eq $obj } @{$room->{things}};
    if ($thing) {
      $log->debug("Describe $thing->{name}");
      notify($p, "$p->{name} changes the description of $thing->{name}.");
      $thing->{description} = $description;
      my $name = uri_escape_utf8 $thing->{short};
      result($stream, "30", "/play/ijirait/examine?$name");
      return;
    }
    # No description of exits.
  }
  success($stream);
  $log->debug("Describing unknown object");
  $stream->write(encode_utf8 "# I don’t know what to describe\n");
  $stream->write(encode_utf8 "The description needs to start with what to describe, e.g. “describe me A shape-shifter with red eyes.”\n");
  $stream->write(encode_utf8 "You can describe yourself (“me”), the room you are in (“room”), or a thing (using its shortcut). You cannot describe exits.\n");
  $stream->write("=> /play/ijirait Back\n");
}

sub name {
  my ($stream, $p, $text) = @_;