Question

My problem is that: the outputs are different, when I run the program on the linux machine, and on a web browser of another machine.

When I run the program on the linux machine, the output is:

Content-type: text/plain
11
22
username password

But when I put the program on an Apache Server, and access it using a browser on another machine, the output is simply:

11

It is probably because the program fails to connect to the database file. As I have set all the files to mode 777, that I do not have the permission is unlikely a reason.

Anyone know what the problem is and how to fix it?

#!/usr/bin/perl -w

use DBI;

print ("Content-type: text/plain\n\n");

print "11\n";
my $dbh = DBI->connect("dbi:SQLite:dbname=4140.db","","",{RaiseError => 1},) or die $DBI::errstr;
print "22\n";

my $sth = $dbh -> prepare("SELECT * FROM Credential");
$sth -> execute();

($usrname, $password) = $sth -> fetchrow();

$sth -> finish();
$dbh->disconnect();

print "$usrname $password\n";

Answer 1

The die strings are sent to STDERR and so won’t appear in the HTTP message that is sent. You can solve this several ways, one of the simplest being to write an error handler for DBI errors that prints the error message to STDOUT.

You should also always use strict and use warnings. That way Perl will highlight many simple errors that you could otherwise easily overlook. use warnings is far superior to -w on the command line.

Take a look at this code as an example. Note that if you enable RaiseError as well as providing an error handler then DBI will raise an exception only if your error handler returns a false value.

#!/usr/bin/perl

use strict;
use warnings;

use DBI;

print ("Content-type: text/plain\n\n");

print "11\n";

my $dbh = DBI->connect('dbi:SQLite:dbname=4140.db','','',
    {RaiseError => 1, PrintError => 0, HandleError => \&handle_error});

print "22\n";

my $sth = $dbh->prepare('SELECT * FROM Credential');
$sth->execute;

my ($usrname, $password) = $sth -> fetchrow();

print "$usrname $password\n";

sub handle_error {
  my ($msg, $dbh, $rv) = @_;
  print "DB Error: $msg\n";
  0;
}