my $query = "SELECT location FROM demstock2 WHERE ds_id=$main";
my $sth   = $db->prepare($query);
$sth->execute or print "Can't execute <pre>$query</pre>: " . $db->errs
+tr . "<br>\n";
[download]

my $query = "SELECT location FROM demstock2 WHERE ds_id=?";
my $sth   = $db->prepare($query);
$sth->execute( $main ) or print "Can't execute <pre>$query</pre>: " . 
+$db->errstr . "<br>\n";
[download]

Now, as for other aspects:

• You have if ( $action ) { then if ($action eq "BOND") I will presume that you have several possible actions and you're only distilling down here. Even in this case you are (correctly) checking for allowed actions, so the cases where $action isn't set and where $action isn't a valid action distill to the same entry. You can get rid of the if ($action) in this case.
• You are trying to provide a lot of descriptive errors: this is good (though some argue how much detail on errors you want to give back to the user); however, this makes you play havoc with lots of embedded if statements. In combination with the $action statement above, it is probably better to do two things: first, create several subroutines that incorporate only the tasks for those actions, eg, you'd have a do_bond sub for $action eq 'BOND'. You can use a hash for storing these:

  my %actions = { 'BOND'=>\&do_bond,
                  'SHARE'=>\&do_share }
  if ( exists $actions{ $action } ) {
     my $err = &{ $actions{ $action } };
     if ( $err ne '1' ) {
        print $err;
     }
  } else {
     print "Action is not defined.";
  }
  [download]

  Now, in the subs, you don't have to print out the error codes; since these errors are 'fatal', simply return the error message; this avoids having to write the else brance, and thus 'flattens' your code more. With the code above, just make sure that successful completion returns '1'. This should now make your logic look like:

  sub do_bond {
     get LOCATION;
     check LOCATION or return;
     foreach @acc
        check PARENT_ID or return;
        update & insert or return;
     foreach @built
        check PARENT_ID or return;
        update & insert or return;
     return 1; # if you got here, everything's fine
  }
  [download]

Update After reading a later reply, I misunderstood the logic in the for blocks; it doesn't change the suggestions above, as another post points out, you can still 'short circuit' with next.:

sub do_bond {
   get LOCATION;
   check LOCATION or return;
   foreach @acc
      check PARENT_ID or { set error; next; }
      update & insert or { set error; next; }
   foreach @built
      check PARENT_ID or { set error; next; }
      update & insert or { set error; next; }
   return 1; # if you got here, everything's fine
}
[download]

IMO I think it's more important to try to avoid shuffling the main logic of a program into the else part of an if block *unless* the 'then' portion has as much or more logic. When dealing with web services in which you want to only handle cases you specifically code for, this may seem difficult to write, but cautious use of 'next', 'last', and 'break' statements can help maintain that. Also, it's just as easy to swap the else and then blocks for any statements, pushing all error handling to the end of the cdoe.

-----------------------------------------------------
Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
"I can see my house from here!"
It's not what you know, but knowing how to find it if you don't know that's important

Thank you, Masem
I've been updating my code, taking yours and others' suggestions into account, and have come up with this:


my $action = param("ACTION") || "NONESUCH";
#Bond the built-in and accessory components to the parent.
if($action eq "BOND") {
        my $main  = param("MAIN");
        my @built = param("BUILT");
        my @acc   = param("ACC");
        my $query = "SELECT location FROM demstock2 WHERE ds_id=?";
        my $sth   = $db->prepare($query);
        $sth->execute($main)
                or print "Can't execute <pre>$query</pre>: " . $db->er
+rstr . "<br>\n";

        my $mainlocation = $sth->fetchrow_hashref;
        $sth->finish();
        if($mainlocation->{"location"} ne "STOCK") {
                print b("Refusing to bond items to $main, as it isn't 
+in free stock") . br();
        } else {

                for my $child (@built, @acc) {

                        #Find out if it still is in free stock
                        my $query = "SELECT curr_parent_id FROM demsto
+ck2 WHERE ds_id=?";
                        my $sth   = $db->prepare($query);
                        $sth->execute($child)
                                or print "Can't execute $query: " . $s
+th->errstr . "<br>\n";
                        my $current_status = $sth->fetchrow_hashref;
                        $sth->finish();
                        if($current_status->{"curr_parent_id"} != 0) {
                                print "Refusing to modify the status o
+f demstock $child. It has already been moved<br>\n";
                                next;
                        }

                        #Move the kit, and update the action table
                        my $move_query = "UPDATE demstock2 SET curr_pa
+rent_id=? WHERE ds_id=?";
                        my $move_sth   = $db->prepare($move_query);
                        $move_sth->execute($main, $child)
                                or print "Can't execute <PRE>$move_que
+ry</PRE>: " . $sth->errstr . br();
                        $move_sth->finish();

                        my $action_query = "INSERT INTO action ";
                        $action_query   .= "(action_id, action_type, d
+s_id, occurred,          ref_no,  staff_id) VALUES";
                        $action_query   .= "(NULL,      'MOVE',      ?
+,     CURRENT_TIMESTAMP, ?, ?)";
                        my $action_sth   = $db->prepare($action_query)
+;
                        $action_sth->execute($child, "0,$main", $calus
+er)
                                or print "Can't execute <PRE>$action_q
+uery</PRE>: " . $sth->errstr . br();
                        $action_sth->finish;
                }
        }
}
[download]

