[Israel.pm] Case Study: Removing all Periods ("."'s) but the Last

Shlomi Fish shlomif at iglu.org.il
Mon Dec 6 08:45:18 PST 2004


I've been on FreeNode's #perl channel one day when someone asked how to remove 
all periods from a string except the last one. So for example 
"this.is.a.file.txt" will become "thisisafile.txt". I gave him some 
solutions, and he eventually wanted to use the one called "sexeger" (see 
below).

However, this interested me, and so today I wrote as many solutions to this 
problem as I could come up with. Here is the file with all the 
implementations in all of its glory, with tests and everything.

I'll accept any more solutions, or ideas on how to improve the existing ones, 
or comments in general.

#!/usr/bin/perl -w

# This file implements various function to remove all periods ("."'s) except
# the last from a string.

use strict;

use Test::More tests => 63;

sub via_split
{
    my $s = shift;
    my @components = split(/\./, $s, -1);
    if (@components == 1)
    {
        return $s;
    }
    my $last = pop(@components);
    return join("", @components) . "." . $last;
}

sub sexeger
{
    my $s = shift;
    $s=reverse($s);
    my $c = 0;
    $s=~s!\.!($c++)?"":"."!ge;
    return reverse($s);
}

sub two_parts
{
    my $s = shift;
    if ($s =~ /^(.*)\.([^\.]*)$/)
    {
        my ($l, $r) = ($1, $2);
        $l =~ tr/.//d;
        return "$l.$r";
    }
    else
    {
        return $s;
    }
}

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

sub count_and_replace
{
    my $s = shift;
    my $count = (my @a = ($s =~ /\./g));
    $s =~ s/\./(--$count)?"":"."/ge;
    return $s;
}

sub elim_last
{
    my $s = shift;
    my $non_occur = "\x{1}" . ("\0" x length($s)) . "\x{1}";
    $s =~ s/\.([^\.]*)$/$non_occur$1/;
    $s =~ tr/.//d;
    $s =~ s!$non_occur!.!;
    return $s;
}

sub rindex
{
    my $s = shift;
    substr($s, 0, rindex($s, ".")) =~ tr/.//d;
    return $s;
}

my @funcs = (qw(via_split sexeger two_parts look_ahead count_and_replace),
    qw(elim_last rindex));

# This should be TEST * $NUM_TESTS * $NUM_FUNCS
# $NUM_TESTS == 9
# TEST*9*7
foreach my $f (@funcs)
{
    my $ref = eval ("\\&$f");
    is($ref->("hello.world.txt"), "helloworld.txt", "$f - simple"); # 1
    is($ref->("hello-there"), "hello-there", "$f - zero periods"); # 2
    is($ref->("hello..too.pl"), "hellotoo.pl", "$f - double"); # 3
    is($ref->("magna..carta"), "magna.carta", "$f - double at end"); # 4
    is($ref->("the-more-the-merrier.jpg"), 
       "the-more-the-merrier.jpg", "$f - one period"); # 5
    is($ref->("hello."), "hello.", "$f - one period at end"); # 6
    is($ref->("perl.txt."), "perltxt.", "$f - period at end"); # 7
    is($ref->(".yes"), ".yes", "$f - one period at start"); # 8
    is($ref->(".yes.txt"), "yes.txt", "$f - period at start"); # 9
}

Regards,

	Shlomi Fish

---------------------------------------------------------------------
Shlomi Fish      shlomif at iglu.org.il
Homepage:        http://www.shlomifish.org/

Knuth is not God! It took him two days to build the Roman Empire.



More information about the Perl mailing list