Assigning actions to a variable - krl

In answering Aaron's recent question, I'd like to do something like the following:
rule first_rule {
select when pageview "exampley.com/\?name=(.*)" setting (username)
pre {
isjoe = username eq "joe";
myaction = defaction() {
thisaction = isjoe => notify("Hello, World", "Hi there, Joe!") | noop();
thisaction();
};
}
{
notify("Will it work?", "Methinks you are #{username}");
myaction();
}
}
However, the defaction never seems to work. It doesn't like that I'm trying to assign an action to a variable and then return that variable.
What am I doing wrong?

You are really close.
You can't call an action till the end of the defaction. You need to create a defaction that delays execution till the right time.
Change:
thisaction = isjoe => notify("Hello, World", "Hi there, Joe!") | noop();
to
thisaction = isjoe => defaction(){notify("Hello, World", "Hi there, Joe!");} | noop;
Note the added defaction and I removed the parens from noop.
This concept is is similar to javascript closures.

Related

WWW::Mechanize::Firefox looping though links

I am using a foreach to loop through links. Do I need a $mech->back(); to continue the loop or is that implicit.
Furthermore do I need a separate $mech2 object for nested for each loops?
The code I currently have gets stuck (it does not complete) and ends on the first page where td#tabcolor3 is not found.
foreach my $sector ($mech->selector('a.link2'))
{
$mech->follow_link($sector);
foreach my $place ($mech->selector('td#tabcolor3'))
{
if (($mech->selector('td#tabcolor3', all=>1)) >= 1)
{
$mech->follow_link($place);
print $_->{innerHTML}, '\n'
for $mech->selector('td.dataCell');
$mech->back();
}
else
{
$mech->back();
}
}
You cannot access information from a page when it is no longer on display. However, the way foreach works is to build the list first before it is iterated through, so the code you have written should be fine.
There is no need for the call to back as the links are absolute. If you had used click then there must be a link in the page to click on, but with follow_link all you are doing is going to a new URL.
There is also no need to check the number of links to follow, as a for loop over an empty list will simply not be executed.
To make things clearer I suggest that you assign the results of selector to an array before the loop.
Like this
my #sectors = $mech->selector('a.link2');
for my $sector (#sectors) {
$mech->follow_link($sector);
my #places = $mech->selector('td#tabcolor3');
for my $place (#places) {
$mech->follow_link($place);
print $_->{innerHTML}, '\n' for $mech->selector('td.dataCell');
}
}
Update
My apologies. It seems that follow_link is finicky and needs to follow a link on the current page.
I suggest that you extract the href attribute from each link and use get instead of follow_link.
my #selectors = map $_->{href}, $mech->selector('a.link2');
for my $selector (#selectors) {
$mech->get($selector);
my #places = map $_->{href}, $mech->selector('td#tabcolor3');
for my $place (#places) {
$mech->get($place);
print $_->{innerHTML}, '\n' for $mech->selector('td.dataCell');
}
}
Please let me know whether this works on the site you are connecting to.
I recommend to use separate $mech object for this:
foreach my $sector ($mech->selector('a.link2'))
{
my $mech = $mech->clone();
$mech->follow_link($sector);
foreach my $place ($mech->selector('td#tabcolor3'))
{
if (($mech->selector('td#tabcolor3', all=>1)) >= 1)
{
my $mech = $mech->clone();
$mech->follow_link($place);
print $_->{innerHTML}, '\n'
for $mech->selector('td.dataCell');
#$mech->back();
}
# else
# {
# $mech->back();
# }
}
I am using WWW:Mechanize::Firefox to loop over a bunch of URLs with loads of Javascript. The page does not render immediately so need test if a particular page element is visible (similar to suggestion in Mechanize::Firefox documentation except 2 xpaths in the test) before deciding next action.
The page eventually renders a xpath to 'no info' or some wanted stuff after about 2-3 seconds. If no info we go to next URL. I think there is some sort of race condition with both xpaths not existing at once causing the MozRepl::RemoteObject: TypeError: can't access dead object error intermittently (at the sleep 1 in the loop oddly enough).
My solution that seems to work/improve reliability is to enclose all the $mech->getand$mech->is_visible in an eval{}; like this:
eval{
$mech->get("$url");
$retries = 15; #test to see if element visible = page complete
while ($retries-- and ! $mech->is_visible( xpath => $xpath_btn ) and ! $mech->is_visible( xpath => $xpath_no_info )){
sleep 1;
};
last if($mech->is_visible( xpath => $xpath_no_info) ); #skip rest if no info page
};
Others might suggest improvements on this.

Perl do...while and last command

I've just encountered some very weird behavior that I really can't explain:
do {
my $qry = $self->getHTMLQuery(undef, $mech->content());
next if (!defined($qry));
push(
#prods,
map { 'http://www.XXXXYYYX.com'.$_->attr('href') }
$qry->query('div.prodInfo div.prodInfoBox a.prodLink.GridItemLink')
);
$qry->delete();
$TEST++;
last if ($TEST >= 10);
} while(eval { $mech->follow_link(class => 'jump next') });
print "WHILE ENDED\n";
The code above never prints "WHILE ENDED" even though it does seem to go out of the while loop when $TEST >= 10.
But the following code does print "WHILE ENDED":
do {
my $qry = $self->getHTMLQuery(undef, $mech->content());
next if (!defined($qry));
push(
#prods,
map { 'http://www.XXXXYYYX.com'.$_->attr('href') }
$qry->query('div.prodInfo div.prodInfoBox a.prodLink.GridItemLink')
);
$qry->delete();
$TEST++;
} while(eval { $mech->follow_link(class => 'jump next') } && $TEST <= 10);
print "WHILE ENDED\n";
In both tests, the initial value of $TEST is 0.
Is the behavior of last in do...while different than in for and while {...}?
A do block with a looping modifier doesn't count as a real loop as far as next, last, and redo are concerned. This is mentioned in perlsyn, where you'll find the tip Schwern mentioned about surrounding it with a bare block to make last work. But that won't work with next, because a bare block is only executed once, so next acts like last. To make next work, you can put the bare block inside the do, but then last will act like next.
If you need both next and last to work with a do ... while, the easiest way is to use an infinite loop with the real condition in a continue block. These 2 loops are equivalent, except that the second is a real loop, so it works with next & last:
do { ... } while condition;
while (1) { ... } continue { last unless condition };
From perldoc -f last:
"last" cannot be used to exit a block that returns a value such as
"eval {}", "sub {}" or "do {}"
TLP is right. The standard work around for this (I just hit it myself) is to wrap the do/while in a bare block which, counter-intuitively, does respect loop controls.
{ do {
last;
} while 1; }
The block outside will catch last. If you want to handle next you have to put the bloc inside.
do {{
next;
}} while 1;
The block inside will catch next.
Unfortunately you can't do both.

more than one defaction in the body?

All, can I run more than one defaction in the body of the rule? or can I only run one?
You can define as many actions in the pre block of a rule as you want. You can have as many actions in the action block of a rule as you want (just enclose the action block in curly braces). For example,
rule first_rule {
select when pageview ".*" setting ()
pre {
notify_one = defaction() { notify("notify_one", "First defaction"); };
notify_two = defaction() { notify("notify_two", "Second defaction"); };
}
{
notify_one();
notify_two();
}
}
So I think the answer to your question is yes.
Your question is a little confusing, but I'll give it a run.
Running actions defined with defaction is just like running system defined actions.
If you want to run more then one action in a rule, you need to wrap them in {} like so:
rule foo {
select when pageview ".*"
{
notify("cheese", "brie");
notify("apple", "golden delicious");
}
}
I seem to recall that a defaction has an implicit, optional 'pre' section, followed by the action(s). To include multiple actions you do need {} as Sam says.
act1 = defaction() {
{
notify("Defaction Demo", "<ul id='demo_id'></ul>");
append("#demo-id", "<li>cheese: brie</li>");
append("#demo-id", "<li>apple: golden delicious</li>");
}
};
That works out to defaction() { { ... } }; but the extra curly braces are required if you want more than one action in a defaction.
See also http://docs.kynetx.com/docs/Defaction

KRL and Yahoo Local Search

I'm trying to use Yahoo Local Search in a Kynetx Application.
ruleset avogadro {
meta {
name "yahoo-local-ruleset"
description "use results from Yahoo local search"
author "randall bohn"
key yahoo_local "get-your-own-key"
}
dispatch { domain "example.com"}
global {
datasource local:XML <- "http://local.yahooapis.com/LocalSearchService/V3/localsearch";
}
rule add_list {
select when pageview ".*" setting ()
pre {
ds = datasource:local("?appid=#{keys:yahoo_local()}&query=pizza&zip=#{zip}&results=5");
rs = ds.pick("$..Result");
}
append("body","<ul id='my_list'></ul>");
always {
set ent:pizza rs;
}
}
rule add_results {
select when pageview ".*" setting ()
foreach ent:pizza setting pizza
pre {
title = pizza.pick("$..Title");
}
append("#my_list", "<li>#{title}</li>");
}
}
The list I wind up with is
. [object Object]
and 'title' has
{'$t' => 'Pizza Shop 1'}
I can't figure out how to get just the title. It looks like the 'text content' from the original XML file turns into {'$t' => 'text content'} and the '$t' give problems to pick().
When XML datasources and datasets get converted into JSON, the text value within an XML node gets assigned to $t. You can pick the text of the title by changing your pick statement in the pre block to
title = pizza.pick("$..Title.$t");
Try that and see if that solves your problem.
Side notes on things not related to your question to consider:
1) Thank you for sharing the entire ruleset, what problem you were seeing and what you expected. Made answering your question much easier.
2) The ruleset identifier should not be changed from what AppBuilder or the command-line gem generate for you. Your identifier that is currently
ruleset avogadro {
should look something more like
ruleset a60x304 {
3) You don't need the
setting ()
in the select statement unless you have a capture group in your regular expression
Turns out that pick("$..Title.$t") does work. It looks funny but it works. Less funny than a clown hat I guess.
name = pizza.pick("$..Title.$t");
city = pizza.pick("$..City.$t");
phone = pizza.pick("$..Phone.$t");
list_item = "<li>#{name}/#{city} #{phone}</li>"
Wish I had some pizza right now!

How could I redefine a subroutine and keep the old one too?

Here's what I'd like to achieve:
sub first {
print "this is original first";
}
*original_first = \&first;
sub first {
print "this is first redefined";
}
original_first(); # i expect this to print "this is original first"
first() # i expect this to print "this is first redefined"
I thought that by saving the symbol for first, I'd be able to later call the original subroutine ( under the name original_first ) and to also be able to call first, and get the one redefined. However, if I call the original_first, I still get the "this is first redefined". What do I have to do to make this work?
This should work as you expect:
sub first {
print "this is original first";
}
*original_first = \&first;
*first = sub {
print "this is first redefined";
};
in your code, Perl interprets both sub declarations similar to this:
BEGIN {
*first = sub { ... }
}
so both assignments to &first end up happening before saving the copy and calling the routines. the fix is to make the second declaration into a runtime assignment:
sub first {
print "this is original first";
}
*original_first = \&first;
*first = sub {print "this is first redefined"};
original_first(); # prints "this is original first"
first(); # prints "this is first redefined"
See the Hook::LexWrap module, which can handle all of that for you. If you don't want to use the module, just look at the source, which shows you exactly how to do it.