#!/usr/bin/env perl
## inspired by https://perlmonks.org/?node_id=1223819
##      my old link to a junction post => https://perlmonks.org/?node_id=1178059
## found https://github.com/dagolden/Path-Tiny/issues/160 (which is where these functions came from)
##      added the -d and -l tests
use Path::Tiny;
use 5.010; # required to enable "state"

for my $p (glob('C:/Users/peter.jones/*'), glob('c:/users/Public/*') ) {
    print is_junction($p) ? "J" : " ";
    print -d($p) ? "d" : " ";
    print -l($p) ? "l" : " ";
    print f32attr($p);
    print isjunc($p) ? " j " : "   ";
    print " $p\n"
}

sub is_junction {
    my ($dir) = @_;
    state $last_parent;
    state $junction_by;
    my $path = path($dir);
    if (! $path->is_dir || $path->is_rootdir) {
        return 0;
    }
    if (! defined $last_parent || $path->parent ne $last_parent) {
        $junction_by = { map { $_ => 1 } list_junctions($path->parent) };
            use Data::Dumper; print Dumper $junction_by; no Data::Dumper;
        $last_parent = $path->parent;
    }
    return exists $junction_by->{$path->basename};
}

sub list_junctions {
    my ($dir) = @_;
    my $path = path($dir);
    if (! $path->is_dir) {
        return ();
    }
    my $cmd = sprintf 'dir /AL /B "%s" 2>&1', $path->canonpath;
    my @lines = `$cmd`;
    chomp @lines;
    if ($? >> 8) {
        if ($lines[0] eq 'File Not Found') {
            return ();
        } else {
            die "Failed to execute: $cmd";
        }
    }
    return @lines;
}


#### https://metacpan.org/pod/Win32API::File
use Win32API::File qw'GetFileAttributes :FILE_ATTRIBUTE_';
sub isjunc {
    return GetFileAttributes($_[0]) & FILE_ATTRIBUTE_REPARSE_POINT
    #return (GetFileAttributes($_[0]) & FILE_ATTRIBUTE_REPARSE_POINT == FILE_ATTRIBUTE_REPARSE_POINT) ? 1 : 0;
}

sub f32attr {
    my $arg = shift;
    my $uAttrs = GetFileAttributes( $arg );
    $uAttrs==INVALID_FILE_ATTRIBUTES and die "INVALIDE FILE ATTRIBUTES";
    my $ret = '<';
    $ret .= $uAttrs&FILE_ATTRIBUTE_ARCHIVE              ? 'A' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_COMPRESSED           ? 'C' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_DEVICE               ? 'D' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_DIRECTORY            ? 'd' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_ENCRYPTED            ? 'E' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_HIDDEN               ? 'H' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_NORMAL               ? 'N' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_NOT_CONTENT_INDEXED  ? '!' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_OFFLINE              ? 'O' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_READONLY             ? 'R' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_REPARSE_POINT        ? 'J' : ' ';    # Yes, the reparse point agrees with the Path::Tiny/160 `dir /AL` results
    $ret .= $uAttrs&FILE_ATTRIBUTE_SPARSE_FILE          ? 'S' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_SYSTEM               ? 'Y' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_TEMPORARY            ? 'T' : ' ';
    $ret .= '>';
    return $ret;
}