Welcome to the Monastery PerlMonks

### Transposition Cipher

by pauloesb (Initiate)
 on May 03, 2014 at 22:18 UTC Need Help??
pauloesb has asked for the wisdom of the Perl Monks concerning the following question:

Hello everybody, my name is Paul and I'm beginner in perl language. I'm doing a college work on the transposition cipher, and decided to do in Perl, because I enjoyed the language, but I'm having some problems of logic to solve this in the Perl language, could you guys could help me? I wrote an encryptor and decryptor transposition perl, apparently the encryption is working perfectly, but the decryption is not working, would you orient me about this problem? Follow the code below

Transposition Cipher
``` open KEYWORD, "<", "key.txt" or die \$!;
open CLEANTEXT, "<", "cleanText.txt" or die \$!;
open CIPHERTEXT, ">", "cipherText.txt" or die \$!;

my (\$data, \$n, \$offset);
my @cleanTextArray;

while((\$n = read CLEANTEXT, \$data, 1)!=0) {
push @cleanTextArray, \$data;
}

my \$textSize = \$#cleanTextArray;

\$key = &to26(<KEYWORD>);             # Get keys from command line
#   and transform to upper case.
#\$option = \$ARGV[1];
\$keylength = length(\$key);
print "Length of key: \$keylength --- ";
@keylist = split(//, \$key);   # Split key into single
#   characters.
print "Key: ";
foreach \$k (@keylist) {print "\$k ";}
print "\n";

\$permut[0] = 0;
for (\$i = 1; \$i < \$keylength; \$i++) {
\$j = 0;
\$found = 0;
while (!\$found) {
if ((\$j >= \$i) || (\$keylist[\$i] lt \$keylist[\$permut[\$j]])) {
splice(@permut, \$j, 0, \$i);    # Insert \$i at position \$j
\$found = 1;}
else {\$j++;}
}
}

print "Permutation:";
foreach \$p (@permut) {print " \$p";}
print "\n";

my \$lines = \$keylength;
my \$columns = int(\$textSize/\$keylength);
if ((\$textSize % \$keylength) > 0) {
\$columns += 1;
}
\$matrixSize = \$columns*\$lines;

print "Number of rows: \$colums -- size of tableau: \$matrixSize\n";
for (\$i = \$textSize; \$i < \$matrixSize; \$i++) {\$cleanTextArray[\$i] = "0
+";}

print "Arrangement of plaintext in columns:\n";
for (\$i = 0; \$i < \$columns; \$i++) {
for (\$j = 0; \$j < \$lines; \$j++) {
print "\$cleanTextArray[\$lines*\$i + \$j] ";
}
print "\n";
}

for (\$i = 0; \$i < \$columns; \$i++) {
for (\$j = 0; \$j < \$lines; \$j++) {
print CIPHERTEXT "\$cleanTextArray[\$lines*\$i + \$    permut[\$j]]";
}
print "\n";
}

close KEYWORD;
close CLEANTEXT;
close CIPHERTEXT;

sub to26 {
local(\$mytext) = \$_[0];         # Get input string.
#  \$mytext =~ tr/a-z/A-Z/;         # Translate to upper case.
\$mytext =~ s/0/zero/g;          # Numbers to verbal description.
\$mytext =~ s/1/um/g;
\$mytext =~ s/2/dois/g;
\$mytext =~ s/3/tres/g;
\$mytext =~ s/4/quatro/g;
\$mytext =~ s/5/cinco/g;
\$mytext =~ s/6/seis/g;
\$mytext =~ s/7/sete/g;
\$mytext =~ s/8/oito/g;
\$mytext =~ s/9/nove/g;
return \$mytext;
}
Transposition Decipher
```open KEYWORD, "<", "key.txt" or die \$!;
open CIPHERTEXT, "<", "cipherText.txt" or die \$!;
open DECIPHERTEXT, ">", "decipherText.txt" or die \$!;

my (\$data, \$n, \$offset);
my @cipherTextArray;

while((\$n = read CIPHERTEXT, \$data, 1)!=0) {
push @cipherTextArray, \$data;
}

my \$textSize = \$#cipherTextArray;

