DOS pattern matching, in Perl

dos_globs.pl

#!perl
use strict;
use warnings;

=pod

Match 8.3 filenames in the DOS way, from Raymond Chen

https://blogs.msdn.microsoft.com/oldnewthing/20071217-00/?p=24143

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 counts strings counting from zero.

=cut

while( <DATA> ) {
	chomp;

	my $glob = $_;

	my $dos_pattern = ' ' x 11;
	my $cursor = 0;

	while( m/(.)/g ) { # /g in scalar content remembers where it left off
		my $input = $1;
		last unless defined $input;

		if( $input eq '.' ) {
			substr( $dos_pattern, 8, 3, ' ' x 3 );
			$cursor = 8;
			next;
			}
		elsif( $input eq '*' ) {
			my $rest = 11 - $cursor;
			substr( $dos_pattern, $_, 1, '?' ) for ( $cursor .. 10 );
			$cursor = 11;
			next;
			}
		elsif( $cursor != 11 ) {
			substr( $dos_pattern, $cursor++, 1 ) = $input;
			}
		}

	printf "%-12s -> %12s\n", $glob, $dos_pattern;
	}

__END__
ABCD.TXT
ABCDEFGHIJK
A*B.TXT
*.*
*
*.TXT
.TXT