My script asks for download URLs and sends them to the download queue. The progress of the download should be printed back.
I don't find a way to keep the prompt on bottom and do the status over it.
I tried a search on CPAN, but I found no module for it.
#!/usr/bin/perl
use 5.14.0;
use strict;
use warnings;
use Term::UI;
use Term::ReadLine;
use threads;
use Thread::Queue;
sub rndStr{ join'', #_[ map{ rand #_ } 1 .. shift ] }
my $q = Thread::Queue->new(); # A new empty queue
my $thr = threads->create(
sub {
while (defined(my $item = $q->dequeue())) {
say "Downloading: ".$item;
sleep 1;
#$q->enqueue(1..10) if $item eq '10';
$q->enqueue(rndStr rand (15)+5, 'a'..'z', 0..9);
}
}
);
$q->enqueue(rndStr 10, 'a'..'z', 0..9);
my $url;
my $term = Term::ReadLine->new('brand');
while ($url ne 'end'){
$url = $term->get_reply(
prompt => 'URL to download',
default => 'end' );
$q->enqueue($url);
}
say "Finishing remaining downloads";
$q->enqueue(undef);
$thr->join();
The basic just of what you are trying to do is use ANSI codes to move the cursor around. Something such as ncurses (windows version) will allow you do this.
Alternatively you can do it yourself with raw ASCII/ANSI codes (as explained by these two links)
http://ascii-table.com/ansi-escape-sequences-vt-100.php
http://www.tldp.org/HOWTO/Bash-Prompt-HOWTO/x361.html
Or lastly you could use a Perl Module Win32::Console::ANSI which is designed to help you do this.
As this is a perl question I would suggest looking at Win32::Console::ANSI.
say adds a newline in the output; use print instead. Add a carriage return to write over previous output:
print "Downloading: ".$item."\r";
Related
I'm trying to use Expect.pm on an old machine with perl 5.8.8.
It works but when I send a text that contains a "#" sign it is removed from the text.
Is there a way to escape/protect it?
Thanks
Sorry corrected it is 5.8.8
#!/usr/bin/perl
use Expect;
use IPC::Open2;
my $cmd="./rec";
my $e = Expect->new;
$e->debug(0);
$e->spawn($cmd) or die;
$e->log_stdout(1);
$e->raw_pty(0);
my $cmd="#some command";
print "cmd: [$cmd]\n";
$e->send($cmd);
$e->expect(1,
[ qr/^I:.*/ => sub { my $exp = shift; print "ok\n"; exp_continue;}],
[ qr/^E:.*/ => sub {
my $self = shift;
print "ko\n";
print "Match: <\n", $self->match, "\n>\n";
print "Before: <", $self->before, ">\n";
print "After: <", $self->after, ">\n";
exp_continue;
}]
);
print "closing\n";
$e->clear_accum();
$e->close();
the rec is a simple c program chat echoes what it receives for debug purpose and prints only
some command
taking the # away.
The actual program I want to control needs that # I cannot make without it.
The following script should demonstrate a problem I'm facing using Mojolicious on OpenBSD5.2 using mod_perl.
The script works fine 4 times being called as CGI under mod_perl. Additional runs of the script result in Mojolicious not returning the asynchronous posts. The subs that are usually called when data is arriving just don't seem to be called anymore. Running the script from command line works fine since perl is then completely started from scratch and everything is reinitialized, which is not the case under mod_perl. Stopping and starting Apache reinitializes mod_perl so that the script can be run another 4 times.
I only tested this on OpenBSD5.2 using Mojolicious in the version that's provided in OpenBSDs ports tree (2.76). This is kinda old I think but that's what OpenBSD comes with.
Am I doing something completely wrong here? Or is it possible that Mojolicious has some circular reference or something which causes this issue?
I have no influence on the platform (OpenBSD) being used. So please don't suggest to "use Linux and install latest Mojolicious version". However if you are sure that running a later version of Mojolicous will solve the problem, I might get the permission to install that (though I don't yet know how to do that).
Thanks in advance!
T.
Here's the script:
#!/usr/bin/perl
use diagnostics;
use warnings;
use strict;
use feature qw(switch);
use CGI qw/:param/;
use CGI qw/:url/;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use Mojo::IOLoop;
use Mojo::JSON;
use Mojo::UserAgent;
my ($activeconnections, $md5, $cgi);
my $ua = Mojo::UserAgent->new;
$ua->max_redirects(0)->connect_timeout(3)->request_timeout(6); # Timeout 6 seconds of which 3 may be connecting
my $delay = Mojo::IOLoop->delay();
sub online{
my $url = "http://www.backgroundtask.eu/Systeemtaken/Search.php";
$delay->begin;
$activeconnections++;
my $response_bt = $ua->post_form($url, { 'ex' => $md5 }, sub {
my ($ua, $tx) = #_;
my $content=$tx->res->body;
$content =~ m/(http:\/\/www\.backgroundtask\.eu\/Systeemtaken\/taakinfo\/.*$md5\/)/;
if ($1){
print "getting $1\n";
my $response_bt2 = $ua->get($1, sub {
$delay->end();
$activeconnections--;
print "got result, ActiveConnections: $activeconnections\n";
($ua, $tx) = #_;
my $filename = $tx->res->dom->find('table.view')->[0]->find('tr.even')->[2]->td->[1]->all_text;
print "fn = " . $filename . "\n";
}
)
} else {
print "query did not return a result\n";
$activeconnections--;
$delay->end;
}
});
}
$cgi = new CGI;
print $cgi->header(-cache_control=>"no-cache, no-store, must-revalidate") . "\n";
$md5 = lc($cgi->param("md5") || ""); # read param
$md5 =~ s/[^a-f0-9]*//g if (length($md5) == 32); # custom input filter for md5 values only
if (length $md5 != 32) {
$md5=lc($ARGV[0]);
$md5=~ s/[^a-f0-9]*//g;
die "invalid MD5 $md5\n" if (length $md5 ne 32);
}
online;
if ($activeconnections) {
print "waiting..., activeconnections: $activeconnections\n" for $delay->wait;
}
print "all pending requests completed, activeconnections is " . $activeconnections . "\n";
print "script done.\n md5 was $md5\n";
exit 0;
Well I hate to say it, but there's a lot wrong here. The most glaring is your use of ... for $delay->wait which doesn't make much sense. Also you are comparing numbers with ne rather than !=. Not my-ing the arguments in the deeper callback seems problematic for async style code.
Then there are some code smells, like regexing for urls and closing over the $md5 variable unnecessarily.
Lastly, why use CGI.pm when Mojolicious can operate under CGI just fine? When you do that, the IOLoop is already running, so some things get easier. And yes I understand that you are using the system provided Mojolicious, however I feel I should mention that the current version is 3.93 :-)
Anyway, here is an example, which strips out a lot of things but still should do pretty much the same thing as the example. Of course I can't test it without a valid md5 for the site (and I also can't get rid of the url regex without sample data).
#!/usr/bin/perl
use Mojolicious::Lite;
use Mojo::UserAgent;
my $ua = Mojo::UserAgent->new;
$ua->max_redirects(0)->connect_timeout(3)->request_timeout(6); # Timeout 6 seconds of which 3 may be connecting
any '/' => sub {
my $self = shift;
$self->res->headers->cache_control("no-cache, no-store, must-revalidate");
my $md5 = lc($self->param("md5") || ""); # read param
$md5 =~ s/[^a-f0-9]*//g if (length($md5) == 32); # custom input filter for md5 values only
if (length $md5 != 32) {
$md5=lc($ARGV[0]);
$md5=~ s/[^a-f0-9]*//g;
die "invalid MD5 $md5\n" if (length $md5 != 32);
}
$self->render_later; # wait for ua
my $url = "http://www.backgroundtask.eu/Systeemtaken/Search.php";
$ua->post_form($url, { 'ex' => $md5 }, sub {
my ($ua, $tx) = #_;
my $content=$tx->res->body;
$content =~ m{(http://www\.backgroundtask\.eu/Systeemtaken/taakinfo/.*$md5/)};
return $self->render( text => 'Failed' ) unless $1;
$ua->get($1, sub {
my ($ua, $tx) = #_;
my $filename = $tx->res->dom->find('table.view')->[0]->find('tr.even')->[2]->td->[1]->all_text;
$self->render( text => "md5 was $md5, filename was $filename" );
});
});
};
app->start;
If I have Perl code which usees a lot of modules, is there a fast and easy way to find out if some of this modules are not pure Perl modules?
#DynaLoader::dl_modules contains the list of XS modules loaded.
perl -MSome::Module1 -MSome::Module2 -M... \
-MDynaLoader -E'say for sort #DynaLoader::dl_modules;'
Or if you wanted to write it as a script:
# Usage: script Some::Module1 Some::Module2 ...
use 5.010;
use DynaLoader qw( );
while (defined($_ = shift(#ARGV))) {
s{::}{/}g;
$_ .= ".pm";
require $_;
}
say for sort #DynaLoader::dl_modules;
Of course, nothing's stopping you from putting it in an existing script either.
use 5.010;
use DynaLoader qw( );
END { say for sort #DynaLoader::dl_modules; }
This looks like a job for what I call a "blowup sensor". You could just boobytrap the hooks, by putting this at the top of the first module:
BEGIN {
require Carp; #Does the stack stuff
# Fool Perl into thinking that these are already loaded.
#INC{ 'XSLoader.pm', 'DynaLoader.pm' } = ( 1, 1 );
# overload boobytrapped stubs
sub XSLoader::load { Carp::confess( 'NOT Pure Perl!' ); }
sub DynaLoader::bootstrap { Carp::confess( 'NOT Pure Perl!' ); }
}
If you have to try which modules in your Perl prog is not installed yet on your machine. You can do it like this:
use ExtUtils::Installed;
my $installed = ExtUtils::Installed->new();
my #miss;
foreach $module ($installed->modules()){
#miss = $installed->validate($module);
}
print join("\n", #miss);
So I have something like this:
fork.pl
for $str (#files)
{
my($command) = "perl command.pl ".$str;
exec( $command );
}
command.pl
$file=$ARGV[0].".csv";
#code that counts rows here
print $rowcount;
So as the end result I have 10 files launched which count how many rows are in each csv file.
I do not need help editting this code, it works (this is just a compressed version). I need help figuring out how to take the output ($rowcount) of ten files and combine it into one for further processing.
I keep some utility code around for just this purpose... this is tweaked slightly to your question and including a synchronized global counting method.
#!/usr/bin/perl
use threads;
use Thread::Queue;
my #workers;
my $num_threads = 10;
my $queue = new Thread::Queue;
my $total_ines = 0;
for (0..$num_threads-1) {
$workers[$_] = new threads(\&worker);
}
while ($_ = shift #ARGV) {
$queue->enqueue($_);
}
sub worker() {
while ($file = $queue->dequeue) {
#line counting code here
global_counter($lines_counted);
}
}
sub global_counter() :locked {
#add to the number of lines counted
$total_lines += shift
}
for (0..$num_threads-1) { $queue->enqueue(undef); }
for (0..$num_threads-1) { $workers[$_]->join; }
print $total_lines;
This kind of communication is solved using pipes (let me write a simple example):
# -- fork.pl -------------------------
for (1..3) {
open my $PIPE, "perl command.pl |";
print "catch: $_\n" while(<$PIPE>);
close $PIPE;
}
# -- command.pl ----------------------
print rand(1);
It prints (random numbers):
catch: 0.58929443359375
catch: 0.1290283203125
catch: 0.907012939453125
You need to look either at threads or Interprocess communication with e.g. sockets or shared memory when using fork.
Compressed but won't work. I'm assuming that in fork.pl, you fork before exec'ing? Backticks capture the output of the called process, namely your prints:
fork.pl
for $str (#files)
{
my($command) = "perl command.pl ".$str;
print `$command`;
}
But rather than forking and launching processes, wouldn't it be smarter to turn the second file into a module?
package MyCommand;
use Exporter;
our #EXPORT = qw( command );
sub command {
my $file = $_[0] . '.csv';
...
return $rowcount;
}
1;
fork.pl:
use MyCommand;
...
my #rowcounts;
for my $str (#files) {
push #rowcounts, command($str);
}
A bit of self-promotion, but I just posted this in your other thread, which seems relevant enough: How to run in parallel two child command from a parent one?
Accumulate pipes from children:
#!/usr/bin/perl -w
use strict;
my $files = qw/one.csv two.csv three.csv/;
my $command = "perl command.pl";
my #pipes;
foreach (#files) {
my $fd;
open $fd, "-|", "$command $_" and push #pipes, $fd;
};
my $sum = 0;
foreach my $pp (#pipes) {
$sum += $_ if defined ($_=<$pp>);
};
print $sum;
Then you can just read them one by one (as in example), or use IO::Select to read data as it appears in each pipe.
A hash table in addition to array is also good if you want to know which data comes from which source.
I'm going to have to download a number of datasets via simply POSTing at an url and getting XML in return. I will be able to speed this up by doing more than one request at a time, but here's the hook:
It will need to run on both Windows and Linux, so threads and forks are both out. (Since this is purely IO-bound i don't think they're needed either.)
Additionally my coworkers aren't on a very high level of perl understanding, but need to be able to grasp how to use it (not necessarily what's going on, usage is fine). As such i'd be happy if its API was somewhat simple.
Right now i'm looking at IO::Lambda for this.
Any other suggestions?
Post-Mortem: Based on draegtun's suggestion i've now thrown together this, which does the job perfectly: https://gist.github.com/661386 You might see it on CPAN soonish.
Have a look at AnyEvent::HTTP. According to the CPAN testers platform matrix it does compile & work on Windows.
Below is a straightforward example of async POSTing (http_post).
use 5.012;
use warnings;
use AnyEvent::HTTP;
my $cv = AnyEvent->condvar;
my #urls = (
[google => 'http://google.com', 'some body'],
[yahoo => 'http://yahoo.com' , 'any body' ],
);
for my $site (#urls) {
my ($name, $url, $body) = #$site;
$cv->begin;
http_post $url, $body => sub {
my $xml = shift;
do_something_with_this( $name, $xml );
$cv->end;
}
}
# wait till all finished
$cv->recv;
say "Finished";
sub do_something_with_this { say #_ }
NB. Remember whatever you decide todo with do_something_with_this try to avoid anything that blocks. See other non-blocking AnyEvent modules
/I3az/
You can try to use LWP::Parallel.
Update:
I just tried to build it on Windows XP with ActiveState's 5.10.1 and encountered a bunch of test failures some which are due to the TEST script blindly prepending .. to all entries in #INC and others seem to be due to a version mismatch with LWP::Protocol::* classes.
This is a concern. I might go with Parallel::ForkManager in conjunction with LWP.
#!/usr/bin/perl
use strict; use warnings;
use Config::Std { def_sep => '=' };
use File::Slurp;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
use Parallel::ForkManager;
die "No config file specified\n" unless #ARGV;
my ($ini) = #ARGV;
read_config $ini, my %config;
my $pm = Parallel::ForkManager->new(10);
my #urls = #{ $config{''}{url} };
for my $url ( #urls ) {
$pm->start and next;
my $param = [ %{ $config{$url} } ];
my $request = POST $url, $param;
my $ua = LWP::UserAgent->new;
my $fn = sprintf '%s-%s-%s.xml',
map $request->$_, qw( method uri content);
$fn =~ s/\W+/_/g;
my $response = $ua->request( $request );
if ( $response->code == 200 ) {
write_file $fn, \ $response->as_string;
}
else {
warn $response->message, "\n";
}
$pm->finish;
}
$pm->wait_all_children;
Here is a sample config file:
url = http://one.example.com/search
url = http://two.example.com/query
url = http://three.example.com/question
[http://one.example.com/search]
keyword = Perl
limit = 20
[http://two.example.com/query]
type = Who is
limit = 10
[http://three.example.com/question]
use = Perl
result = profit
Update:
If you need to convince yourself that execution is not serial, try the following short script:
#!/usr/bin/perl
use strict; use warnings;
use Parallel::ForkManager;
my $pm = Parallel::ForkManager->new(2);
for my $sub (1 .. 4) {
$pm->start and next;
for my $i ('a' .. 'd') {
sleep rand 3;
print "[$sub]: $i\n";
}
$pm->finish;
}
$pm->wait_all_children;
Output:
[1]: a
[1]: b
[2]: a
[1]: c
[1]: d
[2]: b
[3]: a
[3]: b
[3]: c
[2]: c
[3]: d
[2]: d
[4]: a
[4]: b
[4]: c
[4]: d
Regarding your comment about "reliability", I believe it's misguided. What you are doing is simulated by the following script:
#!/usr/bin/perl
use strict; use warnings;
use Parallel::ForkManager;
use YAML;
my #responses = parallel_run();
print Dump \#responses;
sub parallel_run {
my $pm = Parallel::ForkManager->new(2);
my #responses;
for my $sub (1 .. 4) {
$pm->start and next;
for my $i ('a' .. 'd') {
sleep rand 3;
push #responses, "[$sub]: $i";
}
$pm->finish;
}
$pm->wait_all_children;
return #responses;
}
The output you get from that will be:
--- []
It is up to you to figure out why. That's why Parallel::ForkManager allows you to register callbacks. Just like the ones you are using with AnyEvent::HTTP.
What module you use is your own business. Just don't keep making blatantly false statements.
Mojo::UserAgent can also do async paralell http. Its API might be easier to understand for non-perl people than some of the other modules..
Not sure if it qualifies as "reliable" yet ..