I would like to build in Perl under Windows a Watch-Dog for a Hot-Folder (I might call it Folder-Watch or, hmm, probably much better: a Hot-Dog).
So far I succeeded in exactly doing that, with Win32::ChangeNotify (see sample below).
But as you might guess reading the source code I ran into a problem when the moving process wants to finish when the copying/creating process of the file in $watchdir has not finished (No such file or directory).
use Win32::ChangeNotifier;
use File::Copy qw(move);
my $notify = Win32::ChangeNotify->new($watchdir, 0, "FILE_NAME");
while (1) {
if ($notify->wait(1_000)) { # 1-second wait cycle
notify->reset;
#foundfiles = File::get_by_ext($watchdir, "csv"); # search and return files in $watchdir with extension "csv"
print "Something has happened! (del/ren/create)\n";
foreach (#foundfiles) {
move($watchdir.$_, $someotherdir.$_) or die "Fehler: $!";
}
#foundfiles = ();
}
}
Is there a way to automatically find out if the file is ready to go, i.e. has been finally created/copied?
I was thinking about something like
while (1) {
move $file if (-w $file) # writeable
wait(1)
}
but that does not seem to work under Windows. I need to solve this under Windows as well as Perl. Other than that I am open to suggestions.
Yes! I solved it (thanks to Сухой27)!
Inserting the following code right before moving the file:
while (1) {
last if writeable($path_in.$_);
print "-";
$| = 1;
sleep(1);
}
...whereas writeable refers to this little sub-marine:
sub writeable {
return open(my $file, ">>", shift);
}
Thanks, and have a nive day! :-)
Related
Okay I'm at a total loss.
I am trying to extract all the XMLs and PDFs from a 7zip file.
There is more stuff inside said file, so I just want to extract from the PDF folder and the XML folder. Leaving the file structure behind and not searching in any other folders.
I am using the 7Zip command line to do this.
I have two sub routines that I execute which are almost identical.
sub Extract_pdfs_from_this
{
my ($file, $destination) = #_;
my $sevenzip_executable = '\\\\server\7-Zip\7z.exe';
my $extract_pdfs = "$sevenzip_executable e -y -o$destination $file output\\JETPDF\\DISB\\*.pdf ";
print STDOUT "\n\nExtracting PDFs From $file \n>>$extract_pdfs \n";
eval{system($extract_pdfs)};
print STDOUT "Finished Extracting PDFs \n";
return;
}
..
sub Extract_xmls_from_this
{
my ($file, $destination) = #_;
my $sevenzip_executable = '\\\\server\7-Zip\7z.exe';
my $extract_xmls = "$sevenzip_executable e -y -o$destination $file staging\\DISB\\OnBase\\*.xml ";
print STDOUT "\n\nExtracting XMLs From $file \n>>$extract_xmls \n";
eval{system($extract_xmls)};
print STDOUT "Finished Extracting XMLs \n";
return;
}
and I use it like so...
my $in_extraction_directory = dirname(__FILE__);
my $input_subdirectory = "$directory\\$subdirectory";
my #in_seven_zip_files = Get_all_sevenzips_in($input_subdirectory);
foreach my $sevenzip_file (#in_seven_zip_files)
{
$sevenzip_file = "$input_subdirectory\\$sevenzip_file";
Extract_pdfs_from_this($sevenzip_file, $in_extraction_directory);
Extract_xmls_from_this($sevenzip_file, $in_extraction_directory);
}
When executed the PDFs get extracted but not the XMLs.
I get an error, there are no files to process.
I feel like 7zip is hung up on the file from the previous call. Is there a way to close it or release the file?
Any help appreciated, much time wasted on this.
Thanks!
Check exit status $?, if you feel it's hung.
Also you can try first extracting xmls then pdfs to really make sure, if extracting pdfs command is making issue.
share console output, Which can show much details.
User error... Works just how it should.
I had a condition:
unless ($number_of_pdfs == $number_of_xmls)
{
print STDOUT "The number of PDFs and XMLs did not match!\n\n";
print STDOUT "PDFs: $number_of_pdfs \nXMLs: $number_of_xmls\nFile: $sevenzip_file \nExtraction Directory: $output_directory\n\n";
die;
}
and in the first file I was extracting, the XML was not in the correct path... Someone didn't follow pattern. Very embarrassing thanks for the response.
I'm having a really weird problem with this perl script. The basic point is that sometimes a file write/append doesn't happen. On a run of the program, either all of the writes will happen or none of them will. Here is the subroutine, with some comments:
sub process_svs {
my $F;
open($F, '<', $_[0]);
if($log_dups==1) {
open($dfh, '>>',"./duplicates.txt");
}
while (my $line = <$F>) {
chomp $line;
if($line =~ /somepattern/) {
if (! -e "somefile") {
copy("source","dest") or warn ("couldn't copy");
} elsif($log_dups==1) {
system("touch ./duplicates.txt"); # ghetto workaround
print $dfh "./".$_[0]."_files/".$1.",v already exists\n" or die("Couldn't write duplicate"); # problem line
}
}
}
close $F;
}
The print statements to stdout always work, but if I remove the touch ./duplicates.txt crap, nothing is written to duplicates.txt.
The other "weird" thing, is that earlier in the program, I create a directory with perl mkdir, and if the directory exists when the program is run, I don't need the workaround, the duplicates.txt writing works just fine. If I delete the directory, and let the program mkdir it, it doesn't work. Seems relevant, but I can't figure out how since the directory and the text file are not in the same location, or related in any way, that I can think of.
Additionally, I have run it through the debugger, and can see the write call being executed, but inspecting duplicates.txt immediately after the write shows nothing written.
Any possible reasons for this would be greatly appreciated.
If you want to see a modified, but more complete, version of the script, it is here:
use strict;
use warnings;
use File::Copy;
my $svs = $ARGV[0];
my $rhis_str = system("rhis $svs > ./tmp_history");
my $fh;
my $dfh;
my #versions;
my $all_revs = 0;
my $current_rev = "";
my $log_dups = 0;
sub process_svs {
my $F;
open($F, '<', $_[0]);
if($log_dups==1) {
open($dfh, '>>',"./duplicates.txt");
}
while (my $line = <$F>) {
chomp $line;
if($line =~ /something/) {
if (! -e "something") {
copy("source","dest") or warn ("couldn't copy ");
} elsif($log_dups==1) {
system("touch ./duplicates.txt"); # ghetto workaround
print $dfh "something already exists\n" or die("Couldn't write duplicate");
}
}
}
close $F;
}
for(my $i = 0; $i <= scalar #ARGV; $i++) {
my $arg = $ARGV[$i];
if($arg eq "-a") {
$all_revs = 1;
} elsif($arg eq "-r") {
$all_revs = 0;
$current_rev = $ARGV[$i+1];
} elsif($arg eq "--log-dups") {
$log_dups = 1;
}
}
open($fh, '<','./tmp_history') or die(">>> Failed to open ./tmp_history");;
mkdir "./".$svs."_files";
if($all_revs == 1) {
print ">>> Processing all revisions of ".$svs;
if($log_dups==1) {
print" (and logging duplicates)\n";
}
while(my $line = <$fh>) {
chomp $line;
if ($line =~ /something/) {
push #versions, $1;
}
}
}
system("some_cmd &>/dev/null");
process_svs($svs);
}
You're not checking to see if your files opened. This is a very, very basic mistake and you should fix this immediately. Either add or die $! after each open or, better yet, use autodie and it will take care of catching all IO exceptions for you and give you good, consistent error messages.
Most importantly, this will tell you why it failed to open. $! tells you why it failed. You don't have that in your check on print.
print $dfh "./".$_[0]."_files/".$1.",v already exists\n" or die("Couldn't write duplicate"); # problem line
You're checking if print failed, but you're not including $!. Either add $! like die "Couldn't write to duplicate: $!" or use autodie, remove the or die clause, and let autodie take care of it. I recommend the second.
I suspect you'll find that something else is deleting duplicates.txt between the open and the print.
The second thing that grabs my attention is here.
if($log_dups==1) {
open($dfh, '>>',"./duplicates.txt");
}
You're using a global variable $log_dups to decide whether or not to open the file for writing (and not checking if it succeeded). This should be a variable that gets passed into the function, it's just good programming practice. Later you decide whether to print to $dfh based on that global variable.
if (! -e "something") {
copy("source","dest") or warn ("couldn't copy ");
} elsif($log_dups==1) {
system("touch ./duplicates.txt"); # ghetto workaround
print $dfh "something already exists\n" or die("Couldn't write duplicate");
}
Because $log_dups is global it's possible something else is changing $log_dups between deciding to open duplicates.txt and writing to it. To avoid all these problems, and to make the code simpler, $log_dups should be an argument passed into the function.
Furthermore, the filehandle $dfh is inexplicably a global. Same problem, something else could be closing it. It will also not be automatically closed at the end of the function which might leave writes to duplicates.txt buffered until the program exits. $dfh should be a lexical.
Other problems...
my $rhis_str = system("rhis $svs > ./tmp_history");
$rhis_str will contain the exit status of the rhis program. I don't think that's what you want. You don't use this variable anyway.
There's no need to pass ./file to open, it's safe and easier to read to use just pass file. That it's in the current working directory is implied.
If you fix these basic problems and still have trouble, then edit your question with the revised code and we can look again.
I am trying to modify a config file.
I first read it into #buffer, depending on a regex match.
The modified buffer gets written back on disk, in case the file got smaller, a trunciation is done.
Unfortunatly this does not work, and it already crashes at fseek, but as far as I can say my usage of fseek conforms to perl doc.
open (my $file, "+<", "somefilethatexists.txt");
flock ($file, LOCK_EX);
foreach my $line (<$file>) {
if ($line =~ m/(something)*/) {
push (#buffer, $line);
}
}
print "A\n";
seek($file,0,0); #seek to the beginning, we read some data already
print "B\n"; # never appears
write($file, join('\n',#buffer)); #write new data
truncate($file, tell($file)); #get rid of everything beyond the just written data
flock($file, LOCK_UN);
close ($file);
perlopentut says this about Mixing Reads and Writes
... when it comes to updating a file ... you probably don't want to
use this approach for updating.
You should use Tie::File for this. It opens the file for both read and write on the same filehandle and allows you to treat a file as an array of lines
use strict;
use warnings;
use Tie::File;
tie my #file, 'Tie::File', 'somefilethatexists.txt' or die $!;
for (my $i = 0; $i < #file; ) {
if (m/(something)*/) {
$i++;
}
else {
splice #file, $i, 1;
}
}
untie #file;
Where are your fseek(), fwrite() and ftruncate() functions defined? Perl doesn't have those functions. You should be using seek(), print() (or syswrite()) and truncate(). We can't really help you if you're using functions that we know nothing about.
You also don't need (and probably don't want) that explicit call to unlock the file or the call to close the file. The filehandle will be closed and unlocked as soon as your $file variable goes out of scope.
Maybe you can try this:
$^I = '.bak';
#ARGV = 'somefilethatexists.txt';
while (<>) {
if (/(something)*/) {
print;
}
}
Okay, so here's my final question (for the day): I am trying to get my program to search through a document. If the document has the word "unsuccessful" in it anywhere, then the program will search for the word "error" and record all instances of error. However, I am having a hard time making the two dependent on one another. Please help! I am very very new to Perl (this is only my second day using it) so the more detail/comments you can provide, the better! Here is my current code, I am aware it does not run right now:
#!/usr/local/bin/perl
my $argument1 = $ARGV[0];
my $argument2 = $ARGV[1];
open (LOGFILE, "<$argument1") or die "Can't find file";
open FILE, ">>$argument2" or die $!;
while (<LOGFILE>){
if {(/Unsuccessful/){
while(<LOGFILE>){
if (/Error/){
print FILE "ERROR in line $.\n" ;
}
}
}
}
}
close FILE;
close LOGFILE;
Check for "Unsuccessful" and "Error" in one loop and at the end print error findings if "Unsuccessful" has been found...
my $argument1 = $ARGV[0];
my $argument2 = $ARGV[1];
open (LOGFILE, "<$argument1") or die "Can't find file";
open (FILE, ">>$argument2") or die $!;
my $unsuccessful = 0;
my #errors = ();
while (<LOGFILE>) {
if (/Unsuccessful/i) {
$unsuccessful = 1;
}
if (/Error/i) {
push(#errors, "ERROR in line $.\n");
}
}
if ($unsuccessful) {
print $_ for #errors;
}
Switch /i applies for case-insensitive search, so remove it from the code above if not wanted.
Using
<LOGFILE>
multiple times is probably not what you want. The more immediate cause of your trouble is probably a badly placed "{".
It looks like you expect "Error" to always appear later than "Unsuccessful", right?
Try
my $argument1 = $ARGV[0];
my $argument2 = $ARGV[1];
open (LOGFILE, "<$argument1") or die "Can't find file";
open FILE, ">>$argument2" or die $!;
my $unsuccessful = 0;
while (<LOGFILE>){
if ($unsuccessful) {
if (/Error/) { print FILE "ERROR in line $.\n"; }
}
else {
if (/Unsuccessful/) { $unsuccessful = 1; }
}
}
close FILE;
close LOGFILE;
You are committing a grave mistake by taking step 5 before step 1. You're not using the strict and warning pragmas in your code. In fact, the code you posted doesn't compile.
As for the problem in question, provided that you want to parse each file only once (as a good programmer should strive to do), you should parse in two modes: (1) the mode where unsuccessful has been detected, and the mode where it has not yet been detected. The former will have the job of outputting lines, while the latter won't.
Now I'd suggest getting back to some basics and not taking steps in advance. I've taken step 5 before step 1 many times in the past myself, and it was a mistake each and every time.
I need to watch multiple files in Perl, and I am using Linux::Inotify2. However I am encountering an issue in that the first file being watched needs to be modified and hit, then the second, then the first etc etc
For example if the second file is changed before the first, it will not trigger out, or if the first is triggered twice in a row without the second being triggered in between.
This is the section of code I am using which is having this issue.
my $inotify = new Linux::Inotify2;
my $inotify2 = new Linux::Inotify2;
$inotify->watch ("/tmp/rules.txt", IN_MODIFY);
$inotify2->watch ("/tmp/csvrules.out", IN_MODIFY);
while () {
my #events = $inotify->read;
unless (#events > 0){
print "read error: $!";
last ;
}
foreach $mask (#events) {
printf "mask\t%d\n", $mask;
open (WWWRULES, "/tmp/rules.txt");
my #lines = <WWWRULES>;
foreach $line (#lines) {
#things = split(/,/, $line);
addrule(#things[0], #things[1], #things[2], #things[3], trim(#things[4]));
print "PRINTING: #things[0], #things[1], #things[2], #things[3], #things[4]";
close (WWWRULES);
open (WWWRULES, ">/tmp/rules.txt");
close (WWWRULES);
}
}
my #events2 = $inotify2->read;
unless (#events2 > 0){
print "read error: $!";
last ;
}
foreach $mask (#events) {
printf "mask\t%d\n", $mask;
open (SNORTRULES, "/tmp/csvrules.out");
my #lines2 = <SNORTRULES>;
foreach $line2 (#lines2) {
#things2 = split(/,/, $line2);
addrule("INPUT", #things2[0], #things2[1], #things2[2], trim(#things2[3]));
print "PRINTING: INPUT, #things2[0], #things2[1], #things2[2], #things2[3]";
close (SNORTRULES);
open (SNORTRULES, ">/tmp/csvrules.out");
close (SNORTRULES);
}
}
}
Ideally I would like to be watching 3 files but as I cannot get 2 working it seems a little pointless at this stage.
Thanks for any help!
A single inotify object can handle any number of watches. That's one of the advantages of inotify over the older and now obsolete dnotify. So you should be saying:
my $inotify = Linux::Inotify2->new;
$inotify->watch("/tmp/rules.txt", IN_MODIFY);
$inotify->watch("/tmp/csvrules.out", IN_MODIFY);
Then you can see which watch was triggered by checking the fullname property of the event object:
while () {
my #events = $inotify->read;
unless (#events > 0){
print "read error: $!";
last ;
}
foreach my $event (#events) {
print $event->fullname . " was modified\n" if $event->IN_MODIFY;
}
}
The big problem is that your code is modifying the same files that you're watching for modifications. When /tmp/rules.txt is modified, you open it, read it, and then truncate it, which triggers another modification notice, starting the whole process over again. In general, this is hard to solve without race conditions, but in your case, you should be able to just check for an empty file (next if -z $event->fullname).
You seem to be doing checks in serial on something that you want to happen in parallel. You're either going to want to fork a separate process, use threading, or integrate it in with a POE object.
Another option, which may or may not work for your application, is to set your tempdir to something more specific and keep all the files you're working on in there, then just watch the directory as a whole, which would then only require 1 inotify object, if i'm reading this right. (I haven't done anything with this module in particular but I have a pretty good idea of how it works by hooking syscalls to the file system).