RogerBW's Blog

I've been doing the Perl Weekly Challenges. This one dealt with expanding braces and calling C functions.

Write a script to demonstrate brace expansion. For example, script would take command line argument Perl {Daily,Weekly,Monthly,Yearly} Challenge and should expand it and print like below:

Perl Daily Challenge

Perl Weekly Challenge

Perl Monthly Challenge

Perl Yearly Challenge

Of course, there might be multiple braces in a single input, for example {Perl,Postscript} {Daily,Weekly,Monthly,Yearly} Challenge. In this case I feel it's appropriate to go through each of them separately, so that in this case the output would be eight lines.

First, I break down the input to find braced sections. These are turned into array references within @e. %r holds the maximum value for each variable section (i.e. number of alternatives minus 1). Non-variable sections remain as plain text in @e.

foreach my $text (@ARGV) {
  my %r;
  my @e=split /(\{.*?\})/,$text;
  foreach my $i (0..$#e) {
    if ($e[$i] =~ /^\{(.*)\}$/) {
      my @b=split ',',$1;
      $r{$i}=$#b;
      $e[$i]=\@b;
    }
  }

Set the accumulators to 0. We will iterate through each valid combination.

  my %a=map {$_ => 0} keys %r;
 OUTER:
  while (1) {

First, produce the current output, choosing the appropriate alternative for each variable section. (If there are no variable sections, this will still work.)

    my @out;
    foreach my $k (0..$#e) {
      if (exists $r{$k}) {
        push @out,$e[$k][$a{$k}];
      } else {
        push @out,$e[$k];
      }
    }
    print join('',@out),"\n";

Generate a list of the indices of the variable sections. If there aren't any, our job is done and we can exit now.

    my @kl=sort keys %a;
    unless (@kl) {
      last;
    }

Increment the first accumulator. If it's exceeded its maximum value, reset it and go on to the next one. If we run out of accumulators, we've finished.

    my $i=0;
    while (1) {
      $a{$kl[$i]}++;
      if ($a{$kl[$i]} > $r{$kl[$i]}) {
        $a{$kl[$i]}=0;
        $i++;
        if ($i > $#kl) {
          last OUTER;
        }
      } else {
        last;
      }
    }
  }
}

I didn't do this in Perl6, because I'm still getting the hang of how complex data structures work there.

Write a script to demonstrate calling a C function. It could be any user defined or standard C function.

This is notoriously fiddly in Perl (not to mention that all the easily-found examples assume you'll be writing your own C functions, not using an existing library), but I ended up finding a nice simple module to do it.

use FFI::Raw;

my $cpf=FFI::Raw->new('libc.so.6','printf',
                      FFI::Raw::int,
                      FFI::Raw::str,
                      FFI::Raw::str,
                        );

$cpf->call("%s\n",'a string passed from perl5');

This is something that Perl6 seems to have got right:

use NativeCall;

our sub cpf(Str, Str --> int32) is native(sub{'libc.so.6'}) is symbol('printf') { * }

cpf("%s\n",'a string passed from perl6');