[Solution and Test] removing periods

First the current version of my test script:

#!/usr/bin/perl

%Tests = ('test.1.2.3' => 'test12.3',
      'test.123'   => 'test.123',
      '.test'      => '.test',
      'test.'      => 'test.',
      'test...123' => 'test.123',
      '.test.123'  => 'test.123',
      '.test.123.' => 'test123.');

$DO_FILE = shift @ARGV;
do $DO_FILE;

@INPUTS = sort keys %Tests;
@OUTPUTS = @Tests{@INPUTS};

print "$DO_FILE:\n";

for $name (sort keys %::) {
  next unless *{$name}{CODE};
  printf("%2d %10s: ", ++$solcount, $name);

  @errors = ();
  while (($IN, $OUT) = each %Tests) {
    $run_output = *{$name}{CODE}->($IN);
    print ( $run_output eq $OUT ? ' +' : ' -' );
    push @errors, "  >>> $IN ==> $run_output\n"
    if $run_output ne $OUT;
  }
  print "\n", @errors;
}

__END__


And now, my solutions:

#!perl

if (@ARGV) {
  for $name (sort keys %::) {
    next unless *{$name}{CODE};
    printf("%2d %10s:", ++$solcount, $name);
   
    for $Input (@ARGV) {
      print "  ",  *{$name}{CODE}->($Input);
    }
    print "\n";
  }
}


sub regexp01 {$_=$_[0];         
s/\.(?=.*\.)//g;                            $_}

sub regexp02 {$_=$_[0]; 1 while 
s/\.(.*?\.)/$1/;                            $_}

sub regexp03 {$_=$_[0]; s{(.*)\.([^.]*)$}{ ($x=$1)=~tr/.//d; "$x.$2" 
}e;    $_}

sub regexp04 {$_=$_[0]; s/\.// while 
/\..*\./;                              $_}

sub regexp05 {$_=$_[0]; s/\.// while y/.// > 
1;                             $_}

sub regexp06 {$_=$_[0]; s/\.// while s/\././g > 
1;                          $_}

sub regexp07 {$_=$_[0]; s/\.// while y///c -1 > 
y/.//c;                     $_}

sub regexp08 {$_=$_[0]; s/\.// while length() -1 > 
s/([^.])/$1/g;           $_}




sub split01 {
  @x=split /\./, "$_[0]\0";
  if (@x > 1) {
    $x[$#x] =~ s/\0$//;
    join('',@x[0..$#x-1]) . ".$x[$#x]";
  } else {
    $_[0];
  }
}

sub split02 {
  ($a,$b) = split(/\./, reverse($_[0]), 2);
  $b =~ s/\.//g;
  $b  ? scalar reverse "$a.$b"
      : $_[0];
}



sub index01 {
  $x = $_[0];
  $l = index($x,'.')+1;
  while(($c = index($x,'.',$l)) > 0) {
    substr($x, $l-1, 1, '');
    $l = $c;
  }
  $x;
}

sub index02 {
  $x = reverse $_[0];
  $f = index($x,'.')+1;
  while (($c = index($x,'.',$f)) > 0) {
    vec($x,$c,8) = 0;
  }
  $x =~ s/\0//g;
  scalar reverse $x;
}

sub index03 {
  $_ = $_[0];
  $l = rindex($_,'.');
  while (($c = index($_,'.')) < $l--) {
    substr($_,$c,1,'');
  }
  $_;
}



sub pack01 {
  @c = unpack('c*',$_[0]);
  @p = grep($c[$_] == 46, 0..$#c);
  pop @p;
  while (defined($c = pop @p)) {
    splice(@c,$c,1,);
  }
  pack('c*',@c);
}

sub pack02 {
  @g = @l = ();
  for (unpack('c*',$_[0])) {
    if ($_ == 46) {
      @l = @g;
    } else {
      push @g, $_;
    }
    push @l, $_;
  }
  pack('c*',@l);
}



sub mask01 {
  @m = (0xFF) x length($_[0]);
  $c = -1;
  while (($k = index($_[0],'.',$c+1)) >= 0) {
    @m[$c=$k] = 0;
  }
  @m[$c] = 0xFF;
  $_ = $_[0] & pack('C*',@m);
  s/\0//g;
  $_;
}


__END__