ryddler has asked for the wisdom of the Perl Monks concerning the following question:
Fellow monks, I am having an issue with an algorithm I put together, and I am blinded from staring at the code too long trying to debug it. Perhaps some of you have experienced similar issues and will be able to offer me some guidance.
Background: My company deals with title searches, often with paperwork bundles reaching into the hundreds of pages. The search department would scan these files, and depending upon the type of search they would enter the filenames into our title processing software. The issue we (IS Dept) knew they would quickly run into was that of trying to browse a directory that was ever expanding with a new subdirectory for each scan. With 7200 plus subdirectories they were finding navigation time was growing exponentially. The solution we schemed up was to have a service running that would scan a designated "Incoming" directory for new subdirectories, determine where they needed to go based on their name, and move them to the new home.
What was developed seems to work ok, but when I added the ability to notify upon completion of every move I started seeing unexpected behaviour. Without the notification routine, we would see the files show up the new location as expected, and the old files were then deleted. Once the notification routine was in place, I found I was getting 8 emails per subdirectory being moved, but only when the subdirectories are created by the scanners. If I manually move or copy a subdirectory into the "incoming" dir, I only get the one notification.
I suspect the scanning software has some kind of lock on the files in the subdirectory, and that the copy routine is unable to copy them until the scanner lets go, in which case I would expect failure from the function call. That would be fine, but not what seems to be happening... I can watch the directories, and as soon as I receive my first notification I check to see if the file has been copied. It has not, but the $success variable below indicates that it has indeed been copied!
The entire script is too lengthy to place here in its entirety, but the pertinent subs are below. The anonymous sub is actually stored in an XML config file, and eval'd at runtime to allow on-the-fly configuration changes ™. The directory name is passed into $var
sub { my $var = shift; if ($var =~ /^((\d{4})\d{3})$/) { my ($filenumber, $subdir) = ($1, $2); my ($success, $message) = $self->_movefiles( "$var", "\\\\servername\\share\\Dept\\Search\ +\Scans\\$subdir\\$filenumber"); unless ( $success == 1 ) { $self->_error( 'Error: Scanfiler directory moving problem', qq|There was an error moving file "$subdir/$filenumber. The er +ror was $message"|, 0); return; } $self->_error("ScanFiler Moved search file $filenumber", "ScanFiler Moved search file $filenumber to subfolder $subdir\\$ +filenumber \n" . "Success = $success and \$! = $message\n", 1); } } sub _movefiles { my ($self, $pathfrom, $pathto) = @_; my $tifpath = ''; my $fileto = ''; $dir = (new DirHandle $pathfrom) or die "$! at $pathfrom\n"; mkpath($pathto,1,); while (defined(my $filename = $dir->read)) { next if $filename =~ /^\.{1,2}$/; if ($filename =~ /\.tif$/i) { if (-e "$pathto/$filename") { my ($prefix,$digit) = ($filename =~ /(\d+_\d+_)(\d+)\.tif/); while (-e "$pathto/$prefix$digit.tif") { ++$digit } $fileto = $tifpath = "$prefix$digit.tif"; } else { $fileto = $tifpath = $filename; } } else { $fileto = $filename; } my $time = time() - $offset - (stat("$pathfrom/$filename"))[9]; next if $time < 30; unless ( copy("$pathfrom/$filename", "$pathto/$fileto") == 1 ) { return ( 0, $!); } if (compare("$pathfrom/$filename", "$pathto/$fileto") == 0) { unlink "$pathfrom/$filename" } } $dir->close; return (rmdir("$pathfrom"), $tifpath); }
|
---|