\$key = &to26(<KEYWORD>);             # Get keys from command line
#   and transform to upper case.
#\$option = \$ARGV[1];
\$keylength = length(\$key);
print "Length of key: \$keylength --- ";
@keylist = split(//, \$key);   # Split key into single
#   characters.
print "Key: ";
foreach \$k (@keylist) {print "\$k ";}
print "\n";

\$permut[0] = 0;
for (\$i = 1; \$i < \$keylength; \$i++) {
\$j = 0;
\$found = 0;
while (!\$found) {
if ((\$j >= \$i) || (\$keylist[\$i] lt \$keylist[\$permut[\$j]])) {
splice(@permut, \$j, 0, \$i);    # Insert \$i at position \$j
\$found = 1;}
else {\$j++;}
}
}

\$invpermut[0] = 0;
for (\$i = 1; \$i < \$keylength; \$i++) {
\$j = 0;
\$found = 0;
while (!\$found) {
if ((\$j >= \$i) || (\$permut[\$i] lt \$permut[\$invpermut[\$j]])) {
splice(@invpermut, \$j, 0, \$i);    # Insert \$i at position \$j
\$found = 1;}
else {\$j++;}
}
}

print "Permutation:";
foreach \$p (@permut) {print " \$p";}
print "\n";

print "Inverse Permutation:";
foreach \$p (@invpermut) {print " \$p";}
print "\n";

my \$lines = \$keylength;
my \$columns = int(\$textSize/\$keylength);
if ((\$textSize % \$keylength) > 0) {
\$columns += 1;
}
\$matrixSize = \$columns*\$lines;

print "Number of rows: \$colums -- size of tableau: \$matrixSize\n";
for (\$i = \$textSize; \$i < \$matrixSize; \$i++) {\$cipherTextArray[\$i] = "
+0";}

print "Arrangement of ciphertext in columns:\n";
for (\$i = 0; \$i < \$columns; \$i++) {
for (\$j = 0; \$j < \$lines; \$j++) {
print "\$cipherTextArray[\$lines*\$i + \$permut[\$j]] ";
}
print "\n";
}

print "Arrangement of deciphertext in columns: \n";
for (\$i = 0; \$i < \$columns; \$i++) {
for (\$j = 0; \$j < \$lines; \$j++) {
print "\$cipherTextArray[\$lines*\$i + \$invpermut[\$j]]";
}
print "\n";
}

close KEYWORD;
close CIPHERTEXT;
close DECIPHERTEXT;

sub to26 {
local(\$mytext) = \$_[0];         # Get input string.
#  \$mytext =~ tr/a-z/A-Z/;         # Translate to upper case.
\$mytext =~ s/0/zero/g;          # Numbers to verbal description.
\$mytext =~ s/1/um/g;
\$mytext =~ s/2/dois/g;
\$mytext =~ s/3/tres/g;
\$mytext =~ s/4/quatro/g;
\$mytext =~ s/5/cinco/g;
\$mytext =~ s/6/seis/g;
\$mytext =~ s/7/sete/g;
\$mytext =~ s/8/oito/g;
\$mytext =~ s/9/nove/g;
return \$mytext;
}
cleanTxt.txt contains "ola eu sou o paulo 1234567890" key.txt contains "secretmachine"

Replies are listed 'Best First'.
Re: Transposition Cipher
by GrandFather (Sage) on May 04, 2014 at 02:10 UTC

I started out thinking I would point out style and other issues with your code item by item, but instead I've essentially rewritten it rather than try to fix a whole series of (mostly small) issues.

The key problem with your decrypt is that it is "indexing the wrong way round" so in effect it re-encrypts the encrypted text instead of decrypting it.

I've changed the structure of the code so that it is clear that the encryption is block based so instead of breaking the plain text into characters, it breaks it into key length blocks and deals with those.

```#!user/bin/perl
use warnings;
use strict;

my \$plainTextIn = <<EOF;
abcdefghijklmnopqrs1234567890
EOF
my \$keyTextIn = <<EOF;
secretmachine
EOF

test('testing');

sub test {
my (\$testing) = @_;
open my \$plainIn, "<", \\$plainTextIn;

my \$plainText = <\$plainIn>;
chomp \$plainText;
close \$plainIn;

open my \$keyIn, "<", \\$keyTextIn;
my \$key = to26(<\$keyIn>, \$testing);
close \$keyIn;

my \$cipherText = encrypt(\$key, \$plainText, \$testing);
print ">>>>>>>>>>>>>\n" if \$testing;
my \$decryptText = decrypt(\$key, \$cipherText, \$testing);

print <<TEXT
\$plainText
-----------
\$cipherText
-----------
\$decryptText
TEXT
}

sub encrypt {
my (\$key, \$plainText, \$testing) = @_;
my \$keylength  = length (\$key);
my @blocks     = \$plainText =~ /(.{1,\$keylength})/g;
my \$matrixSize = @blocks * \$keylength;

print "-- Length of key: \$keylength --- Key: '\$key'\n" if \$testing
+;
print "-- Plain text: '\$plainText'\n"                  if \$testing
+;

my @permut = calcPermut(\$key);

print "-- Permutation: @permut\n"         if \$testing;
print "-- Size of tableau: \$matrixSize\n" if \$testing;

\$blocks[-1] .= '0' x (\$keylength - length \$blocks[-1]);   # 0 pad
+last block

for my \$line (@blocks) {
print "-- '\$line'\n" if \$testing;
\$line = join '', map {substr \$line, \$permut[\$_], 1} 0 .. \$keyl
+ength - 1;
}

return join '', @blocks;
}

sub decrypt {
my (\$key, \$cipherText, \$testing) = @_;
my \$keylength  = length (\$key);
my @blocks     = \$cipherText =~ /(.{1,\$keylength})/g;
my \$matrixSize = @blocks * \$keylength;

print "-- Length of key: \$keylength --- Key: '\$key'\n" if \$testing
+;
print "-- Cipher text: '\$cipherText'\n"                if \$testing
+;

my @permut = calcPermut(\$key);

print "-- Permutation: @permut\n"         if \$testing;
print "-- Size of tableau: \$matrixSize\n" if \$testing;

for my \$line (@blocks) {
my @newLine;
print "-- '\$line'\n" if \$testing;
\$newLine[\$permut[\$_]] = substr \$line, 0, 1, '' for 0 .. \$#perm
+ut;
\$line = join '', @newLine;
}

return join '', @blocks;
}

sub to26 {
my (\$mytext, \$testing) = @_;    # Get input string.
chomp \$mytext;
print "-- to26:'\$mytext'\n" if \$testing;
\$mytext =~ s/0/zero/g;          # Numbers to verbal description.
\$mytext =~ s/1/um/g;
\$mytext =~ s/2/dois/g;
\$mytext =~ s/3/tres/g;
\$mytext =~ s/4/quatro/g;
\$mytext =~ s/5/cinco/g;
\$mytext =~ s/6/seis/g;
\$mytext =~ s/7/sete/g;
\$mytext =~ s/8/oito/g;
\$mytext =~ s/9/nove/g;
return \$mytext;
}

sub calcPermut {
my (\$key) = @_;
my @keylist = split //, \$key;
my @permut;

\$permut[0] = 0;
for my \$i (1 .. @keylist - 1) {
my \$j = 0;

while (1) {
if ((\$j >= \$i) || (\$keylist[\$i] lt \$keylist[\$permut[\$j]]))
+ {
splice (@permut, \$j, 0, \$i);    # Insert \$i at positio
+n \$j
last;
}

\$j++;
}
}

return @permut;
}

Prints:

```-- to26:'secretmachine'
-- Length of key: 13 --- Key: 'secretmachine'
-- Plain text: 'abcdefghijklmnopqrs1234567890'
-- Permutation: 7 2 8 1 4 12 9 10 6 11 3 0 5
-- Size of tableau: 39
-- 'abcdefghijklm'
-- 'nopqrs1234567'
-- '8900000000000'
>>>>>>>>>>>>>
-- Length of key: 13 --- Key: 'secretmachine'
-- Cipher text: 'hcibemjkgldaf2p3or74516qns0009000000080'
-- Permutation: 7 2 8 1 4 12 9 10 6 11 3 0 5
-- Size of tableau: 39
-- 'hcibemjkgldaf'
-- '2p3or74516qns'
-- '0009000000080'
abcdefghijklmnopqrs1234567890
-----------
hcibemjkgldaf2p3or74516qns0009000000080
-----------
abcdefghijklmnopqrs12345678900000000000

Update: removed unused sub show

Perl is the programming world's equivalent of English

Thank you very much GrandFather, i can see much better now with a modulated code, i couldn't see my error on code about this wrong indexing. I'm still having some issues to understand some parts, but i'm searching for the parts that i dont understand about Pearl Language in google. Thanks again...

"I'm still having some issues to understand some parts, but i'm searching for the parts that i dont understand about Pearl Language in google."

I'd recommend looking in http://perldoc.perl.org/perl.html, using perldoc from your command line, or searching this site with Super Search before reaching for a generic search engine.

If there's anything you still don't understand, you can always ask here. If you give a link back to this thread, that will provide context for your question. Also, indicating what research you've already undertaken, and how the results of that were lacking, will get you a better answer: for instance, if you ask about X, you'll likely get replies about just X; if you say you've found X but not some specific aspect of X, you'll likely get replies about that specific aspect of X.

By the way, if you search for "Pearl", you'll find information about oysters and necklaces. :-)

-- Ken

Create A New User
Node Status?
node history
Node Type: perlquestion [id://1084903]
Approved by GrandFather
Front-paged by kcott
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (4)
As of 2018-03-23 21:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
When I think of a mole I think of:

Results (297 votes). Check out past polls.

Notices?