t/rotors.t


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117

#!perl 
use DAKKAR::p 'test';
use List::Util 'shuffle';
use Test::Enigmatic;
 
use Enigmatic::Rotor;
use Enigmatic::RotorBox;
 
subtest 'identity rotor' => sub {
    my @in = 'A'..'Z';
    my $r = Enigmatic::Rotor->new(@in->join);
    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::Enigmatic::test_static_map($r,\@out,'shuffle');
};
 
subtest 'constraints' => sub {
    my @bad_params = (
        'ABCD',
        'ABCDEFGHIJKLMNOPQRSTUVWXYZABCD',
        'AACDEFGHIJKLMNOPQRSTUVWXYZ',
        '12CDEFGHIJKLMNOPQRSTUVWXYZABCD',
    );
 
    for my $bad_param (@bad_params) {
        dies_ok {
            Enigmatic::Rotor->new($bad_param);
        } "bad parameter $bad_param";
    }
};
 
subtest 'rotor box' => sub {
    my %rotors = (
        I => 'EKMFLGDQVZNTOWYHXUSPAIBRCJ',
        II => 'AJDKSIRUXBLHWTMCQGZNPYFVOE',
        III => 'BDFHJLCPRTXVZNYEIWGAKMUSQO',
        IV => 'ESOVPZJAYQUIRHXLNFTGKDCMWB',
        V => 'VZBRGITYUPSDNHLXAWMJQOFECK',
        VI => 'JPGVOUMFYQBENHZRDKASXLICTW',
        VII => 'NZJHGRCXMYSWBOUFAIVLPEKQDT',
        VIII => 'FKQHTLXOCBJSPDZRAMEWNIUYGV',
        Beta => 'LEYJVCNIXWPBQMDRTAKZGFUHOS',
        Gamma => 'FSOKANUERHMBTIYCWLQPZXVGJD',
    );
    my %notch_at = (
        I => ['Q'],
        II => ['E'],
        III => ['V'],
        IV => ['J'],
        V => ['Z'],
        VI => ['Z','M'],
        VII => ['Z','M'],
        VIII => ['Z','M'],
        Beta => [],
        Gamma => [],
    );
 
    my $box = Enigmatic::RotorBox->new();
 
    %rotors->each(sub {
                      my ($rotor,$wiring) = @_;
                      my $r = $box->get($rotor);
                      my $out = $wiring->split(qr//);
                      Test::Enigmatic::test_static_map(
                          $r,$out,
                          "rotor $rotor from box");
 
                      my @notches = $notch_at{$rotor}->flatten;
                      my @not_notches = do {
                          my %tmp;@tmp{'A'..'Z'}=();
                          delete @tmp{@notches};
                          keys %tmp;
                      };
                      for my $l (@notches) {
                          ok($r->has_notch_at($l),
                             "rotor $rotor has notch at $l");
                      }
                      for my $l (@not_notches) {
                          ok(! $r->has_notch_at($l),
                             "rotor $rotor has no notch at $l");
                      }
                  });
};
 
subtest 'ring-setting on real rotor' => sub {
    my $r = Enigmatic::RotorBox->new->get('I');
    $r->ring_setting(1);
 
    my $out = 'EKMFLGDQVZNTOWYHXUSPAIBRCJ'->split(qr//);
    $out->unshift($out->pop);
    $out->each_value(sub{$_[0] =~ tr[A-Z][B-ZA]});
 
    Test::Enigmatic::test_static_map($r,$out,'ring I moved to 1');
};
 
done_testing();
 
__END__
 
=head1 AUTHOR
 
Gianni Ceccarelli <dakkar@thenautilus.net>
 
=head1 COPYRIGHT AND LICENSE
 
This software is copyright (c) 2011 by Gianni Ceccarelli.
 
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, version 3.
 
=cut