DOS pattern matching, in Perl 6

I rewrote my DOS pattern matching in Perl 6. There’s nothing particularly fancy here and I tried to keep it close to the version I wrote in Perl 5 and the way Raymond Chen presented it.

#!perl6

=begin pod

Match 8.3 filenames in the DOS way, from Raymond Chen

How did wildcards work in MS-DOS?
1. Start with eleven spaces and the cursor at position 1. 2. Read a character from the input. If the end of the input is reached, then stop. 3. If the next character in the input is a dot, then set positions 9, 10, and 11 to spaces, move the cursor to position 9, and go back to step 2. 4. If the next character in the input is an asterisk, then fill the rest of the pattern with question marks, move the cursor to position 12, and go back to step 2. (Yes, this is past the end of the pattern.) 5. If the cursor is not at position 12, copy the input character to the cursor position and advance the cursor. *: Remember that Perl 6 counts strings counting from zero. =end pod for $=finish.lines -> $line { my $dos_pattern = ' ' x 11; my $cursor = 0; for $line.split("", :skip-empty) -> $char { if $char eq '.' { $dos_pattern.substr-rw( 8, 3 ) = ' ' x 3; $cursor = 8; } elsif $char eq '*' { $dos_pattern.substr-rw( $_, 1 ) = '?' for $cursor .. 10; $cursor = 11; } elsif $cursor != 11 { $dos_pattern.substr-rw( $cursor++, 1 ) = $char; } } printf "%d: %12s -> %12s\n", $++, $line, $dos_pattern; } =finish ABCD.TXT ABCDEFGHIJK A*B.TXT *.* * *.TXT .TXT

I get the same output.

0:     ABCD.TXT ->  ABCD    TXT
1:  ABCDEFGHIJK ->  ABCDEFGHIJK
2:      A*B.TXT ->  A???????TXT
3:          *.* ->  ???????????
4:            * ->  ???????????
5:        *.TXT ->  ????????TXT
6:         .TXT ->          TXT

But let’s look at some differences.

I have $line.split("", :skip-empty). Splitting with an empty string creates empty elements at the beginning and end of the list, so I can add the :skip-empty.

There’s a chars method in the Str class, but it doesn’t return characters. It returns a count. The lines method, however, returns lines and not a count.

The Str class has several subst* methods that do slightly different things. The subset-rw provides the lvalue that I can assign to.

And, check out that anonymous variable in the printf line. Perl 6 has a feature that creates persistent state variables that are private to a statement. Don’t give the variable a name. $++ is a variable without a name that I post-increment. That’s pretty handy.

One comment

  1. # using ‘comb’ instead of ‘split’ and ‘when’ to match on $_ instead of ‘if’.

    for $=finish.lines -> $line {
    my $dos_pattern = ‘ ‘ x 11;
    my $cursor = 0;

    for $line.comb {
    when ‘.’ {
    $dos_pattern.substr-rw( 8, 3 ) = ‘ ‘ x 3;
    $cursor = 8;
    }
    when ‘*’ {
    $dos_pattern.substr-rw( $_, 1 ) = ‘?’ for $cursor .. 10;
    $cursor = 11;
    }
    when $cursor != 11 {
    $dos_pattern.substr-rw( $cursor++, 1 ) = $_;
    }
    }
    printf “%d: %12s -> %12s\n”, $++, $line, $dos_pattern;
    }

    # Seems to work 🙂

Leave a Reply

Your email address will not be published. Required fields are marked *