Which, IMHO, is much more easy to read. (Notice the removal of the second for() loop, as the two loops simply did the same thing. Style is not a replacement for sensible coding :-)
I've renamed some of the query variables as per tommyw's suggestions, and I've also used placeholders (which evidently rock). A quick note on the security: this is actually for internal company use only, so hopefully nobody's going to try and break it, hence the specific error messages. However, I see your point about security, and the fact that it's internal doesn't mean it shouldn't be bulletproof.

About the if{} logic placement - that's something I nabbed from "Practical C Programming" - keep the shorter pieces of code (like error messages) near the top of the if's, so that it's easier to see which error message is the alternative to which bit of code.
Like you say though, this is personal preference, and feel free to ignore it :)
Thanks again to everyone who replied.
davis

More comments and ways for improving your code:
• Now that you've got the SQL statements using placeholders, you only need to define them once. I would suggest either the use of global-level variables or with constants. EG:

  # top level of code:
  my $loc_query = "SELECT location FROM demstock2 WHERE ds_id=?";
  #...
  #...much later...
  my $sth = $dbi->prepare( $loc_query ) # or die...
  $sth->execute( $id ) # or capture error
  [download]

  That will do wonders to clean up the text some more to focus on the logic (if that IS your goal).
• fetchrow_hashref is knows to be VERY VERY VERY slow. If you can, it's much better to use fetchrow_array if you know the order, or even better in this case since you are using fields and you know what order to expect things.
• You should be able to reuse the $sth handler. No need to finish() each one (though there's certainly nothing wrong with confirming this). You don't have the problem in this case that you can't reuse the $sth variable if you are still pulling data out from it. Alternatively, if you combine this with the idea of global-level SQL's, you can do the $db->prepare() step at the global level, leaving yourself with a few $sth variables all ready to go for an execute().
• Logic-wise, if the UPDATE should fail, do you *really* want the insert to continue? You might need to repeat the print; next; block at this point.
But overall, the code looks much better and much easier to follow. Additional comments could only help further since this is an in-house app, and someone else might come along later to pick up where you left off.

Do note that even though it is in-house, and might be behind the safest firewall in the world, it's always a good idea to think security first, as not only will this help you if you go on to help develop the company's public site, but for any future CGI efforts you might do. It's like what we say around here with use strict and -w; your program might not need them, but it's a very good habit to always include those.

-----------------------------------------------------
Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
"I can see my house from here!"
It's not what you know, but knowing how to find it if you don't know that's important

And now, rather than declaring and preparing the queries once per array element, you can lift them outside the loops:

my $sth = $db->prepare("SELECT curr_parent_id FROM demstock2 WHERE ds_
+id=?");
my $move_sth = $db->prepare("UPDATE demstock2 SET curr_parent_id=? WHE
+RE ds_id=?");
my $action_sth = $db->prepare("
INSERT INTO action
(action_id, action_type, ds_id, occurred,          ref_no,  staff_id) 
+VALUES
(NULL,      'MOVE',      ?,     CURRENT_TIMESTAMP, ?, ?)");
for my $child (@built, @acc) {
  #Find out if it still is in free stock
  $sth->execute($child) or ...
  my $current_status = $sth->fetchrow_hashref;
  if($current_status->{"curr_parent_id"} != 0) {
    print ...;
    next;
  }
  $move_sth->execute($main, $child) or ...
  $action_sth->execute($child, "0,$main", $caluser) or ...;
}
[download]

That's why placeholders rock :-)

--
Tommy
Too stupid to live.
Too stubborn to die.

Check out perltidy. It'll reformat overall pretty well, as well as being able to do some cleanup of things like extra parens and the like. I have a ~/.perltidy file with these settings and it manages to get most code into a format close enough to what I usually write:

-l=76
-i=2
-ce
-lp
-nasc
-icp
[download]

Once you've got things more readable you can start refactoring to get the code itself more perl-esque.

If this is exactly the code you're dealing with, then some of the if's can be removed:

• if($action) {
      #Bond the built-in and accessory components to the parent.
      if($action eq "BOND") {
  [download]

  You don't need the first if.

• for my $acc (@acc) {
  ...
  if ($current_status->{"curr_parent_id"} != 0) {
      print "Refusing to modify the status of demstock $acc. It has alre
  +ady been moved<br>\n";
  } else {
      ...
  }
  [download]

  can be flattened out to

  for my $acc (@acc) {
  ...
  if ($current_status->{"curr_parent_id"} != 0) {
      print "Refusing to modify the status of demstock $acc. It has alre
  +ady been moved<br>\n";
      next;
  }
  ...
  [download]

  which removes one level of indentation (and again in the second loop).

The other three levels are necessary, since you're testing three different conditions: the value of $action, the location, and the elements of @built (well, unless you're willing to start calling DIE to abort the flow).

I'd suggest that you use separate variables for the queries though, rather than recycling $sth all the time. Then (as well as being more readable), they can be pre-prepared, using placeholders.

--
Tommy
Too stupid to live.
Too stubborn to die.

For just a random tidbit, you should change your indent to something in the range 2-4 because in tests that level of indentation results in the best comprehension.

He also offers much good advice on variable naming, how to factor code into functions, etc.

Be warned. It is not about Perl. But it will make your Perl, along with every other language you know, much better.

All of the advice you've received so far is fantastic, but I'm kind of surprised that nobody has mentioned (although it is implied in tilly's response) that when you start nesting large amounts of code into conditional blocks you should immediately think modularize. Break some of those chunks into subroutines and it will be much easier on the eyes.

--Jim

Note: apologies if someone else has already mentioned this and I missed it.