How to get the value of an html element using HTML::TreeBuilder - perl

I have a perl array:
Print Dumper(\#jsession);
$VAR1 = [
'<html><body><form name = \'form\' id=\'form\' method = \'POST\' action = \'/Site.jsp\'><input type = hidden name = \'phpSessionID\' value = \'RBOpXs47l6AOw**\'><input type = hidden name = \'LoggedUserName\' value = \'User\'><!--input type = submit name = \'button\' value = \'goAhead\'--></form> <script language = \'JavaScript\'> document.getElementById(\'frmWelcome\').submit();</script></body'</html>
];
I want to get the value of the phpSessionID element into a perl variable.
Here is the HTML::TreeBuilder code that i tried:
$tree=HTML::TreeBuilder->new_from_content(#jsession);
$tree->dump();
It actually prints the HTML part from the array,But how do i use it to get the value of the element that i need?
Here is the code that actually worked for me,in case anyone else where to search for this:
$tree=HTML::TreeBuilder->new_from_content(#jsession);
$first_match = $tree->find_by_attribute('name' => 'phpSessionID');
$first_match->dump();
$value = $first_match->attr('value');
chomp($value);
print "$value";

You use look_down (https://metacpan.org/pod/HTML::Element#look_down) from the root element to describe and find the element you want -
#elements = $h->look_down( ...criteria... );
$first_match = $h->look_down( ...criteria... );
This starts at $h and looks thru its
element descendants (in pre-order), looking for elements matching the
criteria you specify. In list context, returns all elements that match
all the given criteria; in scalar context, returns the first such
element (or undef, if nothing matched).
Then use attr (https://metacpan.org/pod/HTML::Element#attr) on the found element to get the attribute value.
$value = $h->attr('attr');
$old_value = $h->attr('attr', $new_value);
Returns (optionally sets) the value of the given attribute of $h. The
attribute name (but not the value, if provided) is forced to
lowercase. If trying to read the value of an attribute not present for
this element, the return value is undef. If setting a new value, the
old value of that attribute is returned.

Related

Return empty strings in woocommerce checkout form

I'd like to return empty strings on all checkout form field but one (the billing_country one).
I already know how to do it with all fields :
add_filter('woocommerce_checkout_get_value','__return_empty_string', 1, 1);
And how to do it with only one field:
add_filter('woocommerce_checkout_get_value','custom_checkout_get_value_ship_ville', 10, 2);
function custom_checkout_get_value_ship_ville( $value, $imput ){
if($imput == 'shipping_city')
$value = '';
return $value;
}
But for all but one ... I'm a little stucked.
I succeed by duplicating and adapting the previous function, but it's a lot of code for just returning empty strings.
I tried with else, elsif, switch and with logical operators, but no result.
So if someone have some clue ...
Thanks
If you want to return empty strings on every value of $imput except for one specific value you need to reverse the comparison of your second code snippet. So instead of comparing wether the $imput is equal to a value you compare wether the $imput is NOT equal to a value.
You can read up on this comparison here: http://php.net/manual/en/language.operators.comparison.php
You can also just return an empty string directly without assigning it to a variable:
add_filter('woocommerce_checkout_get_value','custom_checkout_get_value_ship_ville', 10, 2);
function custom_checkout_get_value_ship_ville( $value, $imput ){
if($imput != 'billing_country') {
return '';
}
}

Net::RBLClient parameter

I'm trying to pass additional RBL's to Net::RBLClient, sample code:-
use Net::RBLClient;
my $rbl = Net::RBLClient->new;
$rbl->lookup('25.23.75.65');
my #listed_by = $rbl->listed_by;
Documentation says that parameters can be passed as hash, however one of then parameter(which I'm trying to use) "lists" says it takes array reference. Couldn't understand how it exactly passed on this module.
I've a array reference like
my $rack = ['bl.spamcop.net', 'sbl.spamhaus.org', 'xbl.spamhaus.org'];
Not sure how this reference included in module construct.
Documentation:- CPAN
By the looks of the docs, the new() method accepts an optional hash as arguments, so pass in the array reference as the value to the lists key.
my $rack = ['bl.spamcop.net', 'sbl.spamhaus.org', 'xbl.spamhaus.org'];
my $rbl = Net::RBLClient->new(lists => $rack);
# then, after the object is created, carry on
$rbl->lookup('211.101.236.160');
my #listed_by = $rbl->listed_by;
You could also add other parameters in the same way if you needed/wanted to on object instantiation:
my $rbl = Net::RBLClient->new(
lists => $rack,
max_time => 10,
timeout => 3,
);
...etc. You could also declare the hash up front, and pass the whole shebang in:
my %params = (
lists => [
$blacklist_1,
$blacklist_2,
],
max_time => 10,
timeout => 3,
);
my $rbl = Net::RBLClient->new(%params);

Perl return list of array refs of unknown length

I have a sub in Perl that needs to return a list of array refs to fit in with the rest of the package. The problem is that I don't know in advance how many array refs I will generate. My usual method of pushing the array refs that I generate into an array and returning a reference to that doesn't work with the rest of the code, which I can't change without breaking some legacy stuff.
sub subTrackTable {
my ($self, $experimentName, $subTrackAttr) = #_;
# return nothing if no subtracks required
if ($subTrackAttr eq 'no_sub') {
return;
}
# get distinct values for subtrack attr (eg antibody) from db
my $dbh = $self->dbh();
my $sh = $dbh->prepare("SELECT DISTINCT * blah sql");
$sh->execute();
my #subtrackTable;
while (my ($term, $value) = $sh->fetchrow_array()) {
my $subtrack = [':$value', $value];
push (#subtrackTable, $subtrack);
}
$sh->finish();
# this is hard-coded for one experiment and does what I want
# Want to loop through #subtrackTable and return a list of all the array refs it contains
# Returning nested array refs doesn't work with external code
return ([":H3K4me3", "H3K4me3"],[":H4K20me3", "H4K20me3"]);
}
The problem is that because I am dynamically getting values from a database, I don't know how many there will be. Just returning \#subtrackTable, which would be my usual strategy breaks the rest of the code. If I knew in advance how many there would be I could also do something like
my $a1 = [":$value1", $value1];
my $a2 = [":$value2", $value2];
...
my $an = [":$valuen", $valuen];
return($a1, $a2,...$an);
but I can't see how to make this work with an unknown number of arrayrefs.
Help appreciated!
It looks like you just need to
return #subtrackTable;
Also, this line
my $subtrack = [':$value', $value];
must be changed to use double quotes, like this
my $subtrack = [ ":$value", $value ];

Convert data type of property for all objects in an array

Say I have an array of objects:
$a = #(
#{ Name = "A"; Value = "2016-01-02" },
#{ Name = "B"; Value = "2016-01-03" },
#{ Name = "C"; Value = "2016-01-04" }
)
The Value property is currently a String. I want to convert the Value property of each object to a DateTime. I could accomplish this with a for loop, but I was wondering if there is a more direct way to do it.
Yes, calculated properties.
$a | select #{N='Name';E={$_.Name}}, #{N='Value';E={ [datetime]$_.Value }}
This will change data type of the first object Value to datetime.
$a[0].value = [datetime]::ParseExact($a[0].value,'yyyy-MM-dd',$null)
And the loop from here :
foreach ($Obj in $a)
{
$Obj.Value = [datetime]::ParseExact($Obj.value,'yyyy-MM-dd',$null)
}
The #TessellatingHeckler 's answer, which you accepted, is not correct for your question! It is only change the representation of the data in the object, but not converted it as you ask. Even if you save it as a new object (or overwrite the original) this will change the object itself. You can see the difference if you run flowing code:
$b=$a | select #{N='Name';E={$_.Name}}, #{N='Value';E={ [datetime]$_.Value }}
#check the original and converted object
$a|gm
$b|gm

How to keep the first parameter value only?

In my Perl Catalyst application, I get the value of a URL parameter like this, typically:
my $val = $c->request->params->{arg} || '';
But the URL could contain multiple arg=$Val. I only want to keep the first value of arg=. I could add this throughout my code:
my $val = $c->request->params->{arg} || '';
$val = $val->[0] if (ref($val) eq 'ARRAY');
That is rather ugly. Is there a way to pick up the first value or a url parameter in a better way?
Does your app actually expect multiple values for parameter arg? If not, all you need is
my $val = $c->request->params->{arg} || '';
Sure, it will be garbage if the user provides you with a garbage url, but there's nothing you can do to prevent the user from giving you garbage.
If it's actually valid to have more than one value for parameter arg, why would you want just the first value? You'd actually want all the values.
sub param_vals {
my ($params, $name) = #_;
return () if !exists($params->{name});
return $params->{$name} if !ref($params->{name});
return #{ $params->{$name} };
}
my #args = param_vals($c->request->{params}, 'arg');
I just read the code to Catalyst::Request but I don't see anything to always pull out a single value. Too bad Cat doesn't use something like Hash::MultiValue!