summaryrefslogtreecommitdiff
path: root/lib/Enigmatic
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Enigmatic')
-rw-r--r--lib/Enigmatic/Reflector.pm21
-rw-r--r--lib/Enigmatic/ReflectorBox.pm28
-rw-r--r--lib/Enigmatic/Role/WithWiring.pm17
-rw-r--r--lib/Enigmatic/Rotor.pm12
-rw-r--r--lib/Enigmatic/Types.pm31
5 files changed, 89 insertions, 20 deletions
diff --git a/lib/Enigmatic/Reflector.pm b/lib/Enigmatic/Reflector.pm
new file mode 100644
index 0000000..b9371dd
--- /dev/null
+++ b/lib/Enigmatic/Reflector.pm
@@ -0,0 +1,21 @@
+package Enigmatic::Reflector;
+use DAKKAR::p 'class';
+use Enigmatic::Types qw(ReflWiringMap Letter);
+
+has wiring => (
+ is => 'ro',
+ isa => ReflWiringMap,
+ coerce => 1,
+);
+
+with 'Enigmatic::Role::WithWiring';
+
+sub map {
+ my $self = shift;
+ my ($letter) = pos_validated_list(
+ \@_,
+ { isa => Letter },
+ );
+
+ return $self->wiring->at($letter);
+}
diff --git a/lib/Enigmatic/ReflectorBox.pm b/lib/Enigmatic/ReflectorBox.pm
new file mode 100644
index 0000000..eafa667
--- /dev/null
+++ b/lib/Enigmatic/ReflectorBox.pm
@@ -0,0 +1,28 @@
+package Enigmatic::ReflectorBox;
+use DAKKAR::p 'class';
+use Enigmatic::Reflector;
+use MooseX::Types::Structured qw(Map);
+use MooseX::Types::Moose qw(Str);
+use Moose::Util::TypeConstraints;
+
+has reflectorset => (
+ is => 'ro',
+ isa => Map[Str,class_type('Enigmatic::Reflector')],
+ lazy_build => 1,
+ traits => ['Hash'],
+ handles => {
+ get => 'get',
+ },
+);
+
+sub _build_reflectorset {
+ my %reflectors = (
+ B => 'YRUHQSLDPXNGOKMIEBFZCWVJAT',
+ C => 'FVPJIAOYEDRZXWGCTKUQSBNMHL',
+ 'B_thin' => 'ENKQAUYWJICOPBLMDXZVFTHRGS',
+ 'C_thin' => 'RDOBJNTKVEHMLFCWZAXGYIPSUQ',
+ );
+
+ $_ = Enigmatic::Reflector->new($_) for values %reflectors;
+ return \%reflectors;
+}
diff --git a/lib/Enigmatic/Role/WithWiring.pm b/lib/Enigmatic/Role/WithWiring.pm
new file mode 100644
index 0000000..df6dc48
--- /dev/null
+++ b/lib/Enigmatic/Role/WithWiring.pm
@@ -0,0 +1,17 @@
+package Enigmatic::Role::WithWiring;
+use DAKKAR::p 'role';
+
+requires 'BUILDARGS';
+requires 'wiring';
+
+around BUILDARGS => sub {
+ my $orig = shift;
+ my $class = shift;
+
+ if ( @_ == 1 && !ref $_[0] ) {
+ return $class->$orig( wiring => $_[0] );
+ }
+ else {
+ return $class->$orig(@_);
+ }
+};
diff --git a/lib/Enigmatic/Rotor.pm b/lib/Enigmatic/Rotor.pm
index a600b43..792c7b5 100644
--- a/lib/Enigmatic/Rotor.pm
+++ b/lib/Enigmatic/Rotor.pm
@@ -14,17 +14,7 @@ has ring_setting => (
default => 0,
);
-around BUILDARGS => sub {
- my $orig = shift;
- my $class = shift;
-
- if ( @_ == 1 && !ref $_[0] ) {
- return $class->$orig( wiring => $_[0] );
- }
- else {
- return $class->$orig(@_);
- }
-};
+with 'Enigmatic::Role::WithWiring';
sub map {
my $self = shift;
diff --git a/lib/Enigmatic/Types.pm b/lib/Enigmatic/Types.pm
index 12cb414..ed0be32 100644
--- a/lib/Enigmatic/Types.pm
+++ b/lib/Enigmatic/Types.pm
@@ -1,6 +1,6 @@
package Enigmatic::Types;
use DAKKAR::p;
-use MooseX::Types -declare => [qw(Letter WiringMap RotorPos)];
+use MooseX::Types -declare => [qw(Letter WiringMap ReflWiringMap RotorPos)];
use MooseX::Types::Moose qw(Str Int);
use MooseX::Types::Structured qw(Map);
@@ -16,16 +16,29 @@ subtype WiringMap,
$in eq $out and $in eq ['A'..'Z']->join;
};
+subtype ReflWiringMap,
+ as WiringMap,
+ where {
+ my %reverse; @reverse{values %$_} = keys %$_;
+ (join '',@reverse{keys %$_}) eq $_->values->join;
+ };
+
+sub _coerce_wiring {
+ my @out = $_[0]->uc->split(qr//)->flatten;
+ croak "invalid wiring string <$_>"
+ unless @out == 26;
+ my %ret;
+ @ret{'A'..'Z'}=@out;
+ \%ret;
+}
+
coerce WiringMap,
from Str,
- via {
- my @out = $_->uc->split(qr//)->flatten;
- croak "invalid wiring string <$_>"
- unless @out == 26;
- my %ret;
- @ret{'A'..'Z'}=@out;
- \%ret;
- };
+ via \&_coerce_wiring;
+
+coerce ReflWiringMap,
+ from Str,
+ via \&_coerce_wiring;
subtype RotorPos,
as Int,