[SPOILER] Re: 'Easy' Quiz #2005-2 (Perl... and Pascal)

Most of my efforts are similar to ones already posted.

Just to nitpick, however, note that nothing in the 'spec' said that:
(1) the string passed to the function must be non-empty; or
(2) the string cannot contain embedded new lines.

Concerning (2), and taking a submitted example at random:

sub lookahead {
   my $s = shift;
   $s =~ s/\.(?=.*\.)//g;
   return $s;
}

Feed this with:

print lookahead( "a.b.\nc.d.\ne.f.");

and you will get:
ab.
cd.
ef.

instead of:
ab
cd
ef.

Of course, the fix here is easy (one character to add).


Anyway, for fun (?), since they're making me learn Pascal (at my age!), 
and since people seem to be posting code in more and more languages, 
I include a Pascal solution. First, the Perl translation:

sub undot_Pascal_style {
   return '' unless my $str = shift; # Shut warnings up for empty strings
   my $seen;
   my $new_str = '';
   for ( my $i = length ( $str ) - 1; $i >= 0; $i-- ) {
      if ( substr ( $str, $i, 1 ) eq '.') {
         if ( $seen ) { next; }
         else { $seen++; }
      }
      $new_str = substr ( $str, $i, 1 ) . $new_str;
   }
   return $new_str;
}

Still Perl, same algortihm, but using chop (I've become fond of chop 
recently :-) and replacing the ugly nested if/elses with an even uglier 
single line:

sub undot2 {
   return '' unless my $str = shift;
   my $seen;
   my $new_str = '';
   while ( $str ) {
      my $char = chop $str;
      $char eq '.' and !$seen and $seen++ or next;
      $new_str = $char . $new_str;
   }
   return $new_str;
}

I've wrapped the Pascal function in a program, in the unlikely event that 
anyone should want to compile and test it :-).
I often wish that Perl allowed "$string[$i]" syntax, although of course that 
would conflict with "$array[$i]" (will this change with Perl 6?)

program strip_dots;

function undot (str: string): string;
var
   seen	   : boolean;
   new_str : string;
   i	   : integer;
begin
   seen := false;
   new_str := '';
   for i := length(str) downto 1 do
   begin;
      if str[i] = '.' then
	 if seen then continue
	 else seen := true;
   new_str := str[i] + new_str;
   end;
   undot := new_str;
end; { undot }


var
   my_str : string;
begin
   write('Enter a string: ');
   readln(my_str);
   writeln(undot(my_str));
end.


dave