diff options
Diffstat (limited to 'lib/Enigmatic')
-rw-r--r-- | lib/Enigmatic/Machine.pm | 89 | ||||
-rw-r--r-- | lib/Enigmatic/ReflectorBox.pm | 3 | ||||
-rw-r--r-- | lib/Enigmatic/RotorBox.pm | 5 |
3 files changed, 94 insertions, 3 deletions
diff --git a/lib/Enigmatic/Machine.pm b/lib/Enigmatic/Machine.pm new file mode 100644 index 0000000..f5d5081 --- /dev/null +++ b/lib/Enigmatic/Machine.pm @@ -0,0 +1,89 @@ +package Enigmatic::Machine; +use DAKKAR::p 'class'; +use Enigmatic::RotorBox; +use Enigmatic::ReflectorBox; +use Enigmatic::Plugboard; +use Enigmatic::CryptTrain; +use Enigmatic::Types qw(Letter RotorT ReflectorT PlugboardT); +use MooseX::Types::Moose qw(ArrayRef Str); + +has train => ( + isa => 'Enigmatic::CryptTrain', + is => 'ro', +); + +has plugboard => ( + isa => PlugboardT, + is => 'ro', + default => sub { Enigmatic::Plugboard->new }, + coerce => 1, +); + +around BUILDARGS => sub { + my $orig = shift; + my $class = shift; + + my $args = $class->$orig(@_); + + croak "no rotors specified" unless $args->{rotors}; + croak "no reflector specified" unless $args->{reflector}; + + my $rotors = $args->{rotors}->map(\&to_RotorT); + my $reflector = to_ReflectorT($args->{reflector}); + + if ($args->{ring_settings}) { + $args->{ring_settings}->each( + sub { + my ($idx,$setting) = @_; + $rotors->[$idx]->ring_setting($setting); + }); + } + + $args->{train} = Enigmatic::CryptTrain->new({ + rotors => $rotors, + reflector => $reflector, + ( $args->{rotor_positions} ? ( positions => $args->{rotor_positions} ) : () ), + }); + + return $args; +}; + +sub map { + my $self = shift; + my ($letter) = pos_validated_list( + \@_, + { isa => Letter }, + ); + +warn "mapping $letter\n"; +warn " initial positions: @{[ $self->train->positions ]}\n"; + + $letter = $self->plugboard->map($letter); + +warn " after plugboard: $letter\n"; + + $letter = $self->train->map($letter); + +warn " after rotors: $letter\n"; + + $letter = $self->plugboard->map($letter); + +warn " after plugboard: $letter\n"; + +warn " new positions: @{[ $self->train->positions ]}\n"; + + return $letter; +} + +sub map_string { + my ($self,$string) = @_; + + my @letters = $string->split(qr//)->grep(\&is_Letter)->flatten; + + my @res; + for my $letter (@letters) { + push @res, $self->map($letter); + } + + return wantarray ? @res : @res->join; +} diff --git a/lib/Enigmatic/ReflectorBox.pm b/lib/Enigmatic/ReflectorBox.pm index eafa667..e0558cf 100644 --- a/lib/Enigmatic/ReflectorBox.pm +++ b/lib/Enigmatic/ReflectorBox.pm @@ -1,13 +1,14 @@ package Enigmatic::ReflectorBox; use DAKKAR::p 'class'; use Enigmatic::Reflector; +use Enigmatic::Types 'ReflectorT'; 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')], + isa => Map[Str,ReflectorT], lazy_build => 1, traits => ['Hash'], handles => { diff --git a/lib/Enigmatic/RotorBox.pm b/lib/Enigmatic/RotorBox.pm index 57f0a47..caf7ed1 100644 --- a/lib/Enigmatic/RotorBox.pm +++ b/lib/Enigmatic/RotorBox.pm @@ -1,13 +1,14 @@ package Enigmatic::RotorBox; use DAKKAR::p 'class'; use Enigmatic::Rotor; +use Enigmatic::Types 'RotorT'; use MooseX::Types::Structured qw(Map); use MooseX::Types::Moose qw(Str); use Moose::Util::TypeConstraints; has rotorset => ( is => 'ro', - isa => Map[Str,class_type('Enigmatic::Rotor')], + isa => Map[Str,RotorT], lazy_build => 1, traits => ['Hash'], handles => { @@ -26,7 +27,7 @@ sub _build_rotorset { VII => { wiring => 'NZJHGRCXMYSWBOUFAIVLPEKQDT', notches => ['M','Z'] }, VIII => { wiring => 'FKQHTLXOCBJSPDZRAMEWNIUYGV', notches => ['M','Z'] }, Beta => { wiring => 'LEYJVCNIXWPBQMDRTAKZGFUHOS', notches => [] }, - Gamma => { wiring => 'FSOKANUERHMBTIYCWLQPZXVGJD', notches => [''] }, + Gamma => { wiring => 'FSOKANUERHMBTIYCWLQPZXVGJD', notches => [] }, ); $_ = Enigmatic::Rotor->new($_) for values %rotors; |