view release on metacpan or  search on metacpan

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

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,
	  } ],
	things => [],
	words => [

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

sub export_archive {
  my $stream = shift;
  success($stream, "application/gzip");
  my $tar = Archive::Tar->new;
  my $bytes = "# Rooms\n";
  $bytes .= encode_utf8 "=> rooms/$_->{id}.gmi $_->{name}\n" for @{$data->{rooms}};
  $tar->add_data("ijirait/index.gmi", $bytes);
  for my $room (@{$data->{rooms}}) {
    $bytes = encode_utf8 "# " . $room->{name} . "\n";
    $bytes .= encode_utf8 $room->{description} . "\n" if $room->{description};
    my @things = @{$room->{things}};
    $bytes .= "## Things\n" if @things > 0;
    for my $thing (@things) {
      my $name = uri_escape_utf8 $thing->{short};
      $bytes .= encode_utf8 "=> ../things/$room->{id}/$name.gmi $thing->{name}\n";
      my $bytes2 = encode_utf8 "# $thing->{name}\n";
      $bytes2 .= encode_utf8 "$thing->{description}\n";
      $bytes2 .= "=> ../../rooms/$room->{id}.gmi Back\n";
      $tar->add_data("ijirait/things/$room->{id}/$name.gmi", $bytes2);
    }
    my @exits = @{$room->{exits}};
    $bytes .= "## Exits\n" if @exits > 0;
    for my $exit (@exits) {
      my $direction = uri_escape_utf8 $exit->{direction};
      my $destination = first { $_->{id} == $exit->{destination} } @{$data->{rooms}};
      $bytes .= encode_utf8 "=> $destination->{id}.gmi $exit->{name}\n";
    }
    # We also print rooms without people! We also print inactive people.
    my @people = grep { $_->{location} == $room->{id} } @{$data->{people}};
    $bytes .= "## People\n" if @people > 0;
    for my $o (@people) {
      $bytes .= encode_utf8 "=> ../people/$o->{id}.gmi $o->{name}\n";
      my $bytes2 = encode_utf8 "# $o->{name}\n";
      $bytes2 .= encode_utf8 "$o->{description}\n";
      $bytes2 .= encode_utf8 "=> ../rooms/$room->{id}.gmi $room->{name}\n";
      $tar->add_data("ijirait/people/$o->{id}.gmi", $bytes2);
    }
    $tar->add_data("ijirait/rooms/$room->{id}.gmi", $bytes);
  }
  my $io;
  open(my $fh, ">", \$io) or $log->error("Error preparing string for tarball: $!");
  $tar->write($fh) or $log->error("Error writing tarball: " . $tar->error);
  close($fh);
  $stream->write(gzip $io);
}

sub timespan {
  my $seconds = shift;
  return "some time ago" if not defined $seconds;
  return "just now" if $seconds == 0;
  return sprintf("%d days ago", int($seconds/86400)) if abs($seconds) > 172800; # 2d
  return sprintf("%d hours ago", int($seconds/3600)) if abs($seconds) > 7200; # 2h
  return sprintf("%d minutes ago", int($seconds/60)) if abs($seconds) > 120; # 2min
  return sprintf("%d seconds ago", $seconds);
}

sub menu {
  my $stream = shift;
  $stream->write("## Commands\n");
  $stream->write("=> /play/ijirait/look look\n");
  $stream->write("=> /play/ijirait/say say\n");
  $stream->write("=> /play/ijirait/emote emote\n");
  $stream->write("=> /play/ijirait/help help\n");
  $stream->write("=> /play/ijirait/type type\n");
}

sub help {
  my ($stream, $p) = @_;
  success($stream);
  $stream->write("## Help\n");
  my $dir = $server->{wiki_dir};
  my $file = "$dir/ijirait-help.gmi";
  if (-f $file) {
    $stream->write(encode_utf8 read_text($file));
  } else {
    $stream->write("The help file does not exist.\n");
  }
  $stream->write("## Automatically Generated Command List\n");
  for my $command (sort keys %$commands) {
    $stream->write("* $command\n");
  }
  $stream->write("=> /play/ijirait Back\n");
}

sub type {
  my ($stream, $p, $str) = @_;
  if (!$str) {
    result($stream, "10", "Type your command");
    return;
  }
  # mark activity
  my $room = first { $_->{id} == $p->{location} } @{$data->{rooms}};
  $p->{ts} = $room->{ts} = time;
  # parse commands
  my ($command, $arg) = split(/\s+/, $str, 2);
  $arg =~ s/\s+$// if defined $arg; # trim
  my $routine = $commands->{$command};
  if ($routine) {
    $log->debug("Running $command");
    $routine->($stream, $p, $arg);
    return;
  }
  # using exits instead of go
  if (first { $_->{direction} eq $str } @{$room->{exits}}) {
    go($stream, $p, $str);
    return;
  }
  # using the name of a person or thing instead of examine
  if (first { $_->{location} eq $p->{location} and $_->{name} eq $str } @{$data->{people}}
      or first { $_->{short} eq $str } @{$room->{things}}) {
    examine($stream, $p, $str);
    return;
  }
  $log->debug("Unknown command '$command'");
  success($stream);
  $stream->write("# Unknown command\n");
  $stream->write(encode_utf8 "“$command” is an unknown command.\n");
  menu($stream);
}

sub home {