trew has asked for the wisdom of the Perl Monks concerning the following question:
I'm trying to delete items from an array without skipping entries when the indexes change. But I keep getting the error:
Can't use an undefined value as an ARRAY reference at line 37
Anybody know why this is a problem?
#! /usr/bin/perl
use DBI;
$dbc= DBI->connect('dbi:Pg:dbname=redacted;host=localhost', 'redacted'
+, '', { AutoCommit=>1, RaiseError=>1, PrintError=>0 });
$sth = $dbc->prepare
("
SELECT
TO_CHAR(SN_EVENTS.CREATED, 'YYYY-MM-DD HH24:MI:SS') AS DATETIM
+ED,
SN_CAMERAS.TYPE AS DIRECTION,
sefs.ocr_1 as OCR
FROM
SN_EVENTS
INNER JOIN sn_events_fusions sefs ON sefs.fk_event = sn_ev
+ents.pk_event
INNER JOIN SN_CAMERAS ON SN_CAMERAS.PK_CAMERA = SN_EVENTS.
+FK_CAMERA
INNER JOIN SN_RULES ON SN_RULES.PK_RULE = SN_EVENTS.FK_RUL
+E
WHERE SN_CAMERAS.TYPE = 'entrance' OR SN_CAMERAS.TYPE = 'exit'
AND SN_RULES.key = 'plate-recognition'
AND SN_EVENTS.FK_EVENT_STATUS = 1
ORDER BY SN_EVENTS.CREATED DESC
");
$sth->execute;
@recordset;
while (@event = $sth->fetchrow_array()){
push @recordset, [@event];
};
for ($i=0; $i<@recordset; $i++){
if (@recordset[$i] && (@recordset[$i]->[1] == "exit")){
for ($j=$i+1; $j<@recordset; $j++){
if (@recordset[$i] && (@recordset[$i]->[2] == @recordset[$
+j]->[2])){
undef @recordset[$j];
}
}
undef @recordset[$i];
}
}
for $row ( @recordset ){
print "@$row\n";
}
Re: Trouble with array of arrays
by AnomalousMonk (Archbishop) on Nov 17, 2014 at 12:41 UTC
|
if (@recordset[$i] && (@recordset[$i]->[1] == "exit")){
...
}
Another change you might consider is to add use warnings; and use strict; (see warnings and strict) at the top of your script. warnings would have warned about a string comparison using the == numeric comparator. The expression @recordset[$i]->[1] == "exit" will only be true if @recordset[$i]->[1] (another warning) or better yet $recordset[$i]->[1] or even $recordset[$i][1] (no warning, but -> is redundant) is 0. (Update: In numeric context, a string like 'exit' or 'foo' or '' evaluates to 0.)
Update 1: Some example code (note: no warnings, but strictures enabled):
c:\@Work\Perl>perl -Mstrict -le
"print 'A: equal' if 0 == 'exit';
print 'B: equal' if 'exit' == 'exit';
print 'C: equal' if 'foo' == 'exit';
print 'D: equal' if 1 == 'exit';
"
A: equal
B: equal
C: equal
Update 2: In many cases, a warning is referred to as an 'error'; there are many examples of this on PerlMonks. But a warning is not an error; it is, well, a warning: something that looks odd to the Perl interpreter and that the interpreter is telling you about because you asked it to. As long as you don't mind having whatever STDERR points to fill up with umpteen warning messages, Perl is perfectly happy to soldier on. There are, however, some cases in which a warning alludes to a serious semantic error, as when 0 or 'foo' is numerically compared to 'exit' and found to be equal! Bottom line, especially if you're a Perl novice: always ask for warnings; always pay close attention to them. (And IMHO, always eliminate their source.)
Update 3: And I should have said this long since: the proper equality operators for string comparison are eq and ne (see Equality Operators in perlop).
| [reply] [d/l] [select] |
Re: Trouble with array of arrays
by pme (Monsignor) on Nov 17, 2014 at 12:58 UTC
|
Hi trew,
You can use refs instead of copying arrays, and hashes to make the code more readable for humans.
The code below is syntactically correct but not tested.
use Data:Dumper;
...
while (my $event = $sth->fetchrow_hashref()) {
push @recordset, $event;
};
$sth->finish;
for (my $i=0; $i<@recordset; $i++) {
if ($recordset[$i]->{DIRECTION} eq "exit") {
for (my $j=$i+1; $j<@recordset; $j++) {
if ($recordset[$i]->{OCR} == $recordset[$j]->{OCR}) {
undef $recordset[$j];
}
}
undef $recordset[$i];
}
}
for my $row ( @recordset ) {
print Dumper($row) . "\n" if defined $row;
}
| [reply] [d/l] |
Re: Trouble with array of arrays
by Loops (Curate) on Nov 17, 2014 at 14:17 UTC
|
Sounds like you have a working solution, but there is still a lot of good advice from the monks above to apply. You could also stop unwanted entries from entering the @recordset array in the first place. For instance you can use a hash to keep track of which items have seen their "exit":
my @recordset;
my %exit;
while ( my @event = fetchrow_array() ) {
$exit{ $event[2] } = 1 if $event[1] eq 'exit';
push @recordset, [ @event ] unless $exit{ $event[2] };
}
| [reply] [d/l] |
Re: Trouble with array of arrays
by trew (Initiate) on Nov 17, 2014 at 12:06 UTC
|
| [reply] [d/l] |
|
It may do what you want, because perl is often smart enough to guess what you meant and not what you said, but you are using the wrong sigils ($, @, %).
$ means "one element" (scalar) and is the equivalent of the english "this", while @ means "several elements" (list, or array), and is the equivalent of the english "these". So when accessing one element from an array, you actually have to write $recordset[$i]. @recordset[$i] is actually a slice. perldata may be a good read. And you would have been warned about that if you had a use warnings; pragma at the top, and use strict; may seem bothersome, but there are very good reasons for the errors it yields, and it does help avoid mistakes.
And you can omit the -> between to sets of [], so $recordset[$i]->[1] is exactly the same thing as $recordset[$i][1];
| [reply] [d/l] [select] |
|
You should turn on warnings and meditate on
Scalar value @recordset[$i] better written as $recordset[$i]
| [reply] [d/l] |
Re: Trouble with array of arrays
by trew (Initiate) on Nov 18, 2014 at 09:27 UTC
|
Thank you everyone, very much appreciate all the assistance. Turns out the code in fact wasn't working correctly after all.
Especially thanks to 'Loops' for the suggestion of using a hash to track exits. I had been worrying about loading the whole dataset into program memory and this suggestion resolved that.
Finally ended up with the following - probably not perfect but it is definitely working and thoroughly tested. It does seem to have been an awful lot of effort for a relatively trivial program, but I suppose you have to expect that when you're trying to learn a new language.
#! /usr/bin/perl
use DBI;
$dbc= DBI->connect('dbi:Pg:dbname=redacted;host=localhost', 'redacted'
+, '', { AutoCommit=>1, RaiseError=>1, PrintError=>0 });
$sth = $dbc->prepare
("
SELECT
TO_CHAR(SN_EVENTS.CREATED, 'YYYY-MM-DD HH24:MI:SS') AS DAT
+ETIMED,
SN_CAMERAS.TYPE AS DIRECTION,
sefs.ocr_1 as OCR
FROM
SN_EVENTS
INNER JOIN sn_events_fusions sefs ON sefs.fk_event = s
+n_events.pk_event
INNER JOIN SN_CAMERAS ON SN_CAMERAS.PK_CAMERA = SN_EVE
+NTS.FK_CAMERA
INNER JOIN SN_RULES ON SN_RULES.PK_RULE = SN_EVENTS.FK
+_RULE
WHERE SN_CAMERAS.TYPE = 'entrance' OR SN_CAMERAS.TYPE = 'exit'
AND SN_RULES.key = 'plate-recognition'
AND SN_EVENTS.FK_EVENT_STATUS = 1
ORDER BY SN_EVENTS.CREATED DESC
");
$sth->execute or die $sth->errstr;
while (@event = $sth->fetchrow_array()){
if ($event[1] eq "exit"){
$exited{$event[2]}=1;
}
if (not $exited{$event[2]}){
push @recordset, [@event];
}
};
$sth->finish;
reverse(@recordset);
for $row ( @recordset ){
print "@$row\n";
}
| [reply] [d/l] |
|
|