1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
#!/usr/bin/env perl
use strict;
use warnings;
use experimental qw<switch>;
use v5.26;
my %forwardTable=map { join "0",split "",$_}(
a=>".-",
b=>"-...",
c=>"-.-.",
d=>"-..",
e=>".",
f=>"..-.",
g=>"--.",
h=>"....",
i=>"..",
j=>".---",
k=>"-.-",
l=>".-...",
n=>"-.",
m=>"--",
o=>"---",
p=>".--.",
q=>"--.-",
r=>".-.",
s=>"...",
t=>"-",
u=>"..-",
v=>"...-",
w=>".--",
x=>"-..-",
y=>"-.--",
z=>"--..",
1=>".----",
2=>"..---",
3=>"...--",
4=>"....-",
5=>".....",
6=>"-....",
7=>"--...",
8=>"---..",
9=>"----.",
0=>"-----",
" "=>""
);
my %reverseTable;
$reverseTable{$forwardTable{$_}}=$_ for (keys %forwardTable);
my $string= $ARGV[0]//"abc";
$string=~tr/A-Z/a-z/;
print "Original String: $string\n";
my $e=encode($string);
print "Encoded: $e\n";
my $packed=pack("B*",$e);
my $unpacked=unpack("B*",$packed);
print "Unpacked: ".$unpacked."\n";
my $d=decode($unpacked);
print "Decoded: $d\n";
#===
sub encode {
my ($in)=@_;
my @codes= map { ($_,"000") } @forwardTable{split "", $in};
pop @codes; #Remove last charater gap
my $out="";
for (map { split "", $_}@codes) {
when (/\./) {
$out.="1";
}
when (/-/) {
$out.="111";
}
when (/0/) {
$out.="0";
}
default {
}
}
$out;
}
sub decode {
my ($in)=@_;
my $out="";
for (split "000", $in) {
when (/^$/) {
$out.=" ";
}
default {
s/111/-/g;
s/1/./g;
# s/0//g;
my $c=$reverseTable{$_};
while (! $c ){ #fix extra bits at end of byte
$_=substr($_,0,length($_) -1);
$c=$reverseTable{$_};
}
$out.=$c;
}
}
$out;
}
|