Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Recursive New Files Generation Thing

by cleen (Pilgrim)
on Jul 02, 2000 at 05:41 UTC ( [id://20778]=perlcraft: print w/replies, xml ) Need Help??

   1: #!/usr/bin/perl -w
   2: #
   3: # This peice of code recursivly searches directories
   4: # untill it hits the end of its tree for files that
   5: # have been modified in the last 10 days. In this case
   6: # Im only searching for mp3 files....but that can easily
   7: # be hacked out.
   8: #
   9: # It then symlinks the final directory of the tree from where
  10: # the file that was modified lately into your $ndir. It then
  11: # creates another text file that specifies exactly what files
  12: # were updated lately in that directory that was symlinked. Hrm
  13: # I think thats it...
  14: #
  15: # This was done so I could move my rips out of incoming/ 
  16: # as soon as they were put in there, and still know what
  17: # I had uploaded in the past few days. ( Previously I kept 
  18: # them in the incoming/ directory till I Made sure they were
  19: # all ok rips.
  20: #
  21: # Mark Thomas <mark@cidera.com>
  22: 
  23: use strict;
  24: 
  25: # This is the directory you want to begin your recursive search
  26: my $mdir        = "/home/ackers";
  27: 
  28: # Where the symlinks and files will be created.
  29: my $ndir        = "/home/ackers/new";
  30: 
  31: # These are directories you want excluded from the search.  
  32: my @dont        = ("$mdir/pub","$mdir/software","$mdir/stuff",
  33:                    "$mdir/.ssh","$mdir/.BitchX","$mdir/.ncftp",$ndir);
  34: 
  35: my($subdirz,@subdirs,$all,$wank,$orig,@moded_files,$m_files,$mdirs,$mfiles,%data,$newfd);
  36: 
  37: 
  38: # We first unlink all the current files in $ndir
  39: opendir (NEW, "$ndir") or die "$! $ndir dont exist!!!\n";
  40: foreach $newfd (readdir(NEW))
  41: {
  42: 
  43:         next if $newfd =~ /^\./; # We dont want "."'s and ".."'s
  44:         my $fullnewfd = "$ndir/$newfd";
  45:         unlink ($fullnewfd) or die "cant unlink $newfd!\n";
  46: 
  47: }
  48:                    
  49: 
  50: readdirz($mdir);
  51: 
  52: foreach $subdirz (@subdirs)
  53: {
  54: 
  55:         readdirz($subdirz);  
  56:  
  57: }
  58:         
  59: # we now have all our directories and sub's
  60: # in an array. Now to stat each file in those
  61: # dirs.
  62: foreach $all (@subdirs)
  63: {
  64:                         
  65:         opendir (SUBDIR, $all);
  66:                                 
  67:         foreach $wank (readdir(SUBDIR)) {
  68:                 $orig = $wank;
  69:                 $wank = "$all/$wank";
  70:  
  71:                 if (-f $wank)
  72:                 {
  73:                         next if $wank !~ /\.mp3/; # Next if the file isnt an mp3.
  74:                         my ($dev,$ino,$mode,$nlink,$uid,$gid,
  75:                             $rdev,$size,$atime,$mtime,$ctime,
  76:                             $blksize,$blocks) = stat $wank;
  77:                         my $curr = time;
  78:                         my $diff = $curr - $mtime;
  79:                         
  80:                         if ($diff <= 864000)
  81:                         {       
  82:                                 push(@moded_files, $wank);
  83:                         }
  84:                 }
  85:         } closedir(SUBDIR);
  86:                 
  87: }
  88: 
  89: # We now have a listing of modified or created
  90: # files within the last 10 days.
  91: foreach $m_files (@moded_files)
  92: {
  93:                         
  94:         # match everything up to last "/" then match
  95:         # everything after that and push our matches
  96:         # into a hash of lists.
  97:         $m_files =~ s/^(.*)\/(.*?\.*)$//g;
  98:         push @{$data{$1}},$2;
  99:  
 100: }               
 101: foreach $mdirs ( keys %data )
 102: {                       
 103: 
 104:         my $mdirs2 = $mdirs;
 105:         $mdirs2 =~ s/$mdir//g;     #- Pure athstetics, get rid of the $mdir
 106:         $mdirs2 =~ s/\// \\ /g;    #- turn /'s into \'s so we can symlink
 107:                                    #  and keep good organazation.
 108:         my $sym = "$ndir/$mdirs2"; #- need to make the mdir2 a full path for
 109:                                    #  the acctuall symlink.
 110:         symlink $mdirs, $sym;      #- the symlink :)
 111:         open(LISTING, ">$sym.updated.txt");
 112:         foreach $mfiles (@{$data{$mdirs}})
 113:         {
 114:                 print LISTING "\t$mfiles\n";
 115:         }
 116:         close(LISTING);
 117: }            
 118: sub readdirz
 119: {
 120:         
 121:         my($dir_to_read) = @_;
 122:         my($dirz,$excluded_dir);
 123:         opendir (DIR, "$dir_to_read") or print "DOH $! $dir_to_read\n";
 124:         foreach $dirz (readdir(DIR))
 125:         {
 126:                 $dirz = "$dir_to_read/$dirz" ;
 127:                 next if $dirz =~ /\./;
 128:                 # This is the part that makes it exclude directories
 129:                 # were not allowed to access defined in the @dont array
 130:                 # at the top.
 131:                 foreach $excluded_dir (@dont)
 132:                 {
 133:                         if ($dirz =~ /$excluded_dir/)
 134:                         {
 135:                                 $dirz = "";
 136:                         }
 137:                 }
 138:                 next if $dirz eq "";
 139:                 if (-d $dirz)
 140:                 {
 141:                         push (@subdirs, $dirz);
 142:                 }
 143:                 
 144:         } closedir(DIR);
 145:                 
 146: }

Replies are listed 'Best First'.
RE: Recursive New Files Generation Thing
by t0mas (Priest) on Jul 02, 2000 at 19:12 UTC
    Maybe you'll want to check for symlinks at
    if (-d $dirz)
    like
    if (-d $dirz && ! -l $dirz)
    to keep it from following the symlinks and maybe ending up in a infinite loop...
    Or port it to File::Find.

    Recursive things like this is a sensitive thing around here. ;)

    /brother t0mas
      Well, it makes the symlinks in $ndir and if you look at the @dont array, $ndir is included, heheh, I kinda forgot to mention in the comments that $ndir should stay in there. But your right, I should be checking for not only the existance but to make sure they are not symlinks. I dont think symlinking symlinks is a good idea anyway, well at least not in this code. Thanks t0mas!

      By the way, this is why I love perlmonks.
      -cleen

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (5)
As of 2024-03-28 23:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found