Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Re: File existance check failure

by Festus Hagen (Novice)
on Nov 17, 2012 at 11:35 UTC ( #1004304=note: print w/replies, xml ) Need Help??


in reply to File existance check failure

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 : )_~

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1004304]
help
Chatterbox?
[Discipulus]: congrats choroba!
Discipulus shutdown and logoff seem untrappable by Perl on win. But it is in Cygwin. but i cannot switch to it
[choroba]: It has the widest rear seats space available in the same price category - needed for the 3 kids.
Discipulus families growth is related to price of cars nowadays..
[choroba]: price of anything, unfortunately

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (12)
As of 2017-01-17 09:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you watch meteor showers?




    Results (154 votes). Check out past polls.