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!
Related
I have a simple page hit tracking script that allows for the output to display friendly names instead of urls by using a hash.
UPDATE: I used php to generate the hash below, but used the wrong dynamic page name of item.html. When changed to the correct name, the script returns the desired results. Sorry for wasting anyone's time.
my %LocalAddressTitlePairs = (
'https://www.mywebsite.com/index.html' => 'HOME',
'https://www.mywebsite.com/art_gallery.html' => 'GALLERY',
'https://www.mywebsite.com/cart/item.html?itemID=83&cat=26' => 'Island Life',
'https://www.mywebsite.com/cart/item.html?itemID=11&cat=22' => 'Castaways',
'https://www.mywebsite.com/cart/item.html?itemID=13&cat=29' => 'Pelicans',
and so on..
);
The code for returning the page hits:
sub url_format {
local $_ = $_[0] || '';
if ((m!$PREF{'My_Web_Address'}!i) and (m!^https://(.*)!i) ) {
if ($UseLocalAddressTitlePairs == 1) {
foreach my $Address (keys %LocalAddressTitlePairs) {
return "<a title=\"$Address\" href=\"$_\">$LocalAddressTitlePairs{$Address}</A>" if (m!$_$! eq m!$Address$!);
}
}
my $stub =$1;
return $stub;
}
}
Displaying the log hits will show
HOME with the correct link, GALLERY with the correct url link, but https://www.mywebsite.com/cart/item.html?itemID=83&cat=26
will display a random name instead of what it should be, Island Life for this page.. it has the correct link,-- a different name displays every time the page is loaded.
And, the output for all pages with query strings will display the exact same name. I know the links are correct by clicking thru site pages and checking the log script for my own page visits.
I tried -
while (my($mykey, $Value) = each %LocalAddressTitlePairs) {
return "<a title=\"$mykey\" href=\"$_\">$Value</a>" if(m!$_$! eq m!$mykey$!);
but again, the link is correct but the mykey/Value associated is random too. Way too new to perl to figure this out but I'm doing a lot of online research.
m!$Address$! does not work as expected, because the expression contains special characters such as ?
You need to add escape sequences \Q and \E
m!\Q$Address\E$!
it’s even better to add a check at the beginning of the line, otherwise
my $url = "https://www.mywebsite.com/?foo=bar"
my $bad_url = "https://bad.com?u=https://www.mywebsite.com/?foo=bar"
$bad_url =~ m!\Q$url\E$! ? 1 : 0 # 1, pass
$bad_url =~ m!^\Q$url\E$! ? 1 : 0 # 0, fail
I have a string that looks something like this:
$string = "property1.property2.property3"
And I have an object, we'll call $object. If I try to do $object.$string it doesn't interpret it that I want property3 of property2 of property1 of $object, it thinks I want $object."property1.property2.property3".
Obviously, using split('.') is where I need to be looking, but I don't know how to do it if I have an unknown amount of properties. I can't statically do:
$split = $string.split('.')
$object.$split[0].$split[1].$split[2]
That doesn't work because I don't know how many properties are going to be in the string. So how do I stitch it together off of n amounts of properties in the string?
A simple cheater way to do this would be to use Invoke-Expression. It will build the string and execute it in the same way as if you typed it yourself.
$string = "property1.property2.property3"
Invoke-Expression "`$object.$string"
You need to escape the first $ since we don't want that expanded at the same time as $string. Typical warning: Beware of malicious code execution when using Invoke-Expression since it can do anything you want it to.
In order to avoid this you would have to build a recursive function that would take the current position in the object and pass it the next breadcrumb.
Function Get-NestedObject{
param(
# The object we are going to return a propery from
$object,
# The property we are going to return
$property,
# The root object we are starting from.
$rootObject
)
# If the object passed is null then it means we are on the first pass so
# return the $property of the $rootObject.
if($object){
return $object.$property
} else {
return $rootObject.$property
}
}
# The property breadcrumbs
$string = '"Directory Mappings"."SSRS Reports"'
# sp
$delimetedString = $String.Split(".")
$nestedObject = $null
Foreach($breadCrumb in $delimetedString){
$nestedObject = Get-NestedObject $nestedObject $breadcrumb $settings
}
$nestedObject
There are some obvious places where that function could be hardened and documented better but that should give you an idea of what you could do.
What's the use case here? You can split the string as you've described. This will create an array, and you can count the number of elements in the array so that n is known.
$string = "property1.property2.property3"
$split = $string.split('.')
foreach($i in 0..($split.Count -1)){
Write-Host "Element $i is equal to $($split[$i])"
$myString += $split[$i]
}
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 ];
I have the code below:
my $content = $response->decoded_content((charset => 'UTF-8'));
my $feed = XML::Feed->parse(\$content) || $logger->error("When retrieving $URL: ", XML::Feed->errstr);
if (defined $feed) {
for my $entry ($feed->entries) {
#DO SOMETHING
}
}
For some site, XML::FEED saying that it can't detect the feed type. This is something I have to look at but this is not my question at the moment.
This sample code is inside a while loop has I'm retrieving different RSS and I would like to have the script running even when some URLs failed.
The defined function seems to not work as I get the error message:
Can't call method "entries" without a package or object reference
Can someone tell me what is the right way to handle the test?
You first have to check the value of $feed.
The error message you describe is obvious: $feed is not a package / object reference, but it can be a simple hash for instance. So it's defined.
Add my favourite debugging line right in front of if(defined):
warn Data::Dumper->new([ $feed ],[ '*feed' ])->Sortkeys(1)->Dump();use Data::Dumper;
and you'll see the value in a nice way.
Without testing I'd say that $feed contains the result of your logger, which might be 1 or 0 or something like that, because you set the value of $feed to XML::Feed->parse, and if this is not successful (undefined) it's the result of $logger->error.
You'd better write it like:
my $feed = XML::Feed->parse(\$content);
if (defined $feed) {
for my $entry ($feed->entries) {
#DO SOMETHING
}
}
else {
$logger->error("When retrieving $URL: ", XML::Feed->errstr);
}
because parse is said to return an object, and I guess it returns undef on error.
The error message means what it says: $feed is neither a package nor an object reference. It passes the defined test because there are many defined values which are neither packages nor object references.
In this particular case, you're seeing this error because you are misuing ||:
my $feed = XML::Feed->parse(\$content) || $logger->error("When retrieving $URL: ", XML::Feed->errstr);
If the parse call should fail and return undef, this evaluates to
my $feed = ( undef || $logger->error("When retrieving $URL: ", XML::Feed->errstr) );
which evaluates to
my $feed = $logger->error("When retrieving $URL: ", XML::Feed->errstr);
. The return value of $logger->error is unknown to me, but presumably it is neither a package nor an object reference. And if it were one, it probably would be the wrong one to put in a variable named $feed.
The documentation for XML::Feed mentions parsing with a construct like
my $feed = XML::Feed->parse(URI->new('http://example.com/atom.xml'))
or die XML::Feed->errstr;
This is not the same thing. Their respective precedence rules make || and or suitable for different applications; specifically, you should only use || when you want the value on the right-hand side for something. Do not use it only for the short-circuit side effect.
You can solve this by replacing the || with or to get the right evaluation order. While you are there, you probably should also eliminate the redundant defined test.
So I'm using a basic formmail script. Within the script I'm using a redirect variable. The value of the redirect is something like:
http://www.mysite.com/NewOLS_GCUK_EN/bling.aspx?BC=GCUK&IBC=CSEE&SIBC=CSEE
When the redirect action happens however, the URL appears in the browser as:
http://www.mysite.com/NewOLS_GCUK_EN/bling.aspx?BC=GCUK&IBC=CSEE&SIBC=CSEE
You can see the & characters are replaced with &
Is there any way to fix this?
Maybe you can edit the script with a string substitution:
$myRedirectURL =~ s/\&/\&/g;
Or perhaps look in the script where the opposite substitution is taking place, and comment out that step.
HTML::Entities's decode_entities could decode this for you:
$redirect_target = decode_entities($redirect_target);
But passing the destination URL as HTTP argument (e.g. hidden form field) is dangerous (as #Sinan Ünür already said in the comments). Better store the target URL within your script and pass a selector from the form:
if ($selector eq 'home') { $target_url = 'http://www.foo.bar/'; }
elsif ($selector eq 'bling') { $target_url = 'http://www.foo.bar/NewOLS_GCUK_EN/bling.aspx'; }
else {
$target_url = 'http://www.foo.bar/default.html'; # Fallback/default value
}
Using a Hash would be shorter:
my %targets = {
home => 'http://www.foo.bar/',
bling => '/NewOLS_GCUK_EN/bling.aspx',
};
$target_url = $targets{$selector} || '/default_feedback_thanks.html';