package Enigmatic::Types;
use DAKKAR::p;
use MooseX::Types -declare =>
[qw(
Letter RotorPos
WiringMap ReflWiringMap PlugWiringMap
PlugboardT
RotorT
ReflectorT
)];
use MooseX::Types::Moose qw(Str Int);
use MooseX::Types::Structured qw(Map);
use Moose::Util::TypeConstraints;
subtype Letter, as Str, where { /[A-Z]/ };
subtype RotorPos, as Int, where { $_ >=0 and $_ <= 25 };
coerce RotorPos, from Letter, via { ord($_) - ord('A') };
subtype WiringMap,
as Map[Letter,Letter],
where {
my $in = $_->keys->sort->join;
my $out = $_->values->sort->join;
$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 \&_coerce_wiring;
coerce ReflWiringMap, from Str, via \&_coerce_wiring;
subtype PlugWiringMap, as ReflWiringMap;
coerce PlugWiringMap,
from Str,
via {
my %map = map { $_, $_ } 'A'..'Z';
my $in = $_; $in =~ s{\s+}{}g;
my @pairs = $in->split(qr{(..)})->grep(sub{length})->flatten;
for my $pair (@pairs) {
my ($from,$to) = ($pair =~ m{(.)(.)});
croak "useless plug $pair"
if $from eq $to;
croak "excessive plug in $from"
if $map{$from} ne $from;
croak "excessive plug in $to"
if $map{$to} ne $to;
$map{$from} = $to;
$map{$to} = $from;
}
return \%map;
};
subtype RotorT, as class_type('Enigmatic::Rotor');
coerce RotorT, from Str, via {
require Enigmatic::RotorBox;
Enigmatic::RotorBox->new->get($_)
};
subtype ReflectorT, as class_type('Enigmatic::Reflector');
coerce ReflectorT, from Str, via {
require Enigmatic::ReflectorBox;
Enigmatic::ReflectorBox->new->get($_)
};
subtype PlugboardT, as class_type('Enigmatic::Plugboard');
coerce PlugboardT, from Str, via {
require Enigmatic::Plugboard;
Enigmatic::Plugboard->new($_);
};
