How would I scope to this variable depending on a conditional of papertype?
I have tried it several ways and I am getting errors and I am befuddled.
sub paperdisplay_getPaperLink {
my ( $self, $args ) = #_;
my $paper = $args->{paper};
my $linktext = $args->{linktext};
my $session = $args->{session};
my $query = $self->request;
my $password = $query->param('password');
if ( $paper->{Type} eq 'Break' ) {
my $url = $something;
} else {
my $url = $somethingelse;
}
my $link = qq(<a title="$linktext" target="other" href="$url">$linktext</a>);
return $link;
}
You have to declare it in the block you want to use it in. If you declare it inside the if or else block, it'll only exist there. The variable would be destroyed when the block ends.
my $url;
if ($paper->{Type} eq 'Break') {
$url = $something
} else {
$url = $somethingelse
}
# $url still exists down here
Use the Conditional Operator to initialize a variable without the need for an if block:
my $url = $paper->{Type} eq 'Break'
? $something
: $somethingelse;
Related
I'm trying to pass parameters in a URL. I don't know what's missing, I tried to see how the URL looks after executing this script.
my $request3 = HTTP::Request->new(GET => $sql_activation);
my $useragent = LWP::UserAgent->new();
$useragent->timeout(10);
my $response2 = $useragent->request($request3);
if ($response2->is_success) {
my $res2 = $response2->content;
if ($res =~ m/[#](.*):(.*)[#]/g) {
my ($key, $username) = ($1, $2);
print "[+] $username:$key \n\n";
}
else {
print "[-] Error \n\n";
}
}
my $link =
"http://localhost/wordpress/wp-login.php?action=rp&key="
. $key
. "&login="
. $username;
sub post_url {
my ($link, $formref) = #_;
my $ua = new LWP::UserAgent(timeout => 300);
$ua->agent('perlproc/1.0');
my $get = $ua->post($link, $formref);
if ($get->is_success) {
print "worked \n";
}
else {
print "Failed \n";
}
}
After executing the script the URL is like this
site/wordpress/wp-login.php?action=rp&key=&login=
Perl has block level scope. You define $key and $username in the block following an if statement. They don't live beyond that.
You need to create them (with my) before that block.
# HERE
my ( $key, $username );
if ( $response2->is_success ) {
my $res2 = $response2->content;
if ( $res =~ m/[#](.*):(.*)[#]/g ) {
# Don't say my again
( $key, $username ) = ( $1, $2 );
}
else { print "[-] Error \n\n"; }
}
$description is Input from a yaml file of format
main_key:
-
key1:value2
key2:value2
-
key1:value1
key2:value2
Basically that is a hash of array of hashes.
I input $description and process the inner hash as follows:
while ( my ( $mod, $defined ) = each %{ $description } ) {
my $index = 0;
foreach ( #{ $defined } ) {
while ( my ( $key, $value ) = each %{ $_ } ) {
process ( $key, $mod, $description, $index );
}
$index = $index + 1;
}
}
When certain 'keyword' is used as a key I replace add more key,value pairs to the inner hash
function1() and function2() return a hash pointer.
sub process {
my ( $key, $mod, $description, $index ) = #_;
my $parameters;
if ( $key eq 'keyword' ) {
$parameters = function1( );
}
else {
$parameters = function2( );
}
$description->{$mod}[$index] = { %$parameters, %{$description->{$mod}[$index]} };
}
The issue here is that "while ( my ( $key, $value ) = each %{ $_ } )" in the main code runs forever, using the same key and value over and over again.
Yeah. Don't do that.
Never modify a hash while looping over it. From perldoc -f each:
If you add or delete a hash's elements while iterating over it,
entries may be skipped or duplicated--so don't do that.
The general pattern is to build up the list of modifications, and then make them after the end of the loop. You can, of course, embed that sequence in an outer loop that iterates over the hash until there are no more modifications that need to be made.
This refactoring of your code works fine. I have rewritten process to do all that is necessary for the innermost hashes. I have named these $item as I don't know what they are supposed to represent. Please amend this to something more descriptive.
There never was any reason to pass all those parameters, as the values of $description, $mod, and $index were only used to locate the hash in question using $description->{$mod}[$index] so it may as well have been passed directly as a reference, which is what I do. In addition, because process now loops over the array contents there is no need to pass $key either, so the subroutine now has just one parameter.
Each element of $item is examined, and the new hash of data to be added for that element is obtained from function1 or function2 as appropriate and pushed onto #params instead of being inserted straight away.
Once all the new values have been established, they are all added into $item and the process is complete.
for my $defined (values %$description) {
process($_) for #$defined;
}
sub process {
my ($item) = #_;
my #params;
for my $key (keys %$item) {
push #params, $key eq 'keyword' ? function1() : function2();
}
for my $params (#params) {
#{$item}{keys %$params} = values %{$params};
}
}
There's a bunch out there, as Perl is a pretty sugary language, but the most used statements in any language is the combination of if statements and setting values. I think I've found many of them, but there's still a few gaps. Ultimately, the goal would be to not have to write a variable name more than once:
Here's what I have so far:
$r ||= $s; # $r = $s unless ($r);
$r //= $s; # $r = $s unless (defined $r);
$r &&= $s; # $r = $s if ($r);
$r = $c ? $s : $t; # if ($c) { $r = $s } else { $r = $t }
$c ? $r : $s = $t; # if ($c) { $r = $t } else { $s = $t }
$r = $s || $t; # if ($s) { $r = $s } else { $r = $t }
$r = $s && $t; # if ($s) { $r = $t } else { $r = $s = undef, 0, untrue, etc. }
$c and return $r; # return $r if ($c);
$c or return $r; # return $r unless ($c);
$c and $r = $s; # $r = $s if ($c);
#$r{qw(a b c d)} # ($r->{a}, $r->{b}, $r->{c}, $r->{d})
Somebody also had a really interesting article on a "secret operator", shown here:
my #part = (
'http://example.net/app',
( 'admin' ) x!! $is_admin_link,
( $subsite ) x!! defined $subsite,
$mode,
( $id ) x!! defined $id,
( $submode ) x!! defined $submode,
);
However, what I've found to be missing from the list is:
$r <= $s; # read as "$r = min($r, $s);" except with short-circuiting
$r = $s if (defined $s); # what's the opposite of //?
$r and return $r # can that be done without repeating $r?
Is there anything else worth adding? What other conditional set variables are available to reduce the code? What else is missing?
These structures from your question could be written a little bit more clearly using the low precedence and and or keywords:
$c and return $r; # return $r if ($c);
$c or return $r; # return $r unless ($c);
$c and $r = $s; # $r = $s if ($c);
The nice thing about and and or is that unlike the statement modifier control words, and and or can be chained into compound expressions.
Another useful tool for syntactic sugar is using the for/foreach loop as a topicalizer over a single value. Consider the following:
$var = $new_value if defined $new_value;
vs
defined and $var = $_ for $new_value;
or things like:
$foo = "[$foo]";
$bar = "[$bar]";
$_ = "[$_]" for $foo, $bar;
the map function can also be used in this manner, and has a return value you can use.
There's also the left hand side ternary operator:
$cond ? $var1 : $var2 = "the value";
is equivalent to:
if ($cond) {
$var1 = "the value";
} else {
$var2 = "the value";
}
$r = $r < $s ? $r : $s;:
$r = $s if $r > $s;
or
use List::Util qw( min );
$r = min($r, $s);
or:
sub min_inplace {
my $min_ref = \shift;
for (#_) { $$min_ref = $_ if $$min_ref > $_; }
}
min_inplace($r, $s);
$r = $s if (defined $s);:
$r = $s // $r;
$r = $t; $r = $s if (defined $s);:
$r = $s // $t;
$r = !$s ? $s : $t;:
$r = $s && $t;
One of the biggest called for features in Perl was the switch statement. This finally appeared in Perl 5.10. I'm just using the example from the documentation:
use feature qw(say switch); #My preference
#use feature ":5.10"; #This does both "say" and "switch"
[...]
given($foo) {
when (undef) {
say '$foo is undefined';
}
when ("foo") {
say '$foo is the string "foo"';
}
when ([1,3,5,7,9]) {
say '$foo is an odd digit';
continue; # Fall through
}
when ($_ < 100) {
say '$foo is numerically less than 100';
}
when (\&complicated_check) {
say 'a complicated check for $foo is true';
}
default {
die q(I don't know what to do with $foo);
}
}
Why o' why did they go with given/when and not switch/case like you find in most languages is a mystery to me. And, why if the statement is given/when, do you specify it in use features as switch?
Alas, the people who made these decisions are at a higher plane than I am, so I have no right to even question these luminaries.
I avoid the more exotic stuff, and stick with the easiest to understand syntax. Imagine the person who has to go through your code and find a bug of add a feature, which would be easier for that person to understand:
$r &&= $s;
or
if ($r) {
$r = $s;
}
And, maybe I might realize that I really meant:
if (not defined $r) {
$r = $s;
}
And, in this case, I might even say:
$r = $s if not defined $r;
Although I don't usually like post-fixed if statements because people tend to miss the if part when glancing through the code.
Perl is compiled at runtime, and the compiler is fairly efficient. So, even though it's way cooler to write $r &&= $s and it earns it earns you more geek points and is less to type, it doesn't execute any faster. The biggest amount of time spent on code is on maintaining it, so I'd rather skip the fancy stuff and go for readability.
By the way, when I think of syntactic sugar, I think of things added to the language to improve readability. A great example is the -> operator:
${${${$employee_ref}[0]}{phone}}[0];
vs.
$employee_ref->[0]->{phone}->[0];
Of course, if you're storing data as a reference to a list to a hash to a list, you are probably better off using object oriented coding.
There's also:
$hash{$key||'foo'} = 1; # if($key) { $hash{$key} = 1 } else { $hash{'foo'} = 1 }
my $Parser = new MIME::Parser;
my $entity = $Parser->parse_data( $body );
my #parts = $entity->parts;
for $part(#parts){
my $type=$part->mime_type;
my $bhandle=$part->bodyhandle;
$header = $part->head();
$content_disp = $header->get('Content-Disposition');
if ($type =~ /text/i){
$bodydata = "";
if (my $io = $part->open("r")) {
while (defined($_ = $io->getline)) {
$bodydata .= $_;
}
$io->close;
print $bodydata;
}
}
}
I think you're looking for the recommended_filename method:
$header = $part->head();
$filename = $header->recommended_filename;
Be sure to check the return value for sanity. Note that it can also be undef.
I'm trying to save a reference to a string in a class variable.
I wish to access this variable by dereferencing it.
For example in the routine getHeaders instead of using:
my $fileContentsRef = $this->getFileContent;
my $fileContentsRef1 = $$fileContentsRef;
$fileContentsRef1 =~ /Spaltenname.*?Datentyp.*?---\n(.*?)\n\n/gsmi;
I would like to use:
my $fileContentsRef = $this->getFileContent;
$$fileContentsRef =~ /Spaltenname.*?Datentyp.*?---\n(.*?)\n\n/gsmi;
For more details you should see the code at the end.
My problem is, that the program doesn't work when I don't work with the copy( i.e when I don't use $fileContentsRef1). What am I doing / getting wrong? Is it possible to reach the goal in the way I described? Could some give me clues how?
open FILE, "a1.bad";
$file_contents .= do { local $/; <FILE> };
close FILE;
my $log = auswerter->new(\$file_contents);
#-----------------------------------------------------------------
# Subs
#-----------------------------------------------------------------
# CONSTRUCTOR
sub new
{
my $fileRef = $_[1];
my $self = {};
bless $self;
$self->initialize();
if($fileRef) { $self->{fileRef} = $fileRef; }
return $self;
}
sub initialize
{
#-----------------------------------------------------------------
# Configuration
#-----------------------------------------------------------------
my $this = shift;
}
sub setFile {
my $this = shift;
$this->{file} = shift;
}
sub getFileContent
{
my $this = shift;
return $this->{fileRef};
}
sub getHeaders
{
print "HEADERS...\n";
my $this = shift;
my #headers = ();
my $fileContentsRef = $this->getFileContent;
my $fileContentsRef1 = $$fileContentsRef;
$fileContentsRef1 =~ /Spaltenname.*?Datentyp.*?---\n(.*?)\n\n/gsmi;
#headers = split ("\n", $1 );
foreach (#headers)
{
$_ =~ s/^(.*?)\s.*/$1/;
}
return \#headers;
}
sub getErrList
{
print "ERR LIST...\n";
my $this = shift;
my #errors = ();
my $fileContentsRef = $this->getFileContent;
my $fileContentsRef1 = $$fileContentsRef;
$fileContentsRef1 =~ /Spaltenname.*?(Satz.*)ORA.*?^Tabelle/gsmi;
return \#errors if !$1;
#errors = split ("\n\n", $1 );
foreach (#errors)
{
$_ =~ s/.*Spalte (.*?)\..*/$1/msgi;
}
return \#errors;
}
sub getEntries
{
my $this = shift;
my #entries = ();
my $fileContentsRef = $this->getFileContent;
my $fileContentsRef1 = $$fileContentsRef;
$fileContentsRef1 =~ /.*==\n(.*)/gsmi;
#entries = split ("\n", $1 );
return \#entries;
}
sub sqlldrAnalyze
{
my $this = shift;
my $token = shift;
my $errRef =$this->getErrList();
return "" if $#$errRef < 0 ;
my $headersRef = $this->getHeaders();
my $entriesRef = $this->getEntries();
my $i = 0;
my $str = "";
$str = "<html>";
$str .= "<table rules=\"all\">";
$str .= "<tr>";
foreach ( #$headersRef)
{
$str .= "<th>".$_."</th>";
}
$str .= "</tr>";
foreach ( #$entriesRef)
{
my #errOffset = grep { $headersRef->[$_] =~ $errRef->[$i] }0..$#$headersRef ;
my #entries = split($token, $_);
$str .= "<tr>";
foreach (my $j =0; $j <= $#entries;$j++)
{
$str .= "<td nowrap";
$str .= " style=\"background-color: red\"" if $j == $errOffset[0];;
$str .= ">";
$str .= "<b>" if $j == $errOffset[0];
$str .= $entries[$j];
$str .= "</b>" if $j == $errOffset[0];
$str .= "</td>";
}
$str .= "</tr>\n";
$i++;
}
$str .= "</table>";
$str .= "</html>";
return $str;
}
return 1;
When you call your class->new(...) constructor with a filename argument, the new subroutine gets the class name as the first argument, and the filename as the second argument.
In your constructor, you are simply copying the value of $_[1] (the filename) into $self->{FileRef}, but that value is not a reference.
So when you access it, there is no need to use a doubled sigil to dereference the value.
You should run all of your code with the following two lines at the top, which will catch many errors for you (including trying to use strings as references when they are not references):
use strict;
use warnings;
These two lines basically move Perl out of quick one-liner mode, and into a mode more suitable for large development (improved type safety, static variable name checking, and others).
Per the update: If the code you have is working properly when copying the string, but not when dereferencing it directly, it sounds like you may be running into an issue of the string reference preserving the last match position (the g flag).
Try running the following:
my $fileContentsRef = $this->getFileContent;
pos($$fileContentsRef) = 0; # reset the match position
$$fileContentsRef =~ /Spaltenname.*?Datentyp.*?---\n(.*?)\n\n/gsmi;