package Enigmatic::CryptTrain;
use DAKKAR::p 'class';
use Enigmatic::Types qw(Letter RotorPos);
use MooseX::Types::Moose qw(ArrayRef);
use Moose::Util::TypeConstraints;
with 'Enigmatic::Role::Rotate';
has rotors => (
isa => ArrayRef[class_type('Enigmatic::Rotor')],
traits => ['Array'],
writer => 'set_rotors',
handles => {
set_rotor => 'set',
rotor_at => 'get',
rotors => 'elements',
},
);
sub rotor_count {
my ($self) = @_;
return scalar $self->rotors;
}
has reflector => (
isa => class_type('Enigmatic::Reflector'),
writer => 'set_reflector',
reader => 'reflector',
);
has positions => (
isa => ArrayRef[RotorPos],
traits => ['Array'],
writer => 'set_positions',
handles => {
set_position => 'set',
position_at => 'get',
positions => 'elements',
},
lazy_build => 1,
);
sub _build_positions {
my ($self) = @_;
my @ret = (0) x $self->rotor_count;
return \@ret;
}
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my $args = $class->$orig(@_);
if ($args->{positions}) {
warn "pos: @{$args->{positions}}\n";
for my $pos (@{$args->{positions}}) {
$pos = to_RotorPos($pos);
}
warn "pos: @{$args->{positions}}\n";
}
return $args;
};
around set_position => sub {
my ($orig,$self,$idx,$pos) = @_;
return $self->$orig($idx,to_RotorPos($pos));
};
sub map {
my $self = shift;
my ($letter) = pos_validated_list(
\@_,
{ isa => Letter },
);
my $max_idx = $self->rotor_count -1;
my $log='';
$self->step_positions();
for my $idx (0..$max_idx) {
my $rotor = $self->rotor_at($idx);$log.="($idx:";
my $position = $self->position_at($idx);$log.="$position)";
$letter = _rotate_by($letter,$position);$log.=$letter;
$letter = $rotor->map($letter);$log.=$letter;
$letter = _rotate_by($letter,-$position);$log.=$letter;
}
$letter = $self->reflector->map($letter);$log.="r${letter}r";
for my $idx (reverse 0..$max_idx) {
my $rotor = $self->rotor_at($idx);$log.="($idx:";
my $position = $self->position_at($idx);$log.="$position)";
$letter = _rotate_by($letter,$position);$log.=$letter;
$letter = $rotor->inverse_map($letter);$log.=$letter;
$letter = _rotate_by($letter,-$position);$log.=$letter;
}
warn "$log\n";
return $letter;
}
sub _inc_position {
my ($self,$idx) = @_;
my $cur = $self->position_at($idx);
$cur = ($cur+1)%26;
$self->set_position($idx,$cur);
return $cur;
}
sub rotor_window_at {
my ($self,$idx) = @_;
return ['A'..'Z']->[$self->position_at($idx)]
}
sub rotor_windows {
my ($self) = @_;
my @ret = map { $self->rotor_window_at($_) } 0 .. $self->rotor_count -1;
return @ret;
}
sub step_positions {
my ($self) = @_;
my $max_idx = $self->rotor_count -1;
my @will_step = (0) x $max_idx;
$will_step[0]=1;
for my $idx (0 .. $max_idx) {
my $rot = $self->rotor_at($idx);
my $notch = $rot->has_notch_at($self->rotor_window_at($idx));
$will_step[$idx] = $will_step[$idx+1] = 1 if $notch;
}
$will_step[3] = 0;
for my $idx (0 .. $max_idx) {
$self->_inc_position($idx) if $will_step[$idx];
}
return;
}