summaryrefslogtreecommitdiffstats
path: root/lib/Bot/Games
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Bot/Games')
-rw-r--r--lib/Bot/Games/Game.pm49
-rw-r--r--lib/Bot/Games/Game/24.pm6
-rw-r--r--lib/Bot/Games/Game/Chess.pm8
-rw-r--r--lib/Bot/Games/Game/Ghost.pm6
-rw-r--r--lib/Bot/Games/Game/Role/CurrentPlayer.pm4
-rw-r--r--lib/Bot/Games/Game/Spook.pm4
-rw-r--r--lib/Bot/Games/Game/Superghost.pm4
-rw-r--r--lib/Bot/Games/Game/Xghost.pm4
-rw-r--r--lib/Bot/Games/OO.pm18
-rw-r--r--lib/Bot/Games/OO/Game.pm65
-rw-r--r--lib/Bot/Games/OO/Game/Role.pm28
-rw-r--r--lib/Bot/Games/OO/Role.pm4
-rw-r--r--lib/Bot/Games/Trait/Attribute/Command.pm62
-rw-r--r--lib/Bot/Games/Trait/Attribute/Formatted.pm58
-rw-r--r--lib/Bot/Games/Trait/Class/Command.pm33
-rw-r--r--lib/Bot/Games/Trait/Class/Formatted.pm26
-rw-r--r--lib/Bot/Games/Trait/Method/Command.pm24
-rw-r--r--lib/Bot/Games/Trait/Method/Formatted.pm22
18 files changed, 31 insertions, 394 deletions
diff --git a/lib/Bot/Games/Game.pm b/lib/Bot/Games/Game.pm
index d57461d..a9d0862 100644
--- a/lib/Bot/Games/Game.pm
+++ b/lib/Bot/Games/Game.pm
@@ -1,18 +1,10 @@
package Bot::Games::Game;
-use Bot::Games::OO::Game;
+use Bot::Games::OO;
use DateTime;
use Time::Duration;
-has help => (
- is => 'ro',
- isa => 'Str',
- default => 'This game doesn\'t have any help text!',
- command => 1,
- needs_init => 0,
-);
-
has players => (
- traits => ['Collection::Array'],
+ traits => ['MooseX::AttributeHelpers::Trait::Collection::Array'],
is => 'ro',
isa => 'ArrayRef[Str]',
auto_deref => 1,
@@ -55,19 +47,12 @@ has last_turn_time => (
},
);
-has is_active => (
- is => 'rw',
- isa => 'Bool',
- command => 1,
- needs_init => 0,
-);
-
-sub turn {
- my $turn = inner();
- return $turn if defined($turn);
- return "Games must provide a turn method";
+sub default {
+ my $self = shift;
+ return "Games must provide a turn method" unless $self->can('turn');
+ $self->turn(@_);
}
-after turn => sub { shift->last_turn_time(DateTime->now) };
+after default => sub { shift->last_turn_time(DateTime->now) };
sub allow_new_player { 1 }
around add_player => sub {
@@ -80,25 +65,9 @@ around add_player => sub {
return;
};
-command cmdlist => sub {
- my $self = shift;
- my @commands;
- for my $method ($self->meta->get_all_methods) {
- push @commands, $method->name
- if $method->meta->can('does_role')
- && $method->meta->does_role('Bot::Games::Trait::Method::Command');
- }
- return \@commands;
-}, needs_init => 0,
- formatter => sub {
- my $list = shift;
- return join ' ', sort map { '-' . $_ } @$list
- };
-
sub _diff_from_now { ago(time - shift->epoch, 3) }
-# this happens in Bot::Games, since we want to add the say method from there
-#__PACKAGE__->meta->make_immutable;
-no Bot::Games::OO::Game;
+__PACKAGE__->meta->make_immutable;
+no Bot::Games::OO;
1;
diff --git a/lib/Bot/Games/Game/24.pm b/lib/Bot/Games/Game/24.pm
index a353900..dd072c4 100644
--- a/lib/Bot/Games/Game/24.pm
+++ b/lib/Bot/Games/Game/24.pm
@@ -1,5 +1,5 @@
package Bot::Games::Game::24;
-use Bot::Games::OO::Game;
+use Bot::Games::OO;
extends 'Bot::Games::Game';
use List::Util qw/shuffle/;
@@ -28,7 +28,7 @@ sub init {
return $self->generate_24;
}
-augment turn => sub {
+sub turn {
my $self = shift;
my ($player, $expr) = @_;
$self->add_player($player) unless $self->has_player($player);
@@ -101,6 +101,6 @@ sub evaluate {
}
__PACKAGE__->meta->make_immutable;
-no Bot::Games::OO::Game;
+no Bot::Games::OO;
1;
diff --git a/lib/Bot/Games/Game/Chess.pm b/lib/Bot/Games/Game/Chess.pm
index 554fe9e..c3eb14f 100644
--- a/lib/Bot/Games/Game/Chess.pm
+++ b/lib/Bot/Games/Game/Chess.pm
@@ -1,5 +1,5 @@
package Bot::Games::Game::Chess;
-use Bot::Games::OO::Game;
+use Bot::Games::OO;
extends 'Bot::Games::Game';
with 'Bot::Games::Game::Role::CurrentPlayer';
@@ -17,7 +17,7 @@ has game => (
);
has turn_count => (
- traits => ['Counter'],
+ traits => ['MooseX::AttributeHelpers::Trait::Counter'],
is => 'ro',
isa => 'Int',
default => 1,
@@ -26,7 +26,7 @@ has turn_count => (
}
);
-augment turn => sub {
+sub turn {
my $self = shift;
my ($player, $move) = @_;
$self->maybe_add_player($player);
@@ -91,6 +91,6 @@ sub format_turn {
}
__PACKAGE__->meta->make_immutable;
-no Bot::Games::OO::Game;
+no Bot::Games::OO;
1;
diff --git a/lib/Bot/Games/Game/Ghost.pm b/lib/Bot/Games/Game/Ghost.pm
index 6f8ad83..97dbbb9 100644
--- a/lib/Bot/Games/Game/Ghost.pm
+++ b/lib/Bot/Games/Game/Ghost.pm
@@ -1,5 +1,5 @@
package Bot::Games::Game::Ghost;
-use Bot::Games::OO::Game;
+use Bot::Games::OO;
use Games::Word::Wordlist;
extends 'Bot::Games::Game';
with 'Bot::Games::Game::Role::CurrentPlayer';
@@ -41,7 +41,7 @@ around state => sub {
return $self->$orig($state);
};
-augment turn => sub {
+sub turn {
my $self = shift;
my ($player, $state) = @_;
$self->maybe_add_player($player);
@@ -126,6 +126,6 @@ around maybe_add_player => sub {
};
__PACKAGE__->meta->make_immutable;
-no Bot::Games::OO::Game;
+no Bot::Games::OO;
1;
diff --git a/lib/Bot/Games/Game/Role/CurrentPlayer.pm b/lib/Bot/Games/Game/Role/CurrentPlayer.pm
index 2dbe524..1479ef8 100644
--- a/lib/Bot/Games/Game/Role/CurrentPlayer.pm
+++ b/lib/Bot/Games/Game/Role/CurrentPlayer.pm
@@ -1,5 +1,5 @@
package Bot::Games::Game::Role::CurrentPlayer;
-use Bot::Games::OO::Game::Role;
+use Bot::Games::OO::Role;
requires 'players', 'num_players', 'add_player';
@@ -40,6 +40,6 @@ sub maybe_add_player {
}
}
-no Bot::Games::OO::Game::Role;
+no Bot::Games::OO::Role;
1;
diff --git a/lib/Bot/Games/Game/Spook.pm b/lib/Bot/Games/Game/Spook.pm
index cfb577f..7cecca0 100644
--- a/lib/Bot/Games/Game/Spook.pm
+++ b/lib/Bot/Games/Game/Spook.pm
@@ -1,5 +1,5 @@
package Bot::Games::Game::Spook;
-use Bot::Games::OO::Game;
+use Bot::Games::OO;
use Games::Word qw/is_subpermutation/;
extends 'Bot::Games::Game::Ghost';
@@ -23,6 +23,6 @@ command valid_word_from_state => sub {
}, formatter => 'Bool';
__PACKAGE__->meta->make_immutable;
-no Bot::Games::OO::Game;
+no Bot::Games::OO;
1;
diff --git a/lib/Bot/Games/Game/Superghost.pm b/lib/Bot/Games/Game/Superghost.pm
index f286425..3cc593e 100644
--- a/lib/Bot/Games/Game/Superghost.pm
+++ b/lib/Bot/Games/Game/Superghost.pm
@@ -1,5 +1,5 @@
package Bot::Games::Game::Superghost;
-use Bot::Games::OO::Game;
+use Bot::Games::OO;
extends 'Bot::Games::Game::Ghost';
has '+help' => (
@@ -21,6 +21,6 @@ command valid_word_from_state => sub {
}, formatter => 'Bool';
__PACKAGE__->meta->make_immutable;
-no Bot::Games::OO::Game;
+no Bot::Games::OO;
1;
diff --git a/lib/Bot/Games/Game/Xghost.pm b/lib/Bot/Games/Game/Xghost.pm
index 6973ab4..799d7ce 100644
--- a/lib/Bot/Games/Game/Xghost.pm
+++ b/lib/Bot/Games/Game/Xghost.pm
@@ -1,5 +1,5 @@
package Bot::Games::Game::Xghost;
-use Bot::Games::OO::Game;
+use Bot::Games::OO;
use Games::Word qw/is_substring/;
extends 'Bot::Games::Game::Ghost';
@@ -21,6 +21,6 @@ command valid_word_from_state => sub {
}, formatter => 'Bool';
__PACKAGE__->meta->make_immutable;
-no Bot::Games::OO::Game;
+no Bot::Games::OO;
1;
diff --git a/lib/Bot/Games/OO.pm b/lib/Bot/Games/OO.pm
index 177af74..119718d 100644
--- a/lib/Bot/Games/OO.pm
+++ b/lib/Bot/Games/OO.pm
@@ -1,24 +1,10 @@
package Bot::Games::OO;
-use Moose ();
+use IM::Engine::Plugin::Commands::OO ();
use MooseX::AttributeHelpers;
use Moose::Exporter;
-use Moose::Util::MetaRole;
Moose::Exporter->setup_import_methods(
- also => ['Moose'],
+ also => ['IM::Engine::Plugin::Commands::OO'],
);
-sub init_meta {
- shift;
- my %options = @_;
- Moose->init_meta(%options);
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class => $options{for_class},
- metaclass_roles => ['MooseX::NonMoose::Meta::Role::Class'],
- constructor_metaclass_roles =>
- ['MooseX::NonMoose::Meta::Role::Constructor'],
- );
- return $options{for_class}->meta;
-}
-
1;
diff --git a/lib/Bot/Games/OO/Game.pm b/lib/Bot/Games/OO/Game.pm
deleted file mode 100644
index 5820b80..0000000
--- a/lib/Bot/Games/OO/Game.pm
+++ /dev/null
@@ -1,65 +0,0 @@
-package Bot::Games::OO::Game;
-use Bot::Games::OO ();
-
-sub command {
- my $caller = shift;
- my $name = shift;
- my $code;
- $code = shift if ref($_[0]) eq 'CODE';
- my %args = @_;
-
- my $method_meta = $caller->meta->get_method($name);
- my $superclass = Moose::blessed($method_meta)
- || $caller->meta->method_metaclass;
- my @method_metaclass_roles = ('Bot::Games::Trait::Method::Command');
- push @method_metaclass_roles, 'Bot::Games::Trait::Method::Formatted'
- if $args{formatter};
- my $method_metaclass = Moose::Meta::Class->create_anon_class(
- superclasses => [$superclass],
- roles => \@method_metaclass_roles,
- cache => 1,
- );
- if ($method_meta) {
- $method_metaclass->rebless_instance($method_meta);
- }
- else {
- $method_meta = $method_metaclass->name->wrap(
- $code,
- package_name => $caller,
- name => $name,
- );
- $caller->meta->add_method($name, $method_meta);
- }
- for my $attr (map { $_->meta->get_attribute_list } @method_metaclass_roles) {
- next unless exists $args{$attr};
- my $value = $args{$attr};
- my $munge_method = "_munge_$attr";
- $value = $method_meta->$munge_method($value)
- if $method_meta->can($munge_method);
- $method_meta->$attr($value);
- }
-}
-
-Moose::Exporter->setup_import_methods(
- with_caller => ['command'],
- also => ['Bot::Games::OO'],
-);
-
-sub init_meta {
- shift;
- my %options = @_;
- Moose->init_meta(%options);
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class =>
- $options{for_class},
- attribute_metaclass_roles =>
- ['Bot::Games::Trait::Attribute::Command',
- 'Bot::Games::Trait::Attribute::Formatted'],
- metaclass_roles =>
- ['Bot::Games::Trait::Class::Command',
- 'Bot::Games::Trait::Class::Formatted'],
- );
- return $options{for_class}->meta;
-}
-
-1;
diff --git a/lib/Bot/Games/OO/Game/Role.pm b/lib/Bot/Games/OO/Game/Role.pm
deleted file mode 100644
index 8aee3a4..0000000
--- a/lib/Bot/Games/OO/Game/Role.pm
+++ /dev/null
@@ -1,28 +0,0 @@
-package Bot::Games::OO::Game::Role;
-use Bot::Games::OO::Role ();
-
-# XXX: is there a better way to go about this?
-*command = \&Bot::Games::OO::Game::command;
-Moose::Exporter->setup_import_methods(
- with_caller => ['command'],
- also => ['Bot::Games::OO::Role'],
-);
-
-sub init_meta {
- shift;
- my %options = @_;
- Moose::Role->init_meta(%options);
- Moose::Util::MetaRole::apply_metaclass_roles(
- for_class =>
- $options{for_class},
- attribute_metaclass_roles =>
- ['Bot::Games::Trait::Attribute::Command',
- 'Bot::Games::Trait::Attribute::Formatted'],
- metaclass_roles =>
- ['Bot::Games::Trait::Class::Command',
- 'Bot::Games::Trait::Class::Formatted'],
- );
- return $options{for_class}->meta;
-}
-
-1;
diff --git a/lib/Bot/Games/OO/Role.pm b/lib/Bot/Games/OO/Role.pm
index 80810f2..43bcf4f 100644
--- a/lib/Bot/Games/OO/Role.pm
+++ b/lib/Bot/Games/OO/Role.pm
@@ -1,10 +1,10 @@
package Bot::Games::OO::Role;
-use Moose ();
+use IM::Engine::Plugin::Commands::OO::Role ();
use MooseX::AttributeHelpers;
use Moose::Exporter;
Moose::Exporter->setup_import_methods(
- also => ['Moose::Role'],
+ also => ['IM::Engine::Plugin::Commands::OO::Role'],
);
1;
diff --git a/lib/Bot/Games/Trait/Attribute/Command.pm b/lib/Bot/Games/Trait/Attribute/Command.pm
deleted file mode 100644
index acc306e..0000000
--- a/lib/Bot/Games/Trait/Attribute/Command.pm
+++ /dev/null
@@ -1,62 +0,0 @@
-package Bot::Games::Trait::Attribute::Command;
-use Bot::Games::OO::Role;
-
-has command => (
- is => 'rw',
- isa => 'Bool',
- default => 0,
-);
-
-has needs_init => (
- is => 'rw',
- isa => 'Bool',
- default => 1,
-);
-
-has _use_accessor_metatrait => (
- is => 'rw',
- isa => 'Bool',
- default => 0,
-);
-
-before _process_options => sub {
- my $self = shift;
- my ($name, $options) = @_;
- warn "needs_init is useless for attributes without command"
- if exists($options->{needs_init}) && !$options->{command};
-};
-
-around accessor_metaclass => sub {
- my $orig = shift;
- my $self = shift;
- my $metaclass = $self->$orig(@_);
- return $metaclass unless $self->command && $self->_use_accessor_metatrait;
- return Moose::Meta::Class->create_anon_class(
- superclasses => [$metaclass],
- roles => ['Bot::Games::Trait::Method::Command'],
- cache => 1,
- )->name;
-};
-
-after install_accessors => sub {
- my $self = shift;
- return unless $self->command;
- my $method_meta = $self->get_read_method_ref;
- $method_meta->pass_args(0);
- $method_meta->needs_init($self->needs_init);
-};
-
-around _process_accessors => sub {
- my $orig = shift;
- my $self = shift;
- my ($type) = @_;
- $self->_use_accessor_metatrait(1) if $type eq 'accessor'
- || $type eq 'reader';
- my @ret = $self->$orig(@_);
- $self->_use_accessor_metatrait(0);
- return @ret;
-};
-
-no Bot::Games::OO::Role;
-
-1;
diff --git a/lib/Bot/Games/Trait/Attribute/Formatted.pm b/lib/Bot/Games/Trait/Attribute/Formatted.pm
deleted file mode 100644
index 00db707..0000000
--- a/lib/Bot/Games/Trait/Attribute/Formatted.pm
+++ /dev/null
@@ -1,58 +0,0 @@
-package Bot::Games::Trait::Attribute::Formatted;
-use Bot::Games::OO::Role;
-
-# when the attribute is being constructed, the accessor methods haven't been
-# generated yet, so we need to store the formatter here, and then apply it
-# after the accessor methods exist
-has formatter => (
- is => 'rw',
- isa => 'CodeRef',
- predicate => 'has_formatter',
-);
-
-before _process_options => sub {
- my $self = shift;
- my ($name, $options) = @_;
- warn "only commands will have a formatter applied"
- if exists($options->{formatter}) && !$options->{command};
-};
-
-after attach_to_class => sub {
- my $self = shift;
- my ($meta) = @_;
- return if $self->has_formatter;
- return unless $self->command;
- return unless $self->has_type_constraint;
- my $tc = $self->type_constraint;
- for my $tc_name ($meta->formattable_tcs) {
- if ($tc->is_a_type_of($tc_name)) {
- $self->formatter($meta->formatter_for($tc_name));
- return;
- }
- }
-};
-
-around accessor_metaclass => sub {
- my $orig = shift;
- my $self = shift;
- my $metaclass = $self->$orig(@_);
- return $metaclass unless $self->has_formatter;
- return Moose::Meta::Class->create_anon_class(
- superclasses => [$metaclass],
- roles => ['Bot::Games::Trait::Method::Formatted'],
- cache => 1,
- )->name;
-};
-
-after install_accessors => sub {
- my $self = shift;
- if ($self->has_formatter) {
- my $formatter = $self->formatter;
- my $method_meta = $self->get_read_method_ref;
- $method_meta->formatter($formatter);
- }
-};
-
-no Bot::Games::OO::Role;
-
-1;
diff --git a/lib/Bot/Games/Trait/Class/Command.pm b/lib/Bot/Games/Trait/Class/Command.pm
deleted file mode 100644
index 8e70200..0000000
--- a/lib/Bot/Games/Trait/Class/Command.pm
+++ /dev/null
@@ -1,33 +0,0 @@
-package Bot::Games::Trait::Class::Command;
-use Bot::Games::OO::Role;
-
-after ((map { "add_${_}_method_modifier" } qw/before after around/) => sub {
- my $self = shift;
- my $name = shift;
-
- my $method_meta = $self->get_method($name);
- my $orig_method_meta = $method_meta->get_original_method;
- return unless $orig_method_meta->meta->can('does_role')
- && $orig_method_meta->meta->does_role('Bot::Games::Trait::Method::Command');
- my $pass_args = $orig_method_meta->pass_args;
- my $method_metaclass = Moose::Meta::Class->create_anon_class(
- superclasses => [blessed $method_meta],
- roles => ['Bot::Games::Trait::Method::Command'],
- cache => 1,
- );
- $method_metaclass->rebless_instance($method_meta, pass_args => $pass_args);
-});
-
-sub get_command {
- my $self = shift;
- my ($action) = @_;
- my $method_meta = $self->find_method_by_name($action);
- return $method_meta
- if blessed($method_meta)
- && $method_meta->meta->can('does_role')
- && $method_meta->meta->does_role('Bot::Games::Trait::Method::Command');
-}
-
-no Bot::Games::OO::Role;
-
-1;
diff --git a/lib/Bot/Games/Trait/Class/Formatted.pm b/lib/Bot/Games/Trait/Class/Formatted.pm
deleted file mode 100644
index 6c3092a..0000000
--- a/lib/Bot/Games/Trait/Class/Formatted.pm
+++ /dev/null
@@ -1,26 +0,0 @@
-package Bot::Games::Trait::Class::Formatted;
-use Bot::Games::OO::Role;
-
-has default_formatters => (
- metaclass => 'Collection::ImmutableHash',
- is => 'ro',
- isa => 'HashRef[CodeRef]',
- builder => '_build_default_formatters',
- provides => {
- get => 'formatter_for',
- exists => 'has_formatter',
- keys => 'formattable_tcs',
- },
-);
-
-sub _build_default_formatters {
- {
- 'ArrayRef' => sub { join ', ', @{ shift() } },
- 'Bool' => sub { return shift() ? 'true' : 'false' },
- 'Object' => sub { shift() . "" },
- }
-}
-
-no Bot::Games::OO::Role;
-
-1;
diff --git a/lib/Bot/Games/Trait/Method/Command.pm b/lib/Bot/Games/Trait/Method/Command.pm
deleted file mode 100644
index 25bd2ff..0000000
--- a/lib/Bot/Games/Trait/Method/Command.pm
+++ /dev/null
@@ -1,24 +0,0 @@
-package Bot::Games::Trait::Method::Command;
-use Bot::Games::OO::Role;
-
-has pass_args => (
- is => 'rw',
- isa => 'Bool',
- default => 1,
-);
-
-has needs_init => (
- is => 'rw',
- isa => 'Bool',
- default => 1,
-);
-
-around execute => sub {
- my $orig = shift;
- my $self = shift;
- return $self->pass_args ? $self->$orig(@_) : $self->$orig($_[0]);
-};
-
-no Bot::Games::OO::Role;
-
-1;
diff --git a/lib/Bot/Games/Trait/Method/Formatted.pm b/lib/Bot/Games/Trait/Method/Formatted.pm
deleted file mode 100644
index cdd4c60..0000000
--- a/lib/Bot/Games/Trait/Method/Formatted.pm
+++ /dev/null
@@ -1,22 +0,0 @@
-package Bot::Games::Trait::Method::Formatted;
-use Bot::Games::OO::Role;
-
-has formatter => (
- is => 'rw',
- isa => 'CodeRef',
- default => sub { sub {
- warn "no formatter specified!";
- return @_;
- } },
-);
-
-sub _munge_formatter {
- my $self = shift;
- my ($format) = @_;
- return $format if ref($format) eq 'CODE';
- return $self->associated_metaclass->formatter_for($format);
-}
-
-no Bot::Games::OO::Role;
-
-1;
generated by cgit v1.2.3-54-g00ecf (git 2.45.0) at 2024-05-18 16:27:14 +0000