# /usr/bin/perl

# for a given path and directory, determine if given directory
# is the first (i.e., top-level) directory in the path.
# accepts win32 or *nix path separators.
# accepts directory names with embedded spaces.


use warnings;
use strict;


# '\' repeated 4 times in next string to compensate for
# subsequent double-quote-like interpolation.
my $seps = '\\\\/';  # possible path separator chars: win & *nix

# regexes to recognize parts of a path.  maybe a bit crude.
my $rx_path_sep = qr{  [$seps]  }xms;  # path separator
my $rx_dir_like = qr{ [^$seps]+ }xms;  # directory name

my @weird = ('', '\\', '/');  # extra weird strings for testing

# first DATA line is possible top-level directory names for testing.
my @dirs = (@weird, split ',', do { chomp(my $d = <DATA>); $d });

# all other DATA lines are paths for testing.
my @paths = (@weird, map { chomp;  split ',' } <DATA>);

# pre-compile directory names to regexes recognizing them
# as first (i.e., top-level) directory in a path.
my %toplevel = map {
    $_ =>                       # each possible dir paired with regex
    qr{ \A (?= $rx_dir_like)    # dir-like string is first
        \Q$_\E                  # and is the given dir
        (?: $rx_path_sep | \z)  # followed by sep or end of string
      }xms
    } @dirs;

# check all permutations.
for my $path (@paths) {
    for my $dir (@dirs) {
        printf qq(%10s begins '%s' \n), qq('$dir'), $path
            if $path =~ $toplevel{ $dir };
            # if $path =~ m{ \A (?= $rx_dir_like) \Q$dir\E
            #                (?: $rx_path_sep | \z)
            #              }xms;
        }
    }


__DATA__
abc,abcd,abcde,x,ab c,ab cd,a+b,foo
abc,abc\,abc/x,abcd,abcd/,abcd\x,abcde,abcde/,abcde/x
x,x/,x/abc,abc\abcd,abcd/abc,abc\abc,abc\abcd/abcde,abcde\abcd/abc
ab c,ab c\,ab c/abc,ab cd,ab cd\,ab cd\x,ab c/abc
ab cd\ab c,a+b,a+b/,a+b\abc,bar,bar\zot,\,/,\abc,/abc,\x,/x
/\,\/,/\x,\/x

##</code><code>##

     'abc' begins 'abc'
     'abc' begins 'abc\'
     'abc' begins 'abc/x'
    'abcd' begins 'abcd'
    'abcd' begins 'abcd/'
    'abcd' begins 'abcd\x'
   'abcde' begins 'abcde'
   'abcde' begins 'abcde/'
   'abcde' begins 'abcde/x'
       'x' begins 'x'
       'x' begins 'x/'
       'x' begins 'x/abc'
     'abc' begins 'abc\abcd'
    'abcd' begins 'abcd/abc'
     'abc' begins 'abc\abc'
     'abc' begins 'abc\abcd/abcde'
   'abcde' begins 'abcde\abcd/abc'
    'ab c' begins 'ab c'
    'ab c' begins 'ab c\'
    'ab c' begins 'ab c/abc'
   'ab cd' begins 'ab cd'
   'ab cd' begins 'ab cd\'
   'ab cd' begins 'ab cd\x'
    'ab c' begins 'ab c/abc'
   'ab cd' begins 'ab cd\ab c'
     'a+b' begins 'a+b'
     'a+b' begins 'a+b/'
     'a+b' begins 'a+b\abc'