I installed File::ChangeNotify on Windows System and try to run the following code :
my $watcher =
File::ChangeNotify->instantiate_watcher
( directories => [ 'C:\files' ],
filter => qr/\.txt$/
);
# # blocking
while ( my #events = $watcher->wait_for_events() ) { print "new event"}
When I ran the script and try to create a new .txt file or modify a .txt file under c:\files the script didn't print anything.
It works for me (on linux) if I add this line:
$| = 1;
Then I see new event.
Refer to perldoc perlvar: $| or $OUTPUT_AUTOFLUSH
Here is the complete code:
use warnings;
use strict;
use File::ChangeNotify;
$| = 1;
my $watcher =
File::ChangeNotify->instantiate_watcher
( directories => [ 'C:\files' ],
filter => qr/\.txt$/
);
# # blocking
while ( my #events = $watcher->wait_for_events() ) { print "new event"}
UPDATE: As cjm astutely points out, adding a newline works as an alternative to $|:
while ( my #events = $watcher->wait_for_events() ) { print "new event\n"}
Related
I tried the below snippet but it always gets the name of all files present in the current directory.
my %args = ("user" => $user, "password" => $pass, "warn" => 0 );
$con= Net::SFTP->new($server, %args);
#files = $con->ls($dir, wanted =>"*.csv");
Seems like there is no wanted option for the ls method. However, you can pass a callback. Here is an example using Text::Glob and a callback function wanted():
use strict;
use warnings;
use Net::SFTP;
use Text::Glob qw( match_glob );
my $con= Net::SFTP->new('host', user => 'user', password => 'pass');
my $dir = '.'; # specify the directory
my #files; # store filenames here
$con->ls($dir, sub { wanted( $_[0], '*.csv') } );
say for #files; # print the matched filenames
sub wanted {
my ( $info, $pat ) = #_;
my $filename = $info->{filename};
if (match_glob( $pat, $filename ) ) {
push #files, $filename;
}
}
You can do it this way in Net::SFTP::Foreign module. I believe same should work for Net::SFTP.
my #files = map {$_->{'filename'}} grep {$_->{'filename'} =~ /.csv$/i} #{$con->ls("$dir")};
I would like to watch a set of files for changes, and do so without a large CPU and battery penalty. Ideally, my perl code would run on both macos and linux, but the former is more important. I tried
I tried Mac::FSEvents, which works on macos and seems to do nicely for directories, but not for files as far as I can tell.
my $fs = Mac::FSEvents->new('try.txt');
my $fh= $fs->watch;
my $sel = IO::Select->new($fh);
while ( $sel->can_read ) {
my #events = $fs->read_events;
for my $event ( #events ) {
printf "File %s changed\n", $event->path;
}
}
which simply does not respond; and the promisingly more OS agnostic
use File::Monitor;
my $monitor = File::Monitor->new();
my #files= qw(try.txt);
foreach (#files) { $monitor->watch($_); }
which consumes 100% CPU. the $monitor-watch() alone does not block. I also tried
use File::Monitor;
my $monitor = File::Monitor->new();
$monitor->watch('try.txt', sub {
my ($name, $event, $change) = #_;
print "file has changed\n";
});
but this immediately returns.
I found another,
use File::ChangeNotify;
my $watcher =
File::ChangeNotify->instantiate_watcher
( directories => [ './' ],
filter => qr/try\.txt/,
);
# blocking
while ( my #events = $watcher->wait_for_events() ) {
print "file has changed\n";
}
but the CPU utilization is again high (70%).
Maybe these are all the wrong cpan modules, too. could someone please give me advice on how I should do this?
regards,
/iaw
Partial (macos-specific) example:
use IO::Select;
use Mac::FSEvents;
my $fs = Mac::FSEvents->new(
path => ['./try.txt', './try2.txt'],
file_events => 1,
);
my $fh= $fs->watch;
my $sel = IO::Select->new($fh);
while ( $sel->can_read ) {
my #events = $fs->read_events;
for my $event ( #events ) {
printf "File %s changed\n", $event->path;
}
}
(i.e., it needed the file_events flag.)
I'm trying to delete all table elements from several HTML files.
The following code runs perfectly on a single file, but when trying to automate the process it returns the error
can't call method "look_down" on an undefined value
Do you have any solution please?
Here is the code:
use strict;
use warnings;
use Path::Class;
use HTML::TreeBuilder;
opendir( DH, "C:/myfiles" );
my #files = readdir(DH);
closedir(DH);
foreach my $file ( #files ) {
print("Analyzing file $file\n");
my $tree = HTML::TreeBuilder->new->parse_file("C:/myfiles/$file");
foreach my $e ( $tree->look_down( _tag => "table" ) ) {
$e->delete();
}
use HTML::FormatText;
my $formatter = HTML::FormatText->new;
my $parsed = $formatter->format($tree);
print $parsed;
}
The problem is that you're feeding HTML::TreeBuilder all sorts of junk in addition to the HTML files that you intend. As well as any files in the opened directory, readdir returns the names of all subdirectories, as well as the pseudo-directories . and ... You should have seen this in the output from your print statement
print("Analyzing file $file\n");
One way to fix this is to check that each value in the loop is a file before processing it. Something like this
for my $file ( #files ) {
my $path = "C:/myfiles/$file";
next unless -f $path;
print("Analyzing file $file\n");
my $tree = HTML::TreeBuilder->new->parse_file($path);
for my $table ( $tree->look_down( _tag => 'table' ) ) {
$table->delete();
}
...;
}
But it would be much cleaner to use a call to glob. That way you will only get the files that you want, and there is also no need to build the full path to each file
That would look something like this. You would have to adjust the glob pattern if your files don't all end with .html
for my $path ( glob "C:/myfiles/*.html" ) {
print("Analyzing file $path\n");
my $tree = HTML::TreeBuilder->new->parse_file($path);
for my $table ( $tree->look_down( _tag => 'table' ) ) {
$table->delete();
}
...;
}
Strictly speaking, a directory name may also look like *.html, and if you don't trust your file structure you should also test that each result of glob is a file before processing it. But in normal situations where you know what's in the directory you're processing that isn't necessary
I written one script that create one xml file from multiple files,I written script like this.
#!/usr/bin/perl
use warnings;
use strict;
use XML::LibXML;
use Carp;
use File::Find;
use File::Spec::Functions qw( canonpath );
use XML::LibXML::Reader;
use Digest::MD5 'md5';
if ( #ARGV == 0 ) {
push #ARGV, "c:/main/work";
warn "Using default path $ARGV[0]\n Usage: $0 path ...\n";
}
open( my $allxml, '>', "all_xml_contents.combined.xml" )
or die "can't open output xml file for writing: $!\n";
print $allxml '<?xml version="1.0" encoding="UTF-8"?>',
"\n<Shiporder xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\">\n";
my %shipto_md5;
find(
sub {
return unless ( /(_stc\.xml)$/ and -f );
extract_information();
return;
},
#ARGV
);
print $allxml "</Shiporder>\n";
sub extract_information {
my $path = $_;
if ( my $reader = XML::LibXML::Reader->new( location => $path )) {
while ( $reader->nextElement( 'data' )) {
my $elem = $reader->readOuterXml();
my $md5 = md5( $elem );
print $allxml $reader->readOuterXml() unless ( $shipto_md5{$md5}++ );
}
}
return;
}
from above script I am extracting data node information from all xml files and stored in a new xml file . but I have one more node starts with "details", I need to extract that information and I need to add that information also to the file, I tried like this
$reader->nextElement( 'details' );
my $information = $reader->readOuterXml();
I added this in while loop but how can I assign or print this data into same file($all xml). Please help me with this problem.
After your suggestion I tried like this, It gives error
#!/usr/bin/perl
use warnings;
use strict;
use XML::LibXML;
use Carp;
use File::Find;
use File::Spec::Functions qw( canonpath );
use XML::LibXML::Reader;
if ( #ARGV == 0 ) {
push #ARGV, "V:/main/work";
warn "Using default path $ARGV[0]\n Usage: $0 path ...\n";
}
my $libXML = new XML::LibXML;
my $outputDom = $libXML->parse_string('<?xml version="1.0" encoding="UTF-8"?
>','<Shiporder xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">');
my $shiporder = $outputDom->documentElement;
find(
sub {
return unless ( /(_stc\.xml)$/ and -f );
extract_information();
return;
},
#ARGV
);
sub extract_information {
my $path = $_;
if(my #inputDom = XML::LibXML->load_xml(location => $path)){
$inputDom->findnodes('//data || //deatils');
foreach (#$inputDom) {
$shiporder->appendChild($_->parentNode->cloneNode(1));
}
$outputDom->toFile("allfiles.xml");
}
}
but it gives like " '\n\n:1: Parser error:Strat tag expected,'<' not found " Can you help me with script because I am very new to perl.
You would do a lot better if you used what XML::LibXML and related modules gives you, it is a very large and comprehensive module and allows you to do a lot in few lines.
You can use the parser to start a new dom document using parse_string, storing the root node using documentElement. From there, use parse_file to load up each of your input files, then findnodes on the input files to extract the nodes you want to clone. Then append a clone of your input nodes to the output document, and finally use the toFile method to write out your output.
Something like:
my $libXML = new XML::LibXML;
my $outputDom = $libXML->parse_string('<?xml version="1.0" encoding="UTF-8"?>',
'\n<Shiporder xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">\n');
my $shiporder = $outputDom->documentElement;
...
my $inputDom = $libXML->parse_file(some_file_name);
$inputDom->findnodes('//data || //details'); # use a more suitable xpath
foreach (#$inputDom) {
$shipOrder->appendChild($_->parentNode->cloneNode(1)); # if you want parent too...
}
...
$outputDom->toFile(some_output_file);
}
You will have to allow for namespaces and whatnot, but this gives one approach to start with.
I'm working my way up towards creating a script that will create image galleries for me.
When I run what I have it tells me
No such file or directory at photographycreate line 16.
------------
(program exited with code: 2)
Here is the code that I've gotten so far.
#!/etc/perl -w
#CHANGE THIS
$filecategory = "cooking";
$filenumber = 0;
#$filename = "photography";
$imagedirectory = "\"/media/New Volume/Programming/kai product/media/photography/".$filecategory."/images/\"";
$galleryfile = "\"/media/New Volume/Programming/kai product/pages/".$filenumber."_".$filecategory."_gallery.html\"";
#imagelocation = <$imagedirectory/*>; #*/
$filecount = #imagelocation;
while($filenumber < 3) {
open GALLERY, "+>", $galleryfile or die $!;
print GALLERY ($filecount."\n");
print GALLERY ($imagedirectory."\n");
print GALLERY ($galleryfile."\n");
close GALLERY;
++$filenumber;
}
What I want it to do is create the file, open it, write stuff to it, and then close/save it. How can I, using what I have, do this?
Here is the fix:
#!/etc/perl -w
use Fcntl; #The Module
use strict;
#CHANGE THIS
my $filecategory = "cooking";
my $filenumber = 0;
my $imagedirectory = "\"/media/New Volume/Programming/kaiproduct/media/photography/".$filecategory."/images/\"";
my $galleryfile = "/media/New Volume/Programming/kaiproduct/pages/".$filenumber."_".$filecategory."_gallery.html";
my #imagelocation = <$imagedirectory/*>; #*/
my $filecount = #imagelocation;
while($filenumber < 3)
{
open GALLERY, "+>", $galleryfile or die $!;
print (GALLERY $filecount."\n");
print (GALLERY $imagedirectory."\n");
print (GALLERY $galleryfile."\n");
close GALLERY;
++$filenumber;
}
I think the problem is here:
$imagedirectory = "\"/media/New Volume/Programming/kai product/media/photography/".$filecategory."/images/\"";
$galleryfile = "\"/media/New Volume/Programming/kai product/pages/".$filenumber."_".$filecategory."_gallery.html\"";
Specifically, each of these strings starts with "\" and ends with \"", which means your files and folders will be surrounded with double quotes. So Perl isn't trying to open /media/New Volume/etc..., but "/media/New Volume/etc...", which doesn't exist because there is no directory called ". You're over-quoting.
One thing you can (and should always) do to make your code better is to use strict;. I see you already have use warnings; at the top there, which is good, but using both strict and warnings will make your code a lot safer and nicer to look at.
IMNHO, the real answer is to use File::Spec and write things a bit clearer:
use File::Spec::Functions qw( catfile );
# ...
my $root = "/media/New Volume/Programming/kai product";
my $imagedirectory = catfile($root,
'photography',
$filecategory,
'images',
);
my $galleryfile = catfile($root,
'pages',
"${filenumber}_${filecategory}_gallery.html",
);
In addition, it is a good idea to observe good habits, especially since you are just learning Perl:
Always put:
use strict;
use warnings;
as the first thing in your program.
Use lexical filehandles rather than bareword filehandles (which are package global):
open my $gallery, '+>', $galleryfile
or die "Cannot open '$galleryfile': $!;
and include the name of the file in the error message.
Finally, I like File::Slurp's append_file:
append_file $gallery_file, [
map { "$_\n" } ( $filecount, $imagedirectory, $galleryfile )
];
Here is a revised version of your program:
#!/etc/perl
use strict;
use warnings;
use File::Spec::Functions qw( catfile );
my $root = "/media/New Volume/Programming/kai product";
my $filecategory = "cooking";
my $imagedirectory = catfile($root,
'photography',
$filecategory,
'images',
);
my #imagelocation = read_dir $imagedirectory;
for my $filenumber ( 0 .. 2 ) {
my $galleryfile = catfile($root, 'pages',
"${filenumber}_${filecategory}_gallery.html",
);
append_file $gallery_file, [
map { "$_\n" } (
scalar #imagelocation, $imagedirectory, $galleryfile,
)];
}