Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

File existance check failure

by Festus Hagen (Novice)
on Nov 10, 2012 at 20:18 UTC ( #1003275=perlquestion: print w/ replies, xml ) Need Help??
Festus Hagen has asked for the wisdom of the Perl Monks concerning the following question:

Hey y'all

Seeking wisdom of those that are wiser then I in the Perl world!

To skip the fmi ramble GOTO _MEAT_

A project I work on hasn't been taught how to wipe up after itself and always leaves a mess behind. Very annoying! (unfortunately that responsibility falls on a deaf (and possibly dumb) individual)

So I whipped up batch file for Win and a script for *nix, then got the brainy idea to multi platform it with Perl, considering Perl is required on the systems anyways it'll always be there!

However I find a peculiar difference that prevents me at my current Perl level to get past.

*nix Perl version 5.16.0
Strawberry Perl version 5.16.1
OS's various!

_MEAT_

It appears "-f" fails with wildcards, should it ??
It's always NOT found even though files meeting the criteria are in fact there.

I have tested the strings for line feeds and the like, they look perf.

Example:

#!/usr/bin/perl use strict; use warnings; # File location: projects/myproj/ # File names: myproj.a, myproj_c.a # This script is in the 'projects' directory. my $Element = 'myproj/*.a'; # Actual use is like: # next if not (-f "$Element"); # Test use: if (-f "$Element") { print "Found!\n"; } else { print "NOT Found!\n"; }

# FreeBSD script works ... #!/bin/sh Element='myproj/*.a' if [ -f "$Element" ]; then echo Found! else echo NOT Found! fi

rem Windows batch (cmd) works ... @echo off if exist "myproj\*.a" ( echo Found! ) else ( echo NOT Found! )

Ideas ??
Workarounds ??

Thanks all

-Enjoy
fh : )_~

