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

monitoring directory for new subdirectories

by incognito129 (Acolyte)
on Mar 27, 2009 at 22:19 UTC ( #753790=perlquestion: print w/replies, xml ) Need Help??

incognito129 has asked for the wisdom of the Perl Monks concerning the following question:

Whats the best way of doing this? I was planning on: 1. grabbing the contents of a directory 2. compare it to a previous list of contents 3. doing a difference on the two arrays with map 4. grab the new entries, filter for subdirectories only === My main concern here is being as efficient and low on resources as possible.
  • Comment on monitoring directory for new subdirectories

Replies are listed 'Best First'.
Re: monitoring directory for new subdirectories
by CSJewell (Beadle) on Mar 27, 2009 at 23:00 UTC

    That seems a little "brute-force", but other methods will depend on the OS: Win32, Mac/Unixy, or who-knows-what? I'll admit not knowing about anything but Win32 on that level.

    Win32 provides monitoring API calls (FindFirstChange(), FindNextChangeNotification() and SHChangeNotifyRegister() all look like things to try.) You may have to code that part in XS, and other people would have more knowledge about specifics than I would (I remember using the FindXChangeNotification API calls in a C++ program a few years back.)

      the script is running in debian 4.0

        Linux::Inotify2.  Some sample code to get you started: Inotify2 findings.

        Update: more (and specific) sample code:

        #!/usr/bin/perl use Linux::Inotify2; my $inotify = Linux::Inotify2->new() or die "unable to create new inotify object: $!"; $inotify->watch( "/tmp", # directory to watch IN_CREATE, # flags sub { # callback routine my $evt = shift; my $name = $evt->fullname; if (-d $name) { print "directory $name has been created\n"; } } ); 1 while $inotify->poll; __END__ $ stty -tostop # just in case $ ./753790.pl & [1] 2590 $ mkdir /tmp/somedir directory /tmp/somedir has been created $
Re: monitoring directory for new subdirectories
by graff (Chancellor) on Mar 28, 2009 at 15:53 UTC
    If the plan is to run a script at some interval (e.g. via your crontab), and you just want to monitor a single directory (not recursively watching all existing subdirectories), something like this would be pretty quick:
    use Croak qw/croak/; # (update; don't forget this line, if making a m +odule) sub check_new_paths { my ( $chkpath, $reflist ) = @_; # path to monitor, list of prev. + contents my %old_list; if ( -f $reflist ) { open( LST, "<", $reflist ) or croak( "Can't read $reflist: $!" + ); %old_list = map { chomp; $_ => undef } <LST>; close LST; } if ( ! -d $chkpath ) { croak( "$chkpath is not a directory" ); } my @new_list = grep { -d } <$chkpath/*>; # NB: file glob does not catch "$chkpath/.any-dot-initial-dirnam +e" my @added_list; if ( keys %old_list ) { for my $p ( sort @new_list ) { push @added_list, $p unless exists( $old_list{$p} ); } } else { warn sprintf( "Creating new list %s with %d items\n", $reflist, scalar @new_list ); } open( LST, ">", $reflist ) or croak( "Can't write $reflist: $!" ); print LST "$_\n" for ( @new_list ); close LST; return @added_list; }
    If you need to recursively check subdirs within the target path, you'll want to check out one of the various "File::Find" modules -- or just do something like:
    my @new_list = split /\x0/, `find $chkpath -type d -print0`;
    (which will also give you subdir names that begin with "."). -- Update: I'm sure you can get File::Glob to list dot-initial file names, too, but "that is left as an exercise..." ;)

    But if you can get Linux::Inotify to work (shouldn't be too hard), it'll probably include better, more general tools that you'll want to use.

Re: monitoring directory for new subdirectories
by ig (Vicar) on Mar 29, 2009 at 00:14 UTC

    Another possibility...

    #! /usr/local/bin/perl use strict; use warnings; use File::Find (); use List::Compare; use Tie::Persistent; my $root = shift or die "USAGE: $0 <directory>"; die "$root: not a directory" unless(-d $root); # Get historic and current states tie my @dirs, 'Tie::Persistent', './dirs.pd', 'rw'; my @newdirs = get_dirs($root); # Check for changes my $lc = List::Compare->new(\@dirs, \@newdirs); print "Removed directories:\n\t" . join("\n\t", $lc->get_unique()) . " +\n"; print "New directories:\n\t" . join("\n\t", $lc->get_complement()) . " +\n"; # Update the persistent record @dirs = @newdirs; exit(0); print "@dirs\n"; { my @dirs; sub wanted { my ($dev,$ino,$mode,$nlink,$uid,$gid); (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && -d _ && push(@dirs, $File::Find::name); } sub get_dirs { my $root = shift; # Traverse desired filesystems File::Find::find({wanted => \&wanted}, $root); return(@dirs); } }

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (6)
As of 2021-11-30 13:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?