Welcome to the Perl review for Week 045 of the Weekly Challenge! For a quick overview, go through the original tasks and recap of the weekly challenge.
Continues from previous week.
Getting in Touch
Email › Email me (Ryan) with any feedback about this review.
GitHub › Submit a pull request for any issues you may find with this page.
Twitter › Join the discussion on Twitter!
We’d greatly appreciate any feedback you’d like to give.
Table of Contents
Task #1 › Square Secret Code
Original task description
The square secret code mechanism first removes any space from the original message. Then it lays down the message in a row of 8 columns. The coded message is then obtained by reading down the columns going left to right.
For example, the message is “The quick brown fox jumps over the lazy dog”.
Then the message would be laid out as below:
thequick
brownfox
jumpsove
rthelazy
dog
Figure 1 › Partitioned Plaintext
The code message would be as below:
tbjrd hruto eomhg qwpe unsl ifoa covz kxey
My general observations
There seem to be two main ways people approached this task:
1. Partitioning
By first splitting the plaintext into column-width substrings, you end up with Figure 1 (above). From there, you can simply append the first character of each string to your output, then the second character, and so on.
This method is perhaps the most obvious implementation of the problem description, as it follows the wording quite closely.
2. split and Modulo Arithmetic
For this method, you first split the plaintext into a list of chars. Then, you loop over the plaintext array, appending each character into its $index % $columns string in an array of @columns. Finally, you simply join the columns together.
This method is maybe a little less obvious, but lead to some concise solutions.
If my plain English descriptions don’t make complete sense yet, don’t worry; there will be plenty of code examples of both methods below.
Adam Russell
Adam Russell’s solution uses the split and modulo arithmetic method. He iterates over @characters to push characters into the array of arrays, @buckets:
use constant SQUARE_SIZE => 8;
sub encode{
my($message) = @_;
$message =~ tr/ //d;
my $encoded;
my @buckets;
my @characters = split(//, lc($message));
for my $i (0 .. @characters){
$buckets[$i % SQUARE_SIZE] = [] if !$buckets[$i % SQUARE_SIZE];
push @{$buckets[$i % SQUARE_SIZE]}, $characters[$i] if $characters[$i];
}
for my $bucket (@buckets){
$encoded .= join("", @{$bucket}) . " ";
}
return $encoded;
}
The solution is then built up by joining each of the @buckets together, and appending the result to the $encoded output string, with the space to separate the columns.
Blog › Perl Fun
Alicia Bielsa
Alicia Bielsa’s solution has an input loop that asks the user for a plaintext message. Her encodeMessage function uses the split and modulo method to encode the message:
sub encodeMessage {
my $message = shift;
my @aSubMessages = ();
my $messageEncoded = '';
$message =~ s%\s+%%g;
my @aEncodedGroups = ();
my @aMessage = split ('', $message);
foreach my $indexMessage (0..$#aMessage) {
my $indexSubgroup = $indexMessage % $columnLength ;
unless (defined $aEncodedGroups[$indexSubgroup]) {
$aEncodedGroups[$indexSubgroup] = '';
}
$aEncodedGroups[$indexSubgroup] .= $aMessage[$indexMessage]; #t
}
$messageEncoded = join(' ', @aEncodedGroups);
return $messageEncoded ;
}
The $indexSubgroup = $indexMessage % $columnLength line is what sets up the proper index, so that the next character in @aMessage is appended to the correct column in @aEncodedGroups.
Also notable, is that Alicia is one of a few people who allows for a configurable column width, through the $columnLength variable, which is a thoughtful touch.
Andrezgz
Andrezgz’s solution first converts the input to lowercase, and then filters out any remaining non-lowercase characters (such as numerics, symbols, and spaces):
my $msg = join '',
map {my $w = lc $_; $w =~ s/[[:^lower:]]//g; $w }
@ARGV or die "USAGE: $0 <message>";
After that, the solution is built up in a %cols hash with modulo arithmetic, with one member for each column:
my %cols;
# each letter is appended to the corresponding column
$cols{$_ % 8} .= substr $msg, $_, 1 for (0 .. (length $msg) -1 );
# coded message is formed by printing each column string in order
print join ' ', map { $cols{$_} } sort keys %cols;
This is a really clean solution, and I particularly like the decision to filter out characters based on what is allowed, instead of what isn’t. When possible, this method typically leads to safer, less error-prone code, as the programmer doesn’t have to account for every possible thing a user might throw at them.
Arne Sommer
Arne has submitted excellent Raku solutions for all 45 weeks in the challenge so far, which is absolutely fantastic. But this is, I believe, the first week Arne has submitted a Perl solution since all the way back in Week 023. Welcome back!
Arne Sommer’s solution is straightforward:
my $string = $ARGV[0] || "The quick brown fox jumps over the lazy dog";
$string =~ tr/ //d;
my @a = split(//, lc $string);
@a.shift;
@a.pop;
for my $word (0 .. 7) {
my $index = $word;
while (1) {
defined $a[$index]
? print $a[$index]
: print(" ") && last;
$index += 8;
}
}
print "\n";
One minor issue, is that the @a.shift; and @a.pop; lines aren’t necessary, and in fact, these statements do nothing except some string concatenation in void context (which would have thrown a warning with use warnings enabled). On reading his blog, Arne was getting extra characters somehow, but that appears to no longer be the case, as this solution works perfectly. It’s also very easy to understand.
Again, I’m very glad to see Arne submitting Perl solutions, and hope to see more in the future! If you haven’t already been following his blog, please do so; it’s excellent.
Blog › Square Dumper with Raku
Athanasius
Athanasius’s solution also has an input loop, and the encoder uses the partitioning method:
sub encode {
my ($plain) = @_;
my @rows;
push @rows, substr($plain, 0, $COLUMNS, '') while $plain;
my $encoded = '';
for my $col (0 .. $COLUMNS - 1) {
$encoded .= ' ' if $encoded;
for my $row (0 .. $#rows) {
my $text = $rows[$row];
$encoded .= substr($text, $col, 1) if $col < length $text;
}
}
return $encoded;
}
As you can see, @rows is built up by partitioning $plain into chunks of up to $COLUMN characters. (The fourth argument to substr ('') is the replacement text, so those chunks get removed during the loop). The next two nested loops build up $encoded character by character from the strings in @rows.
Athanasius wrote a decoder as well:
sub decode {
my ($encoded) = @_;
my @rows = split /\s+/, $encoded;
my $decoded = '';
for my $col (0 .. length($rows[0]) - 1) {
$decoded .= substr($rows[$_], $col, 1) for 0 .. $#rows;
}
return $decoded;
}
The decoder is a little simpler as Athanasius was able to take advantage of the encoded format having spaces separating the rows, but the meat of the function is similar: the nested loops are essentially doing the inverse of what encode did, above.
Burkhard Nickels
Burkhard Nickels’ solution first splits the plaintext into a character array, @l. Then, Burkhard uses a nested loop that builds up the result ($coded_msg) by calculating the array indicies:
$msg =~ s/\s//g;
$msg = lc($msg);
my @l = split("",$msg);
my $coded_msg;
for(my $i=0; $i<=7; $i++) {
for(my $j=$i; $j<=$#l; $j+=8) {
$coded_msg .= $l[$j];
}
$coded_msg .= " ";
}
print "Coded : $coded_msg\n";
The C-style for loops allow Burkhard to manipulate the starting index and increment of the inner loop, so $j will always be the next index to be appended to the result.
Python
Burkhard also submitted a Python solution. Here’s the encoder:
msg = re.sub('\s','',msg)
msg = msg.lower()
l = list(msg)
coded_msg = ""
for i in range(0,8):
j = i
e = len(l)
while j < e:
coded_msg += l[j]
j += 8
coded_msg += " "
print "Coded : ", coded_msg
The Python code uses the same algorithm as the above Perl solution.
Blog › Square Secret Code
Cheok-Yin Fung
Cheok-Yin Fung’s solution decomposes the problem into three distinct parts. First, the plaintext is sanitized, and padded to be a multiple of 8 characters:
$msg = lc($msg);
$msg =~ s/\s//g; # &removespace($_);
$msg =~ s/\t//g;
#ADD WHITESPACE AT THE END SUCH THAT THE LINE HAS 8n CHARACTERS
my $copyoflengthofmsg = length($msg);
$msg .= " " x ($copyoflengthofmsg % 8);
Second, the plaintext is split into characters, and put into a two-dimensional array. $i and $j are maintained such that @a will have the characters in the same type of grid shown in the challenge description:
my $numberofcols = 8;
foreach my $char (split //, $msg) {
$a[$i][$j] = $char;
$copyoflengthofmsg++;
$j++;
if ($j==$numberofcols) {$j = 0; $i++;}
}
Finally, Cheok-Yin Fung iterates over the @a grid to print out the solution:
for $j (0..$numberofcols) {
for $i (0..7) {
$b[$p] = $a[$i][$j];
if ($b[$p] ne " ") {print $b[$p];}
$p++;
}
print " ";
}
Colin Crain
Colin Crain’s solution splits and uses modulo arithmetic:
## eliminate spaces and nonword chars, lowercase rest in one pass
$input = lc( join '', grep { /\w/ } split //, $input );
## create the output array data structure
push my @output, [] for (1..8);
## fill the output arrays
push $output[$_%8]->@*, substr $input, ($_), 1 for (0..(length $input) - 1);
## display the output arrays
say join ' ', map {join '', $_->@* } @output;
This is an example of a good way to use the post-deref syntax, in my opinion; it actually aids the comprehension in this case. Colin’s solution is compact, without being hard to follow.
Dave Cross
Dave Cross’ solution outputs the result in the loop body, rather than building up a string first, but the result is the same:
$msg =~ s/\s+//g;
my @lines = map { [ split // ] } $msg =~ /(.{1,8})/g;
for my $x (0 .. $#{$lines[0]}) {
for my $y (0 .. $#lines) {
print $lines[$y][$x] // '';
}
print ' ';
}
print "\n";
Dave partitions $msg into 8 character (or less) chunks with a /g regex in list context, so it can be sent straight to map, where it is then split into characters and stored in an array of arrays.
Dave Jacoby
Dave Jacoby’s solution first filters out any non-lowercase characters, and then starts partitioning $plaintext into chunks of 8 characters or less, using substr and regexp substitution:
sub encypher ( $plaintext ) {
$plaintext = lc $plaintext;
$plaintext =~ s/[^a-z]//gmx;
my @work;
while ( length $plaintext >= 8 ) {
my $eight = substr $plaintext, 0, 8;
$plaintext =~ s/\w{8}//mix;
push @work, $eight;
}
push @work, $plaintext;
my @cyphertext;
for my $i ( 0 .. scalar @work - 1 ) {
my $word = $work[$i];
for my $j ( 0 .. length $word ) {
my $letter = substr $word, $j, 1;
next unless scalar $letter;
$cyphertext[$j][$i] = $letter;
}
}
return join ' ', map { join '', $_->@* } @cyphertext;
}
After that, @cyphertext is a two-dimensional array (array of arrays, or AoA) built up with a by now familiar-looking nested loop. The return is made by sending each top-level element of @cyphertext through map { join '', $_->@* } to turn the array into a string, and then those strings are joined by the leftmost join ' '.
Blog › Challenge 45: Cyphers and Quines
Duane Powell
Duane Powell’s solution is concise and clear:
$code =~ s/ //g;
my @code = split(//,$code);
my @out;
my $m = 0;
$out[$m++ % $block] .= shift(@code) while (@code);
print "$_ " foreach (@out);
print "\n";
The line doing the heavy lifting, $out[$m++ % $block] .= shift(@code) while (@code) is another good example of how modulo arithmetic really makes light work of this problem.
Duncan C. White
Duncan C. White’s solution provides both an encoder and decoder, as well as a way to change the number of columns. The encoder uses the modulo arithmetic method, but replaces the split with repeated calls to substr $text, $pos, 1 to get one character at a time:
use Function::Parameters;
fun encode( $text )
{
my @columns;
$text =~ s/\s+//g; # remove all whitespace
my $len = length($text);
foreach my $pos (0..$len-1) {
my $ch = substr($text,$pos,1);
$columns[$pos%$ncolumns] //= "";
$columns[$pos%$ncolumns] .= $ch;
}
my $result = join( ' ', @columns );
return $result;
}
The decoder splits the ciphertext on whitespace to obtain @columns. After that is a nested loop, whose body uses s/(^\w)// to trim (and capture) the first character from one of the @columns, appending it to the result:
fun decode( $text )
{
my @columns = split( /\s+/, $text );
my $ncols = @columns;
die "decode: $text has $ncols columns, not $ncolumns\n"
unless $ncols == $ncolumns;
my $npasses = length( $columns[0] );
my $result = "";
foreach my $p (1..$npasses) {
foreach (@columns) {
if( $_ ) {
s/(^\w)//; # remove 1st char from column
$result .= $1;
}
}
}
return $result;
}
E. Choroba
sub square_secret_code {
my ($message) = @_;
my @code = ("") x 8;
for my $group (lc($message) =~ s/\s//gr =~ m/(.{1,8})/g) {
$code[$_] .= (split //, $group)[$_] // "" for 0 .. 7;
}
return join ' ', @code
}
This solution is another example of using the /g modifier in list context. However, Choroba does one better and first removes spaces with the substitution s/\s//gr. The /r modifier is a personal favourite of mine, as instead of performing the substitution in place as usual, it returns a copy of the (modified) string instead. Without that, Choroba would have needed an extra couple of lines of code.
Blog › Perl Weekly Challenge 045: Square Secret Code & Source Dumper
Jaldhar H. Vyas
Jaldhar H. Vyas’ solution chunks the plaintext into @rows of 8 characters, and then uses a nested loop to append the $ith character from each row to the $ith column. The solution is then just @cols, separated by spaces:
my $input = lc join q{ }, @ARGV;
$input =~ s/\s+//gmx;
my @rows;
while (length $input) {
push @rows, substr $input, 0, 8, q{};
}
my @cols;
for my $row (@rows) {
my @chars = split //, $row;
for my $i (0 .. 7) {
if ($chars[$i]) {
$cols[$i] .= $chars[$i];
}
}
}
say join q{ }, @cols;
Blog › Perl Weekly Challenge: Week 45
Javier Luque
Javier Luque’s solution is another concise one with modulo arithmetic:
$string =~ s/\s//g;
my @chars = split('', $string);
my @new_words;
for my $i (0..scalar(@chars)-1) {
$new_words[$i % 8] .= $chars[$i];
}
say join ' ', @new_words;
Blog › PERL WEEKLY CHALLENGE – 045 – Perl Weekly Challenge
Laurent Rosenfeld
Laurent Rosenfeld’s solution uses the partition approach, printing the output on the fly:
$msg =~ s/\s+//g;
my @letters = map { /.{1,8}/g; } $msg;
for my $i (0..7) {
print map { substr $_, $i, 1 if length $_ >= $i} @letters;
print " ";
}
Blog › Perl Weekly Challenge 45: Square Secret Code and Source Dumper
Maxim Kolodyazhny
Maxim Kolodyazhny’s solution is a unique one:
$_ = lc <>;
s/\s//g;
for my $i ( 0..7 ) {
last if ( pos = $i ) == length;
print
$i ? ' ' : '',
/(.).{0,7}/g;
}
Take careful note of Maxim’s assignment to pos, as that is the key to the entire solution. pos sets the offset of the regexp match, and the regexp /(.).{0,7}/g captures every 8th character from that offset. The offset is then incremented the next time through, and it repeats, and thus the columns are printed, one character at a time.
Maxim also included an external set of tests.
Nazareno Delucca
Nazareno Delucca’s solution uses partitioning, and also allows for a user-specified column width:
my $columns = shift || 8;
$message =~ s/\s+//g;
my @rows = unpack "(A$columns)*", lc $message;
foreach my $word ( @rows ){
my @chars = split //, $word;
push @matrix, \@chars;
}
for (0..$columns) {
for my $row( @matrix ) {
$code .= shift @$row || '';
}
$code .= " ";
}
print "$code\n";
The use of unpack is a good way to partition the string. Nazareno then splits the row strings to character arrays to simplify the following task of repeatedly peeling off the first character of each string.
Peter Scott
Peter Scott’s solution came as the following one-liner:
perl -E '$_ = lc shift; tr/a-z//cd; @x = split //; $c=7; while (@x){ for ($i = 0; $i <= $#x; $i += $c) { print splice @x, $i, 1} $c--; print " "} say ""' "The quick brown fox jumps over the lazy dog"
Adding some whitespace back in, we can see it is similar to the split-and-loop method, but is the only solution this week to use splice:
$_ = lc shift;
tr/a-z//cd;
@x = split //;
$c = 7;
while (@x) {
for ($i = 0; $i <= $#x; $i += $c) {
print splice @x, $i, 1
}
$c--;
print " "
}
splice @x, $i, 1 is $x[$i] with the side effect of removing it from @x. Because the element is removed and the others shift positions, Peter compensates by decrementing $c after every column, since the interval between columns decreases by one.
Although splice will be slower, the effect is small (about 15% on a 60-character input string, increasing with length), and I do appreciate the alternative loop conditionals, here, compared to a purely arithmetic-indexed approach.
Rage311
Rage311’s solution uses the split/modulo method, and is beautifully concise:
my @input = split //, <<>> =~ s/\s+//gr;
my @words;
$words[$_ % 8] .= $input[$_] for 0..$#input;
say join ' ', @words;
This is, I believe, Rage311’s first Perl submission. Congrats! I hope to see a lot more like this one.
Rage311 also submitted a solution in Rust, using the same algorithm. Here it is, for all you Rust fans out there:
fn main() -> io::Result<()> {
let mut buffer = String::new();
io::stdin().read_to_string(&mut buffer)?;
buffer = buffer.split_whitespace().collect();
let mut final_words: Vec<String> = vec!["".to_string(); 8];
for i in 0..buffer.len() {
final_words[i % 8].push(buffer.chars().nth(i).unwrap());
}
println!("{}", final_words.join(" "));
Ok(())
}
Roger Bell West
Roger Bell West’s solution uses core module Getopt::Std to accept an arbitrary column width:
use Getopt::Std;
my %o=(n => 8);
getopts('n:',\%o);
Then, after stripping spaces, his encoding looks like this:
my $l=length($in)-1;
my @out;
foreach my $c (0..$o{n}-1) {
my $out;
for (my $k=$c;$k<=$l;$k+=$o{n}) {
$out.=substr($in,$k,1);
}
push @out,$out;
}
print join(' ',@out),"\n";
As you can see, Roger uses a C-style for loop so he can increment by the column width ($o{n}) to pull every $o{n}-th character into his output array. The outer loop shifts the offset ($c) every time through. If speed was the goal, this could be ported to a C XS module with just a few minor changes.
Ruben Westerberg
Ruben Westerberg’s solution avoids the need to deal with undefined values for strings that aren’t a multiple of 8 characters in length by padding the string with spaces:
$padded .= " " x (8+8-length($padded)%8);
Then, he partitions and splits the string into the @rows array-of-arrays, and iterates over it with a nested loop:
my @rows;
my $steps=length($padded)/ 8;
push @rows, [split "", substr $padded, $_*8,8] for (0..$steps-1);
my $out="";
for my $c (0..7) {
for my $r (0..$steps-1) {
$out.= join "",$rows[$r]->[$c];
}
}
$out=~s/ +/ /g;
$out=~s/ $//;
print $out;
His padded string does require a bit of trimming at the end, but after that, all that needs be done is print $out. Nice.
Ryan Thompson
My solution uses the split/modulo method:
sub encode {
local $_ = lc shift;
s/\s//g;
my ($i, @s);
map { $s[$i++ % COLUMNS] .= $_ } split '';
join ' ', @s;
}
The last two lines do most of the work. Had I been going for brevity, I might have combined the lc and substitution regex on the same line as split:
sub encode {
my ($i, @s);
$s[$i++ % COLUMNS] .= $_ for split '', lc shift =~ s/\s//gr;
join ' ', @s
}
But I didn’t feel that helped the code, so I left it as separate statements. I would be happy with either, though.
Blog › Square Secret Code
Saif Ahmed
Saif Ahmed’s solution also supports arbitrary columns, and uses the partition method to chunk the plaintext into @splitChars before the familiar-looking nested loop builds up $result character by character:
sub pivotEncode{
my $str=shift;
my $cols=shift//8;
$str=~s/\s//gm; # remove spaces
@splitChars=($str=~/(.{$cols}|.+)/g); # split into blocks
my $result; # initialise result
foreach my $index (0..$cols-1) { # now select character
foreach my $row ( @splitChars ){ # in each block and
# append it to result
$result.= substr($row,$index,1) if ($index<length $row)
}
$result.=" "; #intersperse spaces
}
return $result; # return encrypted
}
Ulrich Rieke
Ulrich Rieke’s solution uses the partitioning method. I’ll take you through his encode function one step at a time. First, he partitions the string (including any remaining portion less than 8 characters long):
sub encode {
my $str = shift ;
my @strings ;
my $times = int ( (length $str) / 8 ) ;
my $pos = 0 ;
for ( my $i = 0 ; $i < $times ; $i++ ) {
push @strings, substr( $str, $pos , 8 ) ;
$pos += 8 ;
}
At this point, @strings contains one string for each row. Next, Ulrich uses a nested loop and substr($word, $i, 1) to build up $encoded character by character:
push @strings , substr( $str, $pos ) ;
my $encoded ;
for ( my $i = 0 ; $i < 8 ; $i++ ) {
for my $word ( @strings ) {
my $len = length $word ;
if ( $len > $i ) {
$encoded .= substr( $word , $i , 1 ) ;
}
}
}
By now, $encoded might look like Tbjrdhrutoeomhgqwpeunslifoacovzkxey, which is close, but needs spaces between the columns, which is what this next bit does, by splitting and then recombining via join ' ', @encodedStrings:
my $stringslen = scalar @strings ;
my $len = length $encoded ;
$times = length $strings[-1] ;
my @encodedStrings ;
$pos = 0 ;
for ( my $i = 0 ; $i < $times ; $i++ ) {
push @encodedStrings, substr( $encoded , $pos , $stringslen ) ;
$pos += $stringslen ;
}
my $theRest = 8 - $times ;
for ( my $i = 0 ; $i < $theRest ; $i++ ) {
push @encodedStrings , substr( $encoded , $pos , $stringslen - 1 ) ;
$pos += $stringslen - 1 ;
}
return ( join ( ' ' , @encodedStrings ) ) ;
}
Wanderdoc
Wanderdoc’s solution uses Leon Timmermans’ Const::Fast in place of builtin constants:
use Const::Fast; # To use the constant in the regex.
const my $SECRET => 8;
const my $REGEX => qr/(.{1,${SECRET}})/;
Wanderdoc then uses the partitioning method to break up the string:
sub encoding_message {
my $str = $_[0];
$str =~ tr/ //ds;
$str = lc $str;
my @rows = map [split(//,$_)], ($str =~ /$REGEX/g);
my @coded = map {
my $idx = $_;
my @slice = map $_->[$idx] // '', @rows; [@slice];
} 0 .. $SECRET - 1;
my $enc = join(' ', map join('',@$_), @coded);
return $enc;
}
Notice that Wanderdoc uses a variation on the nested loop to create an array-of-arrays in @coded, that is then joined together for the solution.
Wanderdoc also provides a decoder, which looks very similar to the above portion of the encoder, but in reverse:
sub decoding_message {
my $str = $_[0];
my @words = map [split(//,$_)], split(' ', $str);
my @txt = map {
my $idx = $_;
my @slice = map $_->[$idx] // '', @words; [@slice];
} 0 .. $#words;
my $dec = join('', map join('',@$_), @txt);
}
Task #2 - Source Dumper
Write a script that dumps its own source code. For example, say, the script name is ch-2.pl. The following command should return nothing:
$ perl ch-2.pl | diff - ch-2.pl
There are two ways to interpret this problem, resulting in very different solutions. A straight reading of the challenge, with no additional constraints, means our script can simply read its own source file and print it. For example:
open my $fh, '<', __FILE__; # or $0
print <$fh>;
Most people did something similar to this, and these solutions certainly pass the challenge! However, a few of us noticed that this challenge sounded an awful lot like a quine, so we took it a step further for (in my case) the fun of it. Quines are computer programs that not only produce a copy of their own source code, but they also have the additional constraint of taking no input, meaning, reading your own source code is not allowed.
Adam Russell
Adam Russell’s solution is a proper quine, because it does not use any input (the last blank line is required):
print<<''x2,"\n"
print<<''x2,"\n"
I’ve previously seen this quine attributed to Robin Houston some years ago, and it’s long been one of my favourites, due to the clever use of heredocs.
Blog › Perl Fun
Alicia Bielsa
Alicia Bielsa’s solution uses $0 to obtain the filename.
open (my $fh_file , '<', $0 ) or die "Error reading file";
while (my $line = <$fh_file>) {
print $line;
}
close ($fh_file);
Using the three-argument open is always a good practice, so I’m glad to see Alicia use it here. It would, after all, be a terrible quine if your script was named rm -rf . | and used the two-argument open (please don’t try this.)
Andrezgz
Andrezgz’s solution is another proper quine. The whole thing is nearly 100 lines long, but it’s worth seeing, so I’ll trim it down a bit (mostly removing comments) and show what’s left, here. This should still be a quine, after my trimming:
use v5.10;
my @s = (
q&&,
q&say <<'EOT';&,
q&use v5.10;&,
q&EOT&,
q&&,
q&say 'my @s = (';&,
q&foreach my $line (@s) {&,
q& say 'q'.chr(38).$line.chr(38).','&,
q&}&,
q&say ');';&,
q&&,
q&foreach my $line (@s) {&,
q& say $line&,
q&}&,
q&&,
q&say <<'EOT';&,
q&__END__&,
q&&,
q&./ch-2.pl | diff - ch-2.pl&,
q&EOT&,
q&&,
);
say <<'EOT';
use v5.10;
EOT
say 'my @s = (';
foreach my $line (@s) {
say 'q'.chr(38).$line.chr(38).','
}
say ');';
foreach my $line (@s) {
say $line
}
say <<'EOT';
__END__
./ch-2.pl | diff - ch-2.pl
EOT
__END__
./ch-2.pl | diff - ch-2.pl
The solution works by using various quoting operators to embed a copy of the source code within the code itself, which is a common yet powerful way to generate a quine.
Arne Sommer
Arne Sommer’s solution uses $0 to get the script filename, and outputs it line by line:
my $file = $0;
if (open(my $fh, $file)) {
while (my $row = <$fh>) {
print $row;
}
close $fh;
}
Arne also submitted another solution, even more elegant than the first, which uses File::Slurper to read $0 instead:
use File::Slurper 'read_text';
print read_text($0);
By the way, if you haven’t already switched over to File::Slurper from File::Slurp, I encourage you to do so, as ::Slurper fixes a lot of the problems in ::Slurp, especially around the API and handling of encoding.
Blog › Square Dumper with Raku
Burkhard Nickels
Burkhard Nickels’ solution is a source code printer that has gone through some serious research and development! It not only prints its own source code, but it can print the source code of any file. And that’s not all: it can also highlight its own syntax with Text::VimColor, and even render HTML output if desired. It comes with full internal and external documentation, too.
I won’t quote the full source here, but I will share a few key parts. Here is the source code reader and argument processor:
if($ARGV[0] and $ARGV[0] eq "help") {
... # Full help text is here
}
elsif($ARGV[0] and $ARGV[0] eq "high") {
syntax_high($0,$ARGV[1]);
}
elsif($ARGV[0]) {
syntax_high(@ARGV);
}
else {
open(IN,$0) or die "Cant open $0\n";
while(<IN>) { print; }
close IN;
}
As you can see, in all cases, the source code is read from $0, as we’ve seen with other solutions.
The syntax highlighting component (in the sub syntax_high()) shows just how easy it is to get Vim syntax highlighting in HTML using Text::VimColor:
my $syntax = Text::VimColor->new(
file => $file,
filetype => 'perl',
html_full_page => $full,
);
my $html = $syntax->html;
(Getting ANSI output instead would simply look like my $ansi = $syntax->ansi, according to the documentation.)
Burkhard also does a partial HTML parse with split to insert his own line numbering, because the Text::VimColor line numbering wasn’t working for him.
I always like to see solutions like this, that go far above and beyond the challenge, as there is almost guaranteed to be something interesting or unexpected.
Python
Burkhard submitted a Python solution for challenge #2 as well, which uses __file__ to get the script’s filename and then reads from that:
fh = open(__file__);
for line in fh:
print(line),
fh.close
Blog › Source Dumper
Colin Crain
Colin Crain’s solution reads the source code from $0, and prints it out, along with an observation about sections we’d not normally think of as code, such as the __DATA__ section:
local $/ = undef;
open (my $fh, "<", $0) or die "can't open this script thats running this code to read: $0 : $!";
print <$fh>;
__DATA__
even prints the data section, see?
Cristina Heredia
Cristina Heredia’s solution uses a call to system to run cat(1) to print the contents:
#Name of the script
my $program = 'ch-2.pl';
#Execute an unix command
system("cat $program");
Cristina opted to hard-code the name in $program. While this of course means the script can’t be renamed or run from a different directory, it does mean that the single-string call to system is safe from spaces and metacharacters in the filename, since $program is trusted.
The POSIX-only solution is fine by me. My only suggestion would be to switch to the system PROGRAM LIST form. The single-argument form (above) won’t work (and in fact could be vulnerable to abuse) if the script or given pathname contain spaces or shell metacharacters. This is better:
system cat => $0
You could even use exec here, as there is no need to ever regain control after cat is finished:
exec cat => $0
Dave Cross
Dave Cross’ solution exploits the fact that the DATA filehandle is already opened and pointed at the start of the __DATA__ block in the script (if the script has one), but you are still free to access the contents of the entire script, if you set the filehandle’s position with seek:
seek DATA, 0, 0;
print while <DATA>;
__END__
Dave Jacoby
Dave Jacoby’s solution uses Cwd‘s abs_path function to get the absolute path of the script first:
use Cwd qw{abs_path};
my $file = abs_path($0);
if ( -f $file && open my $fh, '<', $file ) {
print join '', <$fh>;
}
From there, Dave does some error checking and uses the three-argument open, which is always a good idea. He prints the contents of the file with join '', <$fh>, which slurps the entire contents into a list which is then fed to join.
Blog › Challenge 45: Cyphers and Quines
Duane Powell
Duane Powell’s solution also makes a system call to cat(1) to print the contents:
system("cat $0");
The same comments I made to Cristina’s use of the single-argument system apply here; system cat => $0 is preferable.
Duncan C. White
Duncan C. White’s solution uses $0 to obtain the script’s filename, and loops through the lines:
open( my $fh, '<', $0 ) || die "can't read $0\n";
while( <$fh> )
{
chomp;
say;
}
E. Choroba
E. Choroba’s solution is another Perl hacker who submitted a full quine:
$_=q!print'$_=q*'.$_.'*;';s/\52/\41/g;print!;print'$_=q!'.$_.'!;';s/\52/\41/g;print
This one again uses the trick of quoting operators to embed a copy of the source, and munging those quoting characters so they are escaped or output as needed. You might think tr/*/!/ would work, but it would transmute its own arguments in the quoted code, which is why the character codes in s/\52/\42/g are necessary.
According to Choroba’s blog, this is a quine he came up with, entirely of his own invention, when he started programming Perl, and has tweaked it over the years into the version you see now.
Covering all the bases, he submitted a file reading version as well:
seek *DATA, 0, 0;
print <DATA>
__DATA__
This one uses the DATA filehandle in a similar way as we saw with Dave Cross’ solution, above.
Blog › Perl Weekly Challenge 045: Square Secret Code & Source Dumper
Jaldhar H. Vyas
Jaldhar H. Vyas’ solution reads its own source file in slurpy fashion, and uses English to aid comprehension:
use English qw/ -no_match_vars /;
open my $fh, '<', $PROGRAM_NAME or die "$OS_ERROR\n";
local $RS = undef;
print <$fh>;
English, a core module, adds plain English aliases for most of Perl’s punctuation variables, and manages to use three of them in just two lines of code:
- ›
$PROGRAM_NAMEis$0, the script’s filename - ›
$OS_ERRORis$!, errno error value (or description) - ›
$RSis$/, the input record separator, usually newline
Blog › Perl Weekly Challenge - Week 45
Javier Luque
Javier Luque’s solution reads the file in $0, with UTF-8 encoding for good measure:
open(my $fh, '<:encoding(UTF-8)', $0) || die "$@";
while (my $line = <$fh>) {
print $line;
};
Blog › PERL WEEKLY CHALLENGE – 045 – Perl Weekly Challenge
Laurent Rosenfeld
Laurent Rosenfeld’s solution is another example of reading one’s own source file via $0:
my $progr = "./$0";
open my $IN, "<", $progr or die "Unable to open $progr $!";
print while <$IN>;
close $IN;
Blog › Perl Weekly Challenge 45: Square Secret Code and Source Dumper
Maxim Kolodyazhny
Maxim Kolodyazhny’s solution reads its own source file. You know those two-argument open calls I’ve been talking about? How about a one-argument open!
use strict;
use warnings;
open 0 and print <0>;
This might require a bit of explanation if you’ve never encountered a one-argument open. First, it’s important to know that there is no special magic with “0” going on, here. Normally open requires at least two arguments. The two-argument open expects a filehandle, and an expression containing the filename.
When open is given just one argument, though, Perl takes the filename from the package scalar with the same name as the filehandle. In this case that scalar is $0, which is of course the script filename. After that, the print <0> part is just a normal read from the filehandle glob named “0” created with open.
Don’t believe this works as I’ve described it? Try it with a different name:
$PROG = "$0";
open PROG and print <PROG>
Then make the first line a lexical: my $PROG = "$0" and now it doesn’t work. In fact, that’s part of the reason we avoid bareword scalars these days; they only work with package globals, so it’s not possible to give them lexical scope.
Nazareno Delucca
Nazareno Delucca’s solution uses the __FILE__ function introduced in Perl 5.16 to get the filename:
open(my $fh, "<", __FILE__) || die "Couldn't open $0 for reading because: $! ";
print <$fh>;
close($fh);
Rage311
Rage311’s solution reads the file in $0, complete with error handling and the three-argument open:
die "Unable to open file: $!" unless
open my $fh, '<', $0;
print while <$fh>;
Roger Bell West
Roger Bell West’s solution eschews all modern Perl contrivances for the following concise solution:
open F,$0;
print <F>;
Ruben Westerberg
Ruben Westerberg’s solution shows that those modern features can look pretty, too:
open my $f,"<",$0;
print $_ for ( <$f> );
Ryan Thompson
I submitted three solutions this week, to showcase three different and progressively more difficult ways this challenge could be solved.
First up—and I can’t believe I actually committed this—an empty file works as a valid script. This arguably meets the letter of the challenge, but probably not the spirit. All serious definitions of quines regard this as cheating, too.
So the next best thing is my own version of the source file reader:
open my $fh, '<', __FILE__;
print do { undef $/; <$fh> };
I opted to slurp <$fh> into a string, although I really didn’t need to.
But my third solution, finally, is a real quine. The source code is not really human readable, but you can see it here. It was, as it turns out, human writeable, although I wouldn’t recommend replicating my methods.
Its output, when fed to a terminal, is displayed just a bit differently:
When fed to diff, diff will happily compare the output—including all of the ANSI escape codes—and report no differences.
For a more human-readable introduction to what I did, I started with the following quine:
$_=q<"ANSI ART HERE";print"\$_=q<$_>;eval\n">;eval
As discussed in my blog, I do not claim to have invented this quine, as it’s pretty difficult to come up with a completely novel quine after all these years. Similar versions are rather ubiquitious in Perl quine discussions, due to how powerful the quoting operators are in Perl.
I then got to work with my amazing ANSI art skills, at the position shown. Maybe I could get rich selling signed prints.
Blog › Quine
Saif Ahmed
Saif Ahmed’s solution is another file read solution, with UTF-8 encoding:
open (my $fh, '<:encoding(UTF-8)', $0 ) ;
print while(<$fh>);
Ulrich Rieke
Ulrich Rieke’s solution reads the file via a filehandle glob:
open (FH , "< $0" ) or die "Can't open file $0!\n" ;
while ( <FH> ) {
print ;
}
close (FH) ;
Wanderdoc
Wanderdoc’s solution reads $0:
open my $in, "<", $0 or die "$!";
for ( <$in> ) {print $_;}
And that’s it! Although a lot of these solutions were quite similar, it’s amazing how much variation in style one can achieve in just two or three lines.
SEE ALSO
Blogs this week:
Great to see more people blogging again this week! I always enjoy reading them.
Adam Russell › Perl Fun
Arne Sommer › Square Dumper with Raku
Burkhard Nickels › Square Secret Code | Source Dumper
Dave Jacoby › Challenge 45: Cyphers and Quines
E. Choroba › Square Secret Code & Source Dumper
Jaldhar H. Vyas › Perl Weekly Challenge Week 45
Javier Luque › 045 – Perl Weekly Challenge
Laurent Rosenfeld › Square Secret Code and Source Dumper
Luca Ferrari › Encoded messages and self-source-code-printing
Ryan Thompson › Square Secret Code | Quine