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]);
}