Little script to Caesar shift strings

Question

I wrote a little Perl script to Caesar shift strings. Usage:

$ # usage: caesar <string> [shifts,...]
$ caesar abcde # The default shift is 13.
nopqr
$ caesar abcde 1
bcdef
$ caesar abcde 1,13 # Multiple shifts are supported.
bcdef
nopqr
$ caesar abcde 1-3,5-6 # Shift ranges are supported.
bcdef
cdefg
defgh
fghij
ghijk

Here is the code:

#!/usr/bin/env perl
use strict;
sub usage {
 die 'usage: ceaser <string> [shifts,...]'
}
usage if $#ARGV < 0;
my @str = split //, $ARGV[0];
my @shifts = split /,/, $ARGV[1];
@shifts = (13) unless @shifts;
# Resolve ranges.
my @shifts2 = ();
SHIFT: for my $shift (@shifts) {
 my @ranges = split /-/, $shift;
 for my $range (@ranges) {
 if ($range < 0 || $range > 25) {
 warn "invalid shift size: $range";
 next SHIFT;
 }
 }
 push @shifts2, ($ranges[0]..$ranges[$#ranges]);
}
@shifts = @shifts2;
# Generate ciphered strings.
for my $shift (@shifts) {
 my @str2 = @str;
 for my $c (@str2) {
 my $d = ord($c);
 if ($d >= ord('a') && $d <= ord('z') - $shift ||
 $d >= ord('A') && $d <= ord('Z') - $shift) {
 $d += $shift;
 } elsif ($d >= ord('z') - $shift && $d <= ord('z') ||
 $d >= ord('Z') - $shift && $d <= ord('Z')) {
 $d -= ord('z') - ord('a') - $shift + 1;
 }
 $c = chr($d);
 }
 printf "%s\n", join '', @str2;
}

This is my first Perl script. I am looking for advice on making the code simpler, cleaner, and more idiomatic.

Answer 1

This is good Perl code. You've followed good practices such as use strict and declaring variables using my. It's also quite readable.

However, it feels a bit like C, trudging along with a lot of iteration and low-level operations. Also, I would suggest defining subroutines such as caesar and shifts.

A typical way to implement a Caesar cipher using Perl is with the tr operator. Unfortunately, since the amount of shifting is to be determined at runtime, you would have to use a nasty eval.

my $uc_in = join '', ('A'..'Z');
my $lc_in = join '', ('a'..'z');
sub caesar {
 my ($shift, $text) = @_;
 my $uc_out = substr((join '', ('A'..'Z', 'A'..'Z')), $shift, 26);
 my $lc_out = substr((join '', ('a'..'z', 'a'..'z')), $shift, 26);
 eval "\$text =~ tr/$uc_in$lc_in/$uc_out$lc_out/r";
}

An alternative implementation, closer to your original idea but avoiding splitting and iterating, is to perform a substitution using s///eg.

sub caesar {
 my ($shift, $text) = @_;
 $text =~ s{([A-Z])|([a-z])}
 { chr(1ドル && (ord(1ドル) <= ord('Z') - $shift) ? ord(1ドル) + $shift :
 2ドル && (ord(2ドル) <= ord('z') - $shift) ? ord(2ドル) + $shift :
 1ドル ? ord(1ドル) + $shift - (ord('Z') - ord('A') + 1) :
 ord(2ドル) + $shift - (ord('z') - ord('a') + 1)
 )
 }eg;
 return $text;
}

To parse the shifts, I would prefer a more functional approach, building the list using map instead of appending results within a for loop.

sub shifts {
 my ($arg) = @_;
 return map {
 my ($low, $high) = split /-/, $_, 2;
 if ($low < 0 || $high > 25 || defined $high && $low >= $high) {
 warn "Invalid shift size: $_";
 }
 defined $high ? ($low .. $high) : $low;
 } (split /,/, $arg);
}

With the difficult stuff out of the way, the main program would be something like

# print "...\n" is annoying. Use say() if you have a newer Perl.
use v5.10;
use feature qw(say);
die 'usage: caesar <string> [shifts,...]' unless @ARGV;
my @shifts = defined $ARGV[1] ? shifts($ARGV[1]) : (13);
for my $shift (@shifts) {
 say caesar($shift, $ARGV[0]);
}

• ThisSuitIsBlackNot: Always use warnings;