Norman Zhang wrote:
> Hi,
> 
> Randy W. Sims wrote:
>> Here is a routine I wrote a while back originally for scanning
>> plugins. I've pruned it down (It could probably be much simpler as
>> this routine does a breadth first scan which requires more
>> bookkeeping, but I'm too lazy to fix it...), and it appears to work
>> with directories containing spaces. Let me know if this gets you any
>> closer to a solution. 
> 
> Thanks. Your script prints out everything in the current folder
> including spaces. May I how to incorporate this into checking/deleting
> files/folders with mtime +30? BTW, is it possible to skip the first
> level of the sub_folders/ under the share_folder/.
> 
> e.g.,
> 
> /share_folder/user_a
> /share_folder/user_b
> ...
> 
> As user_x are created 30 days ago. Can I subsititute something for
> the . in scan_dir('.')?
> 
> Regards,
> Norman
        If I understand you, you are asking to leave files at user_a or _b and but any 
subdirs under that then delete the files at that level and higher.  That is:
> /share_folder/user_a
        /share_folder/user_a/txt1
        /share_folder/user_a/txt2
        /share_folder/user_a/dir1/txt1
        /share_folder/user_a/dir1/txt2
        /share_folder/user_a/dir2/txt3
        /share_folder/user_a/dir2/txt4

        In this case only those files located at dir1 or dir2 would be eligible for 
removing. 

        Another point is you state files/folders. What I have seen so far only handles 
the files.  You would ave to either keep a count of number of entries under a 
directory and subtract out when you delete a file. It becomes even more convoluted 
when you could have another subdirectory under a subdirectory.

        Here is the basic script already done, but I attempted to handle level of the 
delete using 'tr' and counting the number of separators in your base and then if the 
total number ws greater than 2 then the file could be deleted if > 30 days and 
separator count greater 2.  So here is one way to give it a shot. I am running under 
xp prof. Without the tests, I had 625 files to delete while with the test that the 
number of slashes had to be greater than 2, then dropped to 423.

        Note: Does not address empty subdirectories!!

use strict;
use warnings;

use File::Spec;

my @dirstack;
my $MyDir ;
my $MyFilesToDel = 0;
my $MyBaseSep = 0;

while ( defined $ARGV[0] ) {
    $MyDir = $ARGV[0];
    $MyBaseSep = ($MyDir =~ tr!\\!! );
    
    scan_dir($MyDir);
    shift(@ARGV);
 }
printf "Files to Delete: %6d\n",
                                $MyFilesToDel;
#
##
### Start of Subroutines
##
#

sub scan_dir {
  my $dir = shift;
  return unless -d $dir;

  my @subdirs;
  printf "MyBaseSep: %2d\n",
                                  $MyBaseSep;

  opendir DIR, $dir or die "Can't open directory ($dir): $!\n";
  my $MyModTime;
  my $MyTotSlashes ;
  while (my $file = readdir DIR) {
    next if $file eq File::Spec->curdir()
         or $file eq File::Spec->updir();

    my $path = File::Spec->catfile($dir, $file);
    if (-d $path) {
      push @subdirs, $file;
      next;
    } else {
      $MyModTime = -M $path;
      $MyTotSlashes = ( $path =~ tr/\\// );
      
      $MyTotSlashes -= $MyBaseSep;
      if ( ($MyModTime > 30) && ($MyTotSlashes > 2) ) {
          printf "%5.1f: %s\n", 
                                $MyModTime
                                $path;
          
#
# Here is where a delete would go, but you had better understand what is happening 
before it is tried.
#
          if ( ! unlink($path) ) {
             printf "Unable to delete file $path\n";
           }else {
              $MyFilesToDel++;
           }
       }
    }
  }
  closedir DIR;

  foreach my $subdir (@subdirs) {
    push @dirstack, $subdir;
    scan_dir(File::Spec->catdir($dir, $subdir));
    pop  @dirstack;
  }
}

      Thanks.

Wags ;)
Int: 9-8-002-2224
Ext: 408-323-4225x2224



**********************************************************
This message contains information that is confidential
and proprietary to FedEx Freight or its affiliates.
It is intended only for the recipient named and for
the express purpose(s) described therein.
Any other use is prohibited.
****************************************************************


--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>


Reply via email to