Strange issue with arrays

[Mushy-pea]

Hello everyone. I'm still working on that forum system I mentioned a bit ago (perlBB). Hopefully it'll be ready for Christmas :p . However, I ran into a strange problem while I was re-writing parts the two functions below.

sub enter_post {
my(@field, $input, $offset1, $offset2, $n, $name, $field_length, $flag_guest, $flag_verify, @data, $lockfile, $output, $write_length, $write_length2, $post_id, $post_num, $dbase, $chunk, $chunk2, $num_links, $link, $num_replies, $offset_last, $result_all, @stat, @date, $check, $link_check, $dbase, @offset_ext, $flag_reply, @week_day, $num_records, @expected_names, @max_length, @link_info); @expected_names = ("enter_post    $conf::password", "username", "password", "subject", "content", "flag_reply", "thread_id"); @max_length = (4, 14, 14, 48, 8000, 3, 10);
$offset1 = 0; $post_num = 0; $chunk = ""; @week_day = ("", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"); print "\nenter_post()";
&process_form(\@field, 7, 1, @expected_names, @max_length);
$check = ($field[5] eq "no" && $field[6] ne "null");
unless ($check == 0) {&security_alert("Form field conflict.", 1, 0)}
$check = ($field[5] eq "yes" && $field[6] eq "null");
unless ($check == 0) {&security_alert("Form field conflict.", 2, 0)}
if ($field[2] eq "null") {$flag_verify = 1;}
else
{
$flag_verify = &verify_user(@field);
}
@stat = stat($conf::MESSAGE_DB);
$lockfile = "lockfile3.txt";
while (-e $lockfile) {sleep 1;}
open(LOCK, $lockfile);
close(LOCK);
open(file8, "+<", $conf::MESSAGE_DB) || die("Unable to open $conf::MESSAGE_DB for writing.  $!");
@data = <file8>;
if ($field[5] eq "yes")
{
$flag_reply = 1;
@link_info = &update_links(@field, $link, @stat, \@data);
}
elsif ($field[5] eq "no") {$field[6] = &new_thread; $flag_reply = 0;}
else {&security_alert("Invalid form value.", 3, 0)}
unless ($flag_verify == 1) {&security_alert("User privalidges violation.", 4, 0)}
@date = localtime(time);
$date[5] = 1900 + $date[5];
unless (length($date[1]) == 2) {
$date[1] =~ s/[0-9]/0\$date[1]/;
}
$date[9] = "$week_day[$date[6]] $date[3]/$date[4]/$date[5] at $date[2]:$date[1]";
unless ($flag_reply == 1) {$chunk = "<links>$conf::LINK_DEFAULT_FILL</links>";}
$output = "<record><record length>####</record length>$chunk<post_id>$field[6]</post_id><subject>$field[3]</subject><author>$field[1]</author><date+time>$date[9]</date+time><content>$field[4]</content></record></database>";
$write_length = length($output);
$output =~ s/\#\#\#\#/$write_length/;
$write_length2 = length($output);
unless ($write_length == $write_length2) {
$output =~ s/[0-9]{$write_length2}/$write_length2/;
}
$offset_last = $stat[7] - 11;
truncate(file8, $offset_last);
seek(file8, $offset_last, 0);
print file8 $output;
unless ($flag_reply == 0)
{
seek(file8, $link_info[1], 0);
print file8 $link_info[0];
}
$dbase = join("", @data);
$dbase =~ /<database records=([0-9]*)/;
$offset1 = index($dbase, "<database records=") + 18;
$num_records = $1 + 1;
seek(file8, $offset1, 0);
print file8 $num_records;
close(file8);
unlink($lockfile);
$main::QUERY_STRING = "view_post=$field[6]";
&update_list(0, @field, $flag_reply, @date, $field[5]);
&view_post;
}

sub process_form {
my($field, @expected_names, @given_names, @max_length, $num_fields, $status, $m, $n, @input1, @block1, @block2, $original_field, $length, $code, $code1, $code2, $code3, $offset1, $offset2, $count, $var, $result, $replace, $input, $flag_done); $flag_done = 0; $m = 1; $offset1 = 0; ($field, $num_fields, $status, @expected_names, @max_length) = @_; print "\nmax_length: @max_length"; print "\nexpected_names: @expected_names";
if ($conf::environment eq "localhost") {$input = $main::QUERY_STRING; print "\ninput: $input";}
elsif ($conf::environment eq "server") {$input = <STDIN>}
@block1 = split(/&/, $input, $num_fields);
for ($n = 0; $n < $num_fields; $n++)
{
unless ($block1[$n] =~ /={1}/) {&security_alert("Invalid form caught.", 2, 1)}
$block1[$n] =~ /([^=]*)([.]*)/;
if ($1 eq $expected_names[$n])
{
$given_names[$n] = $1;
$block1[$n] = reverse($block1[$n]);
$block1[$n] =~ /([^=]*)([.]*)/;
@$field[$n] = $1;
unless (length(@$field[$n]) <= $max_length[$n]) {&security_alert("Invalid form caught.", $max_length[$n], length(@$field[$n]))}
$original_field = reverse(@$field[$n]); @$field[$n] = "";
@block2 = split(/[\+<>]/, $original_field);
$count = 1;
foreach (@block2) {
if ($count == 1) {@$field[$n] = @$field[$n] . $_;}
else {
@$field[$n] = @$field[$n] . " " . $_;
}
$count++;
}
$original_field = @$field[$n]; @$field[$n] = "";
@block2 = split(/%/, $original_field);
$count = 1;
foreach (@block2) {
if ($count == 1) {@$field[$n] = @$field[$n] . $_;}
else {
@$field[$n] = @$field[$n] . pack("c", hex(substr($_, 0, 2))) . substr($_, 2);
}
$count++;
}
unless ($n != 6) {chop(@$field[$n]);}
}
else {&security_alert("Invalid form caught", $expected_names[$n], $given_names[$n])}
}
}

Sorry it's long. Problem is with the @expected_names and @max_length arrays passed between the two subs. You'll notice I've made the second sub print out these arrays for debuging. The result is

max_length:
expected_names: enter_post    mariA8743 username password subject content flag_reply thread_id 4 14 14 48 8000 3 10

which makes it look like one array has been emptied and it's contents added to the end of the other one (which makes no sense to me). Could anyone tell me if I've made some stupid mistake here or if this looks like a bug in the interpreter to you? Any help appriciated.

Steven.

[KevinADC]

It may seem strange to you, but thats because you don't understand what is happening. Whenever you send anything in the system array to a sub routine or function the list becomes "flattened". This means that where one list ends and another begins is lost, and it becomes one long list, as you experience.

See this page:

http://perldoc.perl.org/perlsub.html#Pass-by-Reference-pass-by-reference-pass-by-reference-reference

But you have a bigger problem, you are not using "strict" with your perl program. All perl programs should use:

use warnings;
use strict;

[Mushy-pea]

Ah, I see. However, I am actually using strict in this program. I only posted a snippit of code so that can't be seen. At the top of the code you would find:

#!/usr/bin/perl -wT

use strict;

Which I think is equivalent to what you are suggesting.

Steven.

[KevinADC]

OK, that is fine, it's just a bit funky how you start a block and then declare all the variables in one line at the beginning which through me off:

my($field, @expected_names, @given_names, @max_length, $num_fields, $status, $m, $n, @input1, @block1, @block2, $original_field, $length, $code, $code1, $code2, $code3, $offset1, $offset2, $count, $var, $result, $replace, $input, $flag_done);

that seems quite lazy to me and will probably make maintenance harder.

[swampyankee]

Ah, I see. However, I am actually using strict in this program. I only posted a snippit of code so that can't be seen. At the top of the code you would find:

#!/usr/bin/perl -wT

use strict;

Which I think is equivalent to what you are suggesting.

Steven.

If you have something like this:

@x = sub(@y, @z);

The subroutine loses @y and @z; they get joined together:

push(@_, (@y, @z));

Similarly, if you return like this:

return @x, @y;

they get mushed together.

To guarantee they remain separate, return array references:

return \@x, \@y;

and, similarly, pass array references into a sub:

@z = sub(\@y, \@z);

sub sub{

my @q = @ { $_[0]};
my @r = @ { $_[1]};