Comment on File existance check failure
Select or Download Code
Re: File existance check failure
by toolic (Chancellor) on Nov 10, 2012 at 20:59 UTC
    There is nothing in the file test documentation to indicate that it supports wilcard expansion. You can use glob. Something like:
    use warnings; use strict; for (glob '*.a') { if (-f $_) { print "file $_ exists\n"; } }

    UPDATE: Fixed typo (thanks 2teez)

      Much Thanks.

      With that I brewed the following:

      sub fexist($) { my $str = shift; for (glob qq("$str")) { return 1 if -e "$_"; } return 0; }

      However I have use for the Link, Directory, File result so:

      sub fexist($) { my $str = shift; for (glob qq("$str")) { return 3 if -l "$_"; return 2 if -d "$_"; return 1 if -f "$_"; } return 0; }

      Critiques ??
      Comments ??
      Suggestions ??
      Improvements ??

      Thanks

      -Enjoy
      fh : )_~

        Critiques ??

        As a general rule, avoid subroutine prototypes unless you have good reason for them. (See, e.g., Far More than Everything You've Ever Wanted to Know about Prototypes in Perl -- by Tom Christiansen.) With the prototype removed, and employing some Perl idioms, sub fexist can be simplified to:

        sub fexist { for (glob $_[0]) { return 3 if -l; return 2 if -d; return 1 if -f; } return 0; }
        Improvements ??

        Since the aim is to cleanup unwanted files, perhaps it would be better to integrate sub fexist with the cleanup code? Something like this:

        use v5.14; ... sub cleanup { for (glob $_[0]) { cleanup_link($_) when -l; cleanup_dir ($_) when -d; cleanup_file($_) when -f; } }

        Hope that helps,

        Athanasius <°(((><contra mundum

        One more small detail, which probably won't be significant unless you happen to be scanning very large quantities of files, links and/or directories: you can use the special operand "_" (the underscore character) on the file-test operators, in order to use the file stat information from the previous stat call (so you don't do repeated stat calls on the same file). Adapting the most recent suggestion from Athanasius:
        sub cleanup { for (glob $_[0]) { cleanup_link($_) when -l; cleanup_dir ($_) when -d _; cleanup_file($_) when -f _; } }
Re: File existance check failure
by itnomad (Scribe) on Nov 10, 2012 at 22:39 UTC

    I think to do this successfully you will have to use opendir with the path and then use readdir to put the contents in an array. Then loop through the array testing with -f. Check 'perldoc -f opendir'. You will have to add the path back in front of the filename when doing filename check.

    Nevermind. I misunderstood what you were trying to do.

Re: File existance check failure
by Festus Hagen (Novice) on Nov 17, 2012 at 11:35 UTC
    Thanks y'all

    I have chosen to stick with the simple fexist sub:

    sub fexist { my $str = shift; # newMeth REMOVE! # for (glob qq("$_[0]")) { # newMeth CHANGE! for (glob qq("$str")) { return 3 if -l; return 2 if -d _; return 1 if -f _; } return 0; }
    Next time I'm working with it I'll make the noted changes and test. (and more likely)

    The quoting is the result of hacking to get it to work with spacy names.
    I believe it still fails on spacy wildcard names, got real sick and had to put it all aside for now and take care of myself.

    Current script, reads a file list of file/directory names and deletes them, Everything after a : and blank lines are ignored.

    #!/usr/bin/perl # fh :)_~ # do with as you wish ... # Just don't blame me if it teaches your computer to smoke! use strict; use warnings; use File::Basename; my $Prog = "cmake -E"; my $RmDir = "remove_directory"; my $RmFile = "remove -f"; my $Cmd; sub fexist { my $str = shift; # newMeth REMOVE! # for (glob qq("$_[0]")) { # newMeth ADD! for (glob qq("$str")) { return 3 if -l; return 2 if -d _; return 1 if -f _; } return 0; } sub main { my $dir = dirname(__FILE__); open(FILE, "$dir/clean.list") or die("Unable to open file: $dir/clea +n.list."); my @data = <FILE>; close(FILE); foreach my $line (@data) { next if $line =~ /^$/; # skip blank lines next if $line =~ /:/; # skip lines with a ':' (colon) in them chomp $line; next if not my $rval = fexist $line; $Cmd = join " ", $Prog, ($rval eq 2) ? $RmDir : $RmFile; print "Deleting $line"; system("$Cmd \"$line\""); print " ... Deleted!" unless fexist $line; print "\n"; } } main();

    Example clean.list

    : Everything after a : and blank lines are ignored : install_manifest.txt cmake_install.cmake cmake_uninstall.cmake CMakeCache.txt Makefile CMakeFiles

    Thanks

    -Enjoy
    fh : )_~

Re: File existance check failure
by Festus Hagen (Novice) on Nov 17, 2012 at 17:22 UTC
    Got restless ...

    Ok, Took the advice and made a few changes ... :)

    I could not get the "when" usage to work!
    Running at least Perl v5.16.0
    Tried as described in perlsys

    So the latest version.

    #!/usr/bin/perl use strict; use warnings; # ** # * BCE 42. # * Read a list of file names from a file and delete them. # ** # # ** # * It is what it is, you can do with it as you please. [with respect +, leave the credits] # * # * Just don't blame me if it teaches your computer to smoke! # * # * -Enjoy # * fh :)_~ # ** # # ** Example clean.list # * : Everything after a : and blank lines are ignored # * : Wildcards are valid, be careful. # * : # * # * install_manifest.txt # * cmake_install.cmake # * CMakeCache* # * examples/*.a # ** use File::Basename; my $Prog = "cmake -E"; my $RmDir = "remove_directory"; my $RmFile = "remove -f"; my $RmLink = "remove -f"; sub runCommand { return `$Prog $_[0] \"$_[1]\"` if $_[0] && $_[1]; return -1; } sub cleanup_Link # non Win32 { print "Deleting Link: $_[0]"; runCommand($RmLink, $_[0]); print " ... Deleted!" if not -l $_[0]; print "\n"; } sub cleanup_Dir { print "Deleting Dir : $_[0]"; runCommand($RmDir, $_[0]); print " ... Deleted!" if not -d $_[0]; print "\n"; } sub cleanup_File { print "Deleting File: $_[0]"; runCommand($RmFile, $_[0]); print " ... Deleted!" if not -f $_[0]; print "\n"; } sub cleanup { for (glob qq("$_[0]")) { cleanup_Link($_) if -l; # non Win32 cleanup_Dir ($_) if -d _; cleanup_File($_) if -f _; } } sub main { my $Dir = dirname(__FILE__); open(FILE, "$Dir/clean.list") or die("Unable to open file: $Dir/cl +ean.list."); my @Data = <FILE>; close(FILE); foreach my $line (@Data) { next if $line =~ /^$/; # skip blank lines next if $line =~ /:/; # skip comment lines with ':' (colon) +in them chomp $line; # trim the newline cleanup($line); } } main();

    Critiques ??
    Comments ??
    Suggestions ??
    Improvements ??

    Thanks

    -Enjoy
    fh : )_~

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1003275]
Approved by toolic
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (4)
As of 2014-08-01 10:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Who would be the most fun to work for?















    Results (4 votes), past polls