in reply to getting a few simple scripts to work on windows

the first one is because of the magic that windows uses for the "My Documents" and similar folders -- junctions. I have a couple links that I store in my scratchpad about junctions: Re^3: how to handle the warnings in a find statement and <JUNCTION>; how to recognize ... And the code that is in the private repo link (sorry, that's there for my benefit, not anyone else's) can be found in the spoiler. Please note: I make no guarantees about this code.

#!/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 wh
+ere 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::Dump
+er;
        $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` r
+esults
    $ret .= $uAttrs&FILE_ATTRIBUTE_SPARSE_FILE          ? 'S' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_SYSTEM               ? 'Y' : ' ';
    $ret .= $uAttrs&FILE_ATTRIBUTE_TEMPORARY            ? 'T' : ' ';
    $ret .= '>';
    return $ret;
}

[download]

edit: I guess I didn't say how you should update your code... when I was exploring junctions the end of last year, it was to get rid of a similar error in my backup-from-pc-to-NAS script that I run at home; basically, I just check beforehand if the path is a junction (using either isjunc or is_junction -- I forget which I chose, and I'm not at home right now to check), and if it is, I don't try to process that folder. (IIRC, "My Documents" is really "Documents", so when it follows the real one, everything works okay; but that's a bit vague. I may look things up when I get home.) /edit

for the second question, use the LIST version of system(). If you want your script to continue without waiting for notepad++, use the system(1,...) syntax mentioned in perlport: perl -e "my $f='readme.txt'; system(1, 'c:\usr\local\apps\notepad++\notepad++.exe', $f)"

Replies are listed 'Best First'.
Re^2: getting a few simple scripts to work on windows
by Aldebaran (Curate) on Aug 14, 2019 at 15:41 UTC

    Thanks for your pithy reply, pryrt. I wish my reply could be so concise, but I'm still grabbing at straws. I try to save the vertical space for responders so will put the rest of what I have that pertains between readmore tags:

    Read more... (7 kB)

    Thanks for your comment

[reply]
[d/l]
[select]

      Okay, since you're asking questions, I'm trying to re-familiarize myself with it; that was all Oct of last year, and I hadn't thought about it since. ...

      The isjunc() and is_junction() are effectively two different ways for testing for whether a file is a junction. The isjunc() is a much simpler way of doing it -- it doesn't require spawning to the shell's dir /AL /B, and is (presumably) much more efficient. If you comment out just the f32attr call in my example script, you can see that is_junction (which results in a capital J in the printout) and isjunc (which results in a lower-case j) both trigger on the same files. Basically, with that, I was trying to prove to myself that isjunc really found all the junctions. (I knew that windows dir should, so was comparing it as "golden" to my "experimental" isjunc.) Specific answers to your questions in the readmore...

      Read more... (3 kB)
[reply]
[d/l]
[select]

        Your recollections and posted code check out. Bravo! I consider this a strong result for untangling a windows 10 machine:

        #!/usr/bin/perl
use warnings;
use 5.016;
## File::Find for windows, handling junctions
## https://perlmonks.org/?node_id=11104464
use File::Find;
use Cwd;
## https://metacpan.org/pod/Win32API::File
use Win32API::File qw'GetFileAttributes :FILE_ATTRIBUTE_';
use File::Basename;

my $current = cwd;
my $VERBOSE = 1;

find( \&pm_beneath, $current, );
say "--------------";
find( \&pm_beneath, "C:/Strawberry", );

sub isjunc {
  return GetFileAttributes( $_[0] ) & FILE_ATTRIBUTE_REPARSE_POINT;
}

sub pm_beneath {
  if (-d) {    # junctions show up as TRUE for `-d`
    if ( isjunc($File::Find::name) ) {

      # if junction, don't bother creating checking destination direct
+ory existence,
      # and don't try to recurse into it
      $File::Find::prune = 1;
      printf( "[%s] %-12s'%s'\n",
        scalar(localtime), "JUNCTION:", $File::Find::name )
        if ($VERBOSE);
      return;
    }

  }

  my $basename = basename($File::Find::name);
  return unless $basename =~ /\.pm$/;
  print "$File::Find::name\n";
  my $access_age = -A $basename;
  print "    $basename\n";
  printf "access age in days: %.2f\n", $access_age;
}

__END__

        [download]
        (File::Find) just prints a warning, but otherwise cannot do anything with the junction -- but other than that, it works fine in windows... and even with junctions, it just gives a warning, so it continues to effectively work.

        I understand and agree now. The other script I presented in the original post is still ailing:

        Read more... (4 kB)

        Thanks for comments,

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom