do 'dbi-lib.pl';



use CGI ':standard';
use DBI;
use strict;
use vars qw($baseURL);

# Declare base URL for return from this page
$baseURL = "../index.html";

my $q = new CGI;
my $user = $q->param('user');
my $passwd = $q->param('passwd');
my $action = $q->param('action');
my $s_off_no = $q->param('s_off_no');


printHead('TDPS - Delete Offence');

# check that user is logon
if (($user eq '') || ($passwd eq '')) {

  goLogon();
  return;
}


print <<EOM;
<table border=0 cellpadding=0 cellspacing=0 width=100%>
<tr>
<td>
EOM

searchform();
queryresult($s_off_no);


print <<EOM;
<hr>
EOM

print <<EOM;
</td>
</tr>
</table>
EOM

printclose();



sub searchform {
    
print <<EOM;

<form action="query.pl" method="post">
<input type="hidden" name="user" value="$user">
<input type="hidden" name="passwd" value="$passwd">
<table border="0" cellpadding="2" cellspacing="2">
<tr>
<td colspan="2" class="pagetitle">Delete Offence Details</td>
</tr>
<tr>
<td>Offence Number</td>
<td><input type="text" name="s_off_no" size="5" maxlength="5">&nbsp;<i
+nput type="submit" value="Search"></td>
</tr>
</table>
</form>

EOM


}



sub queryresult {
    my $debug = 1; # 0 to off, 1 to turn it on         
    my $results;

    my $dbuser = '111';
    my $dbpasswd = '222';
    
    my $s_off_no = $s_off_no;
        
    # Query to check if driver exist
    my $query1 = "select veh_reg_no from offence " .
                 "where off_no = $s_off_no";    

    # Database DBI driver name
    my $dbname = "DBI:Oracle:";

    # Create database handle
    my $dbh = DBI->connect($dbname, $dbuser, $dbpasswd);
    if (!$dbh) {
       showSQLerror("Connecting to the database");
       return;
    } else {
      # set AutoCommit  1 = ON, 0 = OFF (1 is default)
      # transaction control is *required* here, hence set OFF
      $dbh->{AutoCommit} = 0;
    }

    if ($debug == 1) {
      print("<br>query1: $query1");    
    }
    $results = run_statement($dbh,$query1,"Y");
    if ($results == 0) {
        printErrors('Invalid Offence No.!');
        return;
    } elsif ($results == -1) {
        $dbh->rollback;
        $dbh->disconnect;
        return;
    } else {
    
      $dbh->commit;
      $dbh->disconnect;
      print("<br>$results");
    }
}


sub run_statement {

    my ($dbh,$sql,$getNo)=@_;
    my $new_offNo;

    # Create a statement handle - prepare the statement
    my $sth = $dbh->prepare($sql);
    if (!$sth) {
        showSQLerror("Preparing SQL statement");
        return (-1);
    }

    # Execute the statement against the database
    $sth->execute;
    if ($DBI::errstr) {
        showSQLerror("Executing SQL Statment");
        $sth->finish;
        return (-1);
    }

    if ($getNo eq "Y") {
        ($new_offNo) = $sth->fetchrow;
    } else {
        $new_offNo = 0;
    }
    $sth->finish;

    return ($new_offNo);
}
[download]

Ok... to handle the problem chromatic and I pointed out do this.

queryresult($s_off_no);

This is good you loaded the $s_off_no variable into the @_ array

Here is the problem

my $s_off_no = $s_off_no;

^ Here you do not touch the var you loaded into @_. You just take the (lexical scoped to the main package) $s_off_no and assign it to (lexical scoped to the sub) $s_off_no (You hope)

What you should really be doing is

my ($s_off_no) = @_;

This insures there is no ambiguity to where the the var is coming from. Honestly, I do not know if the perl interepets the RHS as the sub scoped lexical of your statement because I have never done this, but it not only introduces ambiguity to you code (possible problems for the interpreter) it also makes it difficult to read for other people (including youself in a month).





PS: as a side node you are loading all the CGI functions into you main namespace.

 use CGI ':standard';

But you use the OO interface

 my $q = new CGI;

you should be able the ditch the ':standard' on the use CGI;



grep

Unix - where you can throw the manual on the keyboard and get a command

here's the problem I encounter
using

my ($s_off_no) = @_;
[download]

I don't seems to be retrieving the value into the variable $s_off_no

and using my original code


my $s_off_no = $s_off_no;
[download]

while i get the value, my query only works one time.
after which, even though I am submitting different query, it is still executing the previous query.

===
my $q = new CGI;
my $user = $q->param('user');
my $passwd = $q->param('passwd');
my $action = $q->param('action');
my $s_off_no = $q->param('s_off_no');
==
[download]

thanks

I believe it's due to the way Perl handles blocks. Each subroutine has a private pad, where it stores lexical variables -- variables you declare within the subroutine with the my operator. When you refer to a variable within the subroutine, Perl first looks in the pad for a variable with the required name, then in the global symbol table for the current namespace. This allows you to say:

my $foo # a lexical
= $foo; # a package global
[download]

I think the problem is that you're running afoul of an optimization. Since it's expensive to allocate and deallocate memory, Perl often reuses and rarely clears the pads attached to subroutines. That means that names and values stick around. Normally, this isn't a problem.

What your code did was to assign the value of the global $s_off_no (in the package symbol table) to the lexical $s_off_no (in the pad attached to the sub) on the first invocation. On subsequent calls, $s_off_no on the right hand side resolves not to the global but to the lexical left over from the first call.

If you pass arguments to the sub, you'll always end up with fresh values in the pad. It could be considered a bug, but this is a really good corner case.

(note: this is speculation on my part, with the appropriate amount of hand-waving)