The variable is not protected - perl

i have this sources
first start.pl
use strict;
use warnings;
use hh;
print "Starting...\n";
my $abc={
VAL=>['alfa','beta'],
STUDENTS=>{
stud1=>{VAL=>['delta','gama']},
stud2=>{VAL=>['omega','upsilon']},
}
};
my $object=hh->new(catalog=>$abc);
and the package
package hh;
use strict;
use warnings;
sub new {
my $class=shift;
my $self={#_};
bless ($self,$class) ;
$self->_initialize("",['BEGIN']);
return $self ;
}
sub _initialize {
my $self=shift;
my $tab=shift;
my $carry=shift;
$tab=$tab."\t|";
if (defined $self->{VAL}){print "$tab Have val=",join(" ",#{$self->{VAL}}),"\n";push(#{$carry},#{$self->{VAL}})}
foreach my $k (sort {lc $a cmp lc $b} keys %{$self}){
print $tab,"carry=",$#{$carry}+1," "," ",$k,"\n";
if (ref($self->{$k}) eq 'HASH'){print "$tab Running initialize pentru $k\n";_initialize($self->{$k},$tab,$carry)}
}
return $self;
}
1;
the output is like this
Starting...
|carry=1 catalog
| Running initialize pentru catalog
| | Have val=alfa beta
| |carry=3 STUDENTS
| | Running initialize pentru STUDENTS
| | |carry=3 stud1
| | | Running initialize pentru stud1
| | | | Have val=delta gama
| | | |carry=5 VAL
| | |carry=5 stud2
| | | Running initialize pentru stud2
| | | | Have val=omega upsilon
| | | |carry=7 VAL
| |carry=7 VAL
Somehow i want to collect into an array the VAL arrays between top of tree and the walked element . Way the last VAL who is in the second level has 7 elements . I want to have only 2 elements (alfa and beta)
this is the expected output
Starting...
|carry=1 catalog
| Running initialize pentru catalog
| | Have val=alfa beta
| |carry=3 STUDENTS
| | Running initialize pentru STUDENTS
| | |carry=3 stud1
| | | Running initialize pentru stud1
| | | | Have val=delta gama
| | | |carry=5 VAL carry=5 (OK)
| | |carry=5 stud2
| | | Running initialize pentru stud2
| | | | Have val=omega upsilon
| | | |carry=7 VAL carry=5 (not ok this need only his values catalog alfa beta omega epsilon)
| |carry=7 VAL not ok (carry 3 only catalog alfa beta)
...

If you want to accumulate only the values in the current branch, you have to pass a copy of the carry array. [#$carry] dereferences the arrayref $carry and creates a new arrayref from the elements. I kept the original reference for the debug print at the end of the function. The more natural way would be to write $carry = [#$carry].
use strict;
use warnings;
package hh;
use Data::Dumper;
sub new {
my $class=shift;
my $self={#_};
bless ($self,$class) ;
$self->_initialize("",['BEGIN']);
return $self ;
}
sub _initialize {
my $self=shift;
my $tab=shift;
my $carry=shift;
$tab=$tab."\t|";
print "$tab _initialize() called with carry "," [",join(', ',#$carry),"]\n";
my $new_carry = [#$carry];
if (defined $self->{VAL}){
print "$tab Have found val=",join(" ",#{$self->{VAL}}),"\n";
print "$tab pushing ",join(" ",#{$self->{VAL}}),"\n";
push(#{$new_carry},#{$self->{VAL}})
}
print $tab," carry=",$#{$new_carry}+1," [",join(', ',#$new_carry),"]\n";
foreach my $k (sort {lc $a cmp lc $b} keys %{$self}){
if (ref($self->{$k}) eq 'HASH'){print "$tab Running initialize pentru $k\n";_initialize($self->{$k},$tab, $new_carry)}
}
print "$tab returning to previous level. carry was "," [",join(', ',#$carry),"]\n";
return $self;
}
package main;
print "Starting...\n";
my $abc={
VAL=>['alfa','beta'],
STUDENTS=>{
stud1=>{VAL=>['delta','gama']},
stud2=>{VAL=>['omega','upsilon']},
}
};
my $object=hh->new(catalog=>$abc);
This prints:
Starting...
| _initialized called with carry [BEGIN]
| carry=1 [BEGIN]
| Running initialize pentru catalog
| | _initialized called with carry [BEGIN]
| | Have found val=alfa beta
| | pushing alfa beta
| | carry=3 [BEGIN, alfa, beta]
| | Running initialize pentru STUDENTS
| | | _initialized called with carry [BEGIN, alfa, beta]
| | | carry=3 [BEGIN, alfa, beta]
| | | Running initialize pentru stud1
| | | | _initialized called with carry [BEGIN, alfa, beta]
| | | | Have found val=delta gama
| | | | pushing delta gama
| | | | carry=5 [BEGIN, alfa, beta, delta, gama]
| | | | returning to previous level. carry was [BEGIN, alfa, beta]
| | | Running initialize pentru stud2
| | | | _initialized called with carry [BEGIN, alfa, beta]
| | | | Have found val=omega upsilon
| | | | pushing omega upsilon
| | | | carry=5 [BEGIN, alfa, beta, omega, upsilon]
| | | | returning to previous level. carry was [BEGIN, alfa, beta]
| | | returning to previous level. carry was [BEGIN, alfa, beta]
| | returning to previous level. carry was [BEGIN]
| returning to previous level. carry was [BEGIN]

Related

Why can memory leaking by cross-reference be solved by explicit reassignment in Perl?

Cross-reference causes memory leaking in Perl like this.
{
my #a = qw(a b c);
my #b = qw(a b c);
# both reference count are 1
push #a, \#b;
# #b reference count is 2(from #b and via #a)
push #b, \#a;
}
# #b reference count is 2(from via #a)
I understand memory leaking by cross-reference in this situation.
But the memory leaking can be resolve by explicit reassignment like this.
{
my #a = qw(a b c);
my #b = qw(a b c);
# both reference count are 1
push #a, \#b;
# #b reference count is 2(from #b and via #a)
push #b, \#a;
#a = ();
}
# why is #b reference count 0?
#a is lexical scope so I think even if there is no reassignment, #a's reference will be invalid but former cause memory leaking and later is not, why?
You start with
#a #b
| ARRAY | ARRAY
| REFCNT=2 | REFCNT=2
+-->+-----------+ +-->+-----------+
| | +-------+ | | | +-------+ |
| | | a | | | | | a | |
| | +-------+ | | | +-------+ |
| | | b | | | | | b | |
| | +-------+ | | | +-------+ |
| | | c | | | | | c | |
| | +-------+ | | | +-------+ |
| | | --------+ | | --------+
| | +-------+ | | +-------+ | |
| +-----------+ +-----------+ |
| |
+---------------------------------------+
If you were to exit the scope here, the reference counts would drop to one, and they would leak.
After #a = ();:
#a #b
| ARRAY | ARRAY
| REFCNT=2 | REFCNT=1
+-->+-----------+ +-->+-----------+
| | | | +-------+ |
| | | | | a | |
| | | | +-------+ |
| | | | | b | |
| | | | +-------+ |
| | | | | c | |
| | | | +-------+ |
| | | | | --------+
| | | | +-------+ | |
| +-----------+ +-----------+ |
| |
+---------------------------------------+
Note that #b's reference count went from two to one.
On scope exit, #a's reference count will drop to one, and #b's reference count will drop to zero.[1] This will free #b, which will cause #a's reference count to drop to zero. And that will free #a.
No cycle, so no memory leak.
At least in theory. In practice, what actually happens is a bit different as an optimization. But those are internal details that aren't relevant here.

PowerShell: Incremental Counter in Foreach Loop

I have a foreach loop that iterates over an Array and calls a function which also has another foreach loop inside with an incremental counter, however it doesn't seem to be working as expected?
Array contents:
| Username | Username2 |
|----------|-----------|
| p1 | p2 |
| p3 | p4 |
Code:
function insertIntoLunchJobs($arrayOfRows) {
$counter = 1
foreach ($i in $arrayOfRows) {
$i
$counter++
$counter
}
}
Output:
| Username | Username2 |
|----------|-----------|
| p1 | p2 |
| 2 | |
| p3 | p4 |
| 2 | |
Desired result:
| Username | Username2 |
|----------|-----------|
| p1 | p2 |
| 2 | |
| p3 | p4 |
| 3 | |
Any ideas?
TIA
I'm literally copy pasting your code. I don't see any errors here:
$arr=#'
Username,Username2
p1,p2
p3,p4
'#|ConvertFrom-Csv
function insertIntoLunchJobs($arrayOfRows) {
$counter = 1
foreach ($i in $arrayOfRows) {
$i
$counter++
$counter
}
}
insertIntoLunchJobs -arrayOfRows $arr

tasklist -v truncation of output

Evidently the Windows dos cmd "tasklist -v " is truncating lines after so many characters.
My perl program is reading in special command processes to compare against processes stored in my database. I am trying to make sure expected processes are running.
Unfortunately the script fails since one of my 50 or so processes is truncated by "tasklist -v".
Is there an alternative command?
Thanks,
Sammy
Following code demonstrates usage of tasklist /fo table command as a pipe input for further processing
Tip: help tasklist
use strict;
use warnings;
my $regex = qr/^(?<name>.*?)\s+(?<pid>\d+)\s+(?<session_name>\S+)\s+(?<session>\d+)\s+(?<mem>.*)/;
$^ = 'STDOUT_TOP';
open my $pipe, 'tasklist /fo table|';
/$regex/ && write for <$pipe>;
close $pipe;
$~ = 'STDOUT_BOTTOM';
write;
exit 0;
format STDOUT_TOP =
+----------------------------------+------------+----------+---------+-----------+
| Name | PID | SessName | Session | Memory |
+----------------------------------+------------+----------+---------+-----------+
.
format STDOUT =
| #<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | #>>>>>>>>> | #<<<<<<< | #>>>>>> | #>>>>>>>> |
$+{name}, $+{pid}, $+{session_name}, $+{session}, $+{mem}
.
format STDOUT_BOTTOM =
+----------------------------------+------------+----------+---------+-----------+
.
Output
+----------------------------------+------------+----------+---------+-----------+
| Name | PID | SessName | Session | Memory |
+----------------------------------+------------+----------+---------+-----------+
| System Idle Process | 0 | Services | 0 | 8 K |
| System | 4 | Services | 0 | 7,452 K |
| Registry | 100 | Services | 0 | 28,664 K |
| smss.exe | 412 | Services | 0 | 368 K |
| csrss.exe | 552 | Services | 0 | 2,256 K |
| csrss.exe | 776 | Console | 1 | 2,496 K |
| wininit.exe | 796 | Services | 0 | 1,420 K |
| winlogon.exe | 860 | Console | 1 | 5,084 K |
| services.exe | 940 | Services | 0 | 5,964 K |
..............
| RuntimeBroker.exe | 7392 | Console | 1 | 8,604 K |
| dwm.exe | 1224 | Console | 1 | 70,144 K |
| chrome.exe | 10580 | Console | 1 | 103,584 K |
| svchost.exe | 12152 | Services | 0 | 7,496 K |
| LockApp.exe | 2620 | Console | 1 | 39,392 K |
| RuntimeBroker.exe | 3104 | Console | 1 | 30,508 K |
| chrome.exe | 452 | Console | 1 | 54,088 K |
| svchost.exe | 7460 | Services | 0 | 7,408 K |
| svchost.exe | 5744 | Services | 0 | 11,540 K |
♀+----------------------------------+------------+----------+---------+-----------+
| Name | PID | SessName | Session | Memory |
+----------------------------------+------------+----------+---------+-----------+
| WmiPrvSE.exe | 6200 | Services | 0 | 10,612 K |
| perl.exe | 2520 | Console | 1 | 8,948 K |
| tasklist.exe | 4808 | Console | 1 | 8,940 K |
+----------------------------------+------------+----------+---------+-----------+

Should Exception::Class objects evaluate to false in boolean context

I'm trying Exception::Class for the first time and something that surprised me is that Exception::Class objects evaluate to true when returned from a function. Shouldn't the default be the opposite.
I know I can change this with overload but I am wondering if it's a good idea
sub gethtml{
return MyException->new( error => 'some error' );
}
my $response = &gethtml
if($response){
#do something with the html
}
else{
#something went wrong check if it's an exception object
}
You're confusing exceptions with returning a false value to indicate an error.
Part of the point of exceptions is that they provide their own channel to indicate error. This leaves return free to only return valid values. There's no need to check for false vs defined, or special objects, or do any per-function call error checking at all. It's all caught and dealt with at the end of the block.
If you return an exception object it defeats the point; they're not exceptions, they're just error codes.
To take advantage of exceptions, the code in your example should be written like this:
sub get_html {
...try to get the html...
return $html if defined $html;
MyException->throw( error => 'some error' );
}
eval {
my $html = get_html;
# do something with $html;
}
if ( my $e = Exception::Class->caught() ) {
...deal with the error...
}
This can be made a bit prettier with Try::Tiny.
This makes more sense when you have to do a lot of things which might error, such as a bunch of file, network or database operations. Look into modules such as autodie and Path::Tiny for how that works.
You should not create one with new and return it. They have a throw method that acts as constructor and die automatically.
use strict;
use warnings;
use Exception::Class qw( InputException HTTPException );
use Try::Tiny;
sub get_html {
my ($url) = #_;
# input validation
InputException->throw(error => 'no URL') unless $url;
my $res = $ua->get($url);
if ($res->is_success) {
# do more stuff with $res;
} else {
HTTPException->throw( error => 'request failed' );
}
}
# ... later
my $url;
try {
get_html($url);
} catch {
# handle the error which is in $_
if ( $_->isa('InputException') ) {
print "You need to supply a URL";
} elsif ( $_->isa('HTTPException') ) {
print "Could not fetch the HTML because the HTTP request failed.\n";
print "But I am not telling you why.";
}
}
You can then go and catch them (use Try::Tiny for that) or simply wrap it in an eval. But basically those exceptions are simple objects. They are intended as the return value of die and get thrown around, so there is no need to return them anywhere.
Once the program dies, all the scopes on the call stack are exited forcefully until you end up in an eval block (which is what catch does). There, you can handle the error. And since that error is an object, you can do fancy stuff with it.
+--------------------------------------------------------------------+
| sub { |
| +----------------------------------------------------------------+ |
| | if () { | |
| | +------------------------------------------------------------+ | |
| | | foo:: sub { | | |
| | | +--------------------------------------------------------+ | | |
| | | | catch { | | | |
| | | | +----------------------------------------------------+ | | | |
| | | | | doo_stuff:: sub { | | | | |
| | | | | +------------------------------------------------+ | | | | |
| | | | | | | | | | | |
| | | | | | MyException->throw ==> die $obj +---------------------------------+
| | | | | | do_more_stuff(); # never executed | | | | | | |
| | | | | | | | | | | | |
| | | | | +------------------------------------------------+ | | | | | |
| | | | +----------------------------------------------------+ | | | | |
| | | | | | | | |
| | | | handle_exception_in_catch($_) <---------------------------------+
| | | | # ( in Try::Tiny the exception ends up in $_ ) | | | |
| | | | | | | |
| | | +--------------------------------------------------------+ | | |
| | +------------------------------------------------------------+ | |
| +----------------------------------------------------------------+ |
+--------------------------------------------------------------------+
Also see the Exception::Class docs.
If you mix exceptions and regular die or Carp croak calls, you will have to do a lot of checking if stuff is blessed before using ->isa. Safe::Isa comes in handy here.
use strict;
use warnings;
use Exception::Class qw( InputException HTTPException );
use Try::Tiny;
use Safe::Isa;
sub get_html {
my ($url) = #_;
# input validation
InputException->throw(error => 'no URL') unless $url;
my $res = $ua->get($url);
if ($res->is_success) {
# do more stuff with $res;
die "There is no answer in this HTML" if $res->decoded_content !~ m/42/;
} else {
HTTPException->throw( error => 'request failed' );
}
}
With this code, the $_->isa('...') would blow up, because in case of the die call, $_ is not an object and you cannot call the method isa on an unblessed reference (or non-reference). Safe::Isa provides a $_isa, which checks for that first and otherwise just returns false.
my $url;
try {
get_html($url);
} catch {
# handle the error which is in $_
if ( $_->$_isa('InputException') ) {
print "You need to supply a URL";
} elsif ( $_->$_isa('HTTPException') ) {
print "Could not fetch the HTML because the HTTP request failed.\n";
print "But I am not telling you why.";
}
}
For details on how that works, see mst's talk You did what?

Per-table constants are not being substituted

Here is my table
| | Name | Vert | Horz | Area | Cost | USD |
|---+-------------+---------+-------+--------+------+-----|
| $ | $price = 75 | $Hi=2.9 | | | | |
| # | Kitchen | 4.160 | 3.630 | #ERROR | | |
| | | | | | | |
| | | | | | | |
| | | | | | | |
#+TBLFM: $5=$4*$Hi*2+$3*$Hi*2
Here is trace output:
Substitution history of formula
Orig: $4*$Hi*2+$3*$Hi*2
$xyz-> $4*(#UNDEFINED_NAME)*2+$3*(#UNDEFINED_NAME)*2
#r$c-> $4*(#UNDEFINED_NAME)*2+$3*(#UNDEFINED_NAME)*2
$1-> (3.630)*(#UNDEFINED_NAME)*2+(4.160)*(#UNDEFINED_NAME)*2
---------^
Error: #'s not allowed in this context
What's wrong? Why $Hi was not substituted?
Ah, found it by myself. Here is wrong row, and the fixed row:
| $ | $price = 75 | $Hi=2.9 | | | | |
| $ | price = 75 | Hi=2.9 | | | | |