From 1776bd778db4f6ed72eed47602877ab7a8fb904f Mon Sep 17 00:00:00 2001 From: dakkar Date: Mon, 29 Aug 2011 13:54:58 +0100 Subject: reflectors, in box, and some refactor --- lib/Enigmatic/Reflector.pm | 21 ++++++++++++ lib/Enigmatic/ReflectorBox.pm | 28 ++++++++++++++++ lib/Enigmatic/Role/WithWiring.pm | 17 ++++++++++ lib/Enigmatic/Rotor.pm | 12 +------ lib/Enigmatic/Types.pm | 31 +++++++++++++----- t/lib/Test/Enigmatic.pm | 15 +++++++++ t/reflectors.t | 71 ++++++++++++++++++++++++++++++++++++++++ t/rotors.t | 26 ++++----------- 8 files changed, 182 insertions(+), 39 deletions(-) create mode 100644 lib/Enigmatic/Reflector.pm create mode 100644 lib/Enigmatic/ReflectorBox.pm create mode 100644 lib/Enigmatic/Role/WithWiring.pm create mode 100644 t/lib/Test/Enigmatic.pm create mode 100644 t/reflectors.t 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, diff --git a/t/lib/Test/Enigmatic.pm b/t/lib/Test/Enigmatic.pm new file mode 100644 index 0000000..923ede1 --- /dev/null +++ b/t/lib/Test/Enigmatic.pm @@ -0,0 +1,15 @@ +package Test::Enigmatic; +use DAKKAR::p 'test'; + +sub test_static_map { + my ($mapper,$out,$name) = @_; + + my @in = 'A'..'Z'; + my %map;@map{@in}=@$out; + + for my $c ('A' .. 'Z') { + is($mapper->map($c), + $map{$c}, + "$name on $c"); + } +} diff --git a/t/reflectors.t b/t/reflectors.t new file mode 100644 index 0000000..107ff9f --- /dev/null +++ b/t/reflectors.t @@ -0,0 +1,71 @@ +#!perl +use DAKKAR::p 'test'; +use List::Util 'shuffle'; +use Test::Enigmatic; + +use Enigmatic::Reflector; +use Enigmatic::ReflectorBox; + +subtest 'identity reflector' => sub { + my @in = 'A'..'Z'; + my $r = Enigmatic::Reflector->new(@in->join); + Test::Enigmatic::test_static_map($r,\@in,'identity'); +}; + +subtest 'scramble reflector' => sub { + my %map;my @letters='A'..'Z'; + my %unused;@unused{@letters}=(); + for my $letter (@letters) { + next if not exists $unused{$letter}; + my @usable = keys %unused; + my $image = @usable[rand @usable]; + $map{$letter} = $image; + $map{$image} = $letter; + delete $unused{$letter}; + delete $unused{$image}; + } + + my $wiring = join '',@map{@letters}; + note "scramble reflector: $wiring"; + + my $r = Enigmatic::Reflector->new($wiring); + Test::Enigmatic::test_static_map($r,[@map{@letters}],'shuffle'); +}; + +subtest 'constraints' => sub { + my @bad_params = ( + 'ABCD', + 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCD', + 'AACDEFGHIJKLMNOPQRSTUVWXYZ', + '12CDEFGHIJKLMNOPQRSTUVWXYZABCD', + 'EKMFLGDQVZNTOWYHXUSPAIBRCJ', + ); + + for my $bad_param (@bad_params) { + dies_ok { + Enigmatic::Reflector->new($bad_param); + } "bad parameter $bad_param"; + } +}; + +subtest 'reflector box' => sub { + my %reflectors = ( + B => 'YRUHQSLDPXNGOKMIEBFZCWVJAT', + C => 'FVPJIAOYEDRZXWGCTKUQSBNMHL', + 'B_thin' => 'ENKQAUYWJICOPBLMDXZVFTHRGS', + 'C_thin' => 'RDOBJNTKVEHMLFCWZAXGYIPSUQ', + ); + + my $box = Enigmatic::ReflectorBox->new(); + + %reflectors->each(sub { + my ($reflector,$wiring) = @_; + my $r = $box->get($reflector); + my $out = $wiring->split(qr//); + Test::Enigmatic::test_static_map( + $r,$out, + "reflector $reflector from box"); + }); +}; + +done_testing(); diff --git a/t/rotors.t b/t/rotors.t index fb53fe4..90ce6ce 100644 --- a/t/rotors.t +++ b/t/rotors.t @@ -1,35 +1,22 @@ #!perl use DAKKAR::p 'test'; use List::Util 'shuffle'; +use Test::Enigmatic; use Enigmatic::Rotor; use Enigmatic::RotorBox; -sub test_the_rotor { - my ($r,$out,$name) = @_; - - my @in = 'A'..'Z'; - my %map;@map{@in}=@$out; - - for my $c ('A' .. 'Z') { - is($r->map($c), - $map{$c}, - "$name on $c"); - } -} - subtest 'identity rotor' => sub { my @in = 'A'..'Z'; my $r = Enigmatic::Rotor->new(@in->join); - test_the_rotor($r,\@in,'identity'); + Test::Enigmatic::test_static_map($r,\@in,'identity'); }; - subtest 'scramble rotor' => sub { my @out = shuffle 'A'..'Z'; my $r = Enigmatic::Rotor->new(@out->join); - test_the_rotor($r,\@out,'shuffle'); + Test::Enigmatic::test_static_map($r,\@out,'shuffle'); }; subtest 'identity rotor, non-default ring setting' => sub { @@ -39,7 +26,7 @@ subtest 'identity rotor, non-default ring setting' => sub { wiring => ['A'..'Z']->join, ring_setting => 1, ); - test_the_rotor($r,\@out,'ring=1'); + Test::Enigmatic::test_static_map($r,\@out,'ring=1'); }; subtest 'constraints' => sub { @@ -77,8 +64,9 @@ subtest 'rotor box' => sub { my ($rotor,$wiring) = @_; my $r = $box->get($rotor); my $out = $wiring->split(qr//); - test_the_rotor($r,$out, - "rotor $rotor from box"); + Test::Enigmatic::test_static_map( + $r,$out, + "rotor $rotor from box"); }); }; -- cgit v1.2.3