5
\$\begingroup\$

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.

\$\endgroup\$

1 Answer 1

4
\$\begingroup\$

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]);
}
\$\endgroup\$
1
  • 1
    \$\begingroup\$ Always use warnings; \$\endgroup\$ Apr 16, 2014 at 21:25

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.