I have a Perl script that reads in data from a database and prints out the result in HTML forms/tables. The form of each book also contains a submit button.
I want Perl to create a text file (or read into one already created) and print the title of the book that was inside the form submitted. But I can't seem to get param() to catch the submit action!
#!/usr/bin/perl -w
use warnings; # Allow for warnings to be sent if error's occur
use CGI; # Include CGI.pm module
use DBI;
use DBD::mysql; # Database data will come from mysql
my $dbh = DBI->connect('DBI:mysql:name?book_store', 'name', 'password')
or die("Could not make connection to database: $DBI::errstr"); # connect to the database with address and pass or return error
my $q = new CGI; # CGI object for basic stuff
my $ip = $q->remote_host(); # Get the user's ip
my $term = $q->param('searchterm'); # Set the search char to $term
$term =~ tr/A-Z/a-z/; # set all characters to lowercase for convenience of search
my $sql = '
SELECT *
FROM Books
WHERE Title LIKE ?
OR Description LIKE ?
OR Author LIKE ?
'; # Set the query string to search the database
my $sth = $dbh->prepare($sql); # Prepare to connect to the database
$sth->execute("%$term%", "%$term%", "%$term%")
or die "SQL Error: $DBI::errstr\n"; # Connect to the database or return an error
print $q->header;
print "<html>";
print "<body>";
print " <form name='book' action='bookcart.php' method=post> "; # Open a form for submitting the result of book selection
print "<table width=\"100%\" border=\"0\"> ";
my $title = $data[0];
my $desc = $data[1];
my $author = $data[2];
my $pub = $data[3];
my $isbn = $data[4];
my $photo = $data[5];
print "<tr> <td width=50%>Title: $title</td> <td width=50% rowspan=5><img src=$photo height=300px></td></tr><tr><td>Discreption Tags: $desc</td></tr><tr><td>Publication Date: $pub</td></tr><tr><td>Author: $author</td></tr><tr><td>ISBN: $isbn</td> </tr></table> <br>";
print "Add this to shopping cart:<input type='submit' name='submit' value='Add'>";
if ($q->param('submit')) {
open(FILE, ">>'$ip'.txt");
print FILE "$title\n";
close(FILE);
}
print "</form>"; # Close the form for submitting to shopping cart
You haven't used use strict, to force you to declare all your variables. This is a bad idea
You have used remote_host, which is the name of the client host system. Your server may not be able to resolve this value, in which case it will remain unset. If you want the IP address, use remote_addr
You have prepared and executed your SQL statement but have fetched no data from the query. You appear to expect the results to be in the array #data, but you haven't declared this array. You would have been told about this had you had use strict in effect
You have used the string '$ip'.txt for your file names so, if you were correctly using the IP address in stead of the host name, your files would look like '92.17.182.165'.txt. Do you really want the single quotes in there?
You don't check the status of your open call, so you have no idea whether the open succeeded, or the reason why it may have failed
I doubt if you have really spent the last 48 hours coding this. I think it is much more likely that you are throwing something together in a rush at the last minute, and using Stack Overflow to help you out of the hole you have dug for yourself.
Before asking for the aid of others you should at least use minimal good-practice coding methods such as applying use strict. You should also try your best to debug your code: it would have taken very little to find that $ip has the wrong value and #data is empty.
Use strict and warnings. You want to use strict for many reasons. A decent article on this is over at perlmonks, you can begin with this. Using strict and warnings
You don't necessarily need the following line, you are using DBI and can access mysql strictly with DBI.
use DBD::mysql;
Many of options are available with CGI, I would recommend reading the perldoc on this also based on user preferences and desired wants and needs.
I would not use the following:
my $q = new CGI;
# I would use as so..
my $q = CGI->new;
Use remote_addr instead of remote_host to retrieve your ip address.
The following line you are converting all uppercase to lowercase, unless it's a need to specifically read from your database with all lowercase, I find this useless.
$term =~ tr/A-Z/a-z/;
Next your $sql line, again user preference, but I would look into sprintf or using it directly inside your calls. Also you are trying to read an array of data that does not exist, where is the call to get back your data? I recommend reading the documentation for DBI also, many methods of returning your data. So you want your data back using an array for example...
Here is an untested example and hint to help get you started.
use strict;
use warnings;
use CGI qw( :standard );
use CGI::Carp qw( fatalsToBrowser ); # Track your syntax errors
use DBI;
# Get IP Address
my $ip = $ENV{'REMOTE_ADDR'};
# Get your query from param,
# I would also parse your data here
my $term = param('searchterm') || undef;
my $dbh = DBI->connect('DBI:mysql:db:host', 'user', 'pass',
{RaiseError => 1}) or die $DBI::errstr;
my $sql = sprintf ('SELECT * FROM Books WHERE Title LIKE %s
OR Description LIKE %s', $term, $term);
my $sth = $dbh->selectall_arrayref( $sql );
# Retrieve your result data from array ref and turn into
# a hash that has title for the key and a array ref to the data.
my %rows = ();
for my $i ( 0..$#{$sth} ) {
my ($title, $desc, $author, $pub, $isbn, $pic) = #{$sth->[$i]};
$rows{$title} = [ $desc, $author, $pub, $isbn, $pic ];
}
# Storing your table/column names
# in an array for mapping later.
my #cols;
$cols[0] = Tr(th('Title'), th('Desc'), th('Author'),
th('Published'), th('ISBN'), th('Photo'));
foreach (keys %rows) {
push #cols, Tr( td($_),
td($rows{$_}->[0]),
td($rows{$_}->[1]),
td($rows{$_}->[2]),
td($rows{$_}->[3]),
td(img({-src => $rows{$_}->[4]}));
}
print header,
start_html(-title => 'Example'),
start_form(-method => 'POST', -action => 'bookcart.php'), "\n",
table( {-border => undef, -width => '100%'}, #cols ),
submit(-name => 'Submit', -value => 'Add Entry'),
end_form,
end_html;
# Do something with if submit is clicked..
if ( param('Submit') ) {
......
}
This assumes that you're using the OO approach to CGI.pm, and that $q is the relevant object. This should work, assuming that you have $q = new CGI somewhere in your script.
Can you post the rest of the script?
I've created a mockup to test this, and it works as expected:
#!/usr/bin/perl
use CGI;
my $q = new CGI;
print $q->header;
print "<form><input type=submit name=submit value='add'></form>\n";
if ($q->param('submit')) {
print "submit is \"" . $q->param('submit') . "\"\n";
}
After the submit button is clicked, the page displays that submit is "add" which means the evaluation is going as planned.
I guess what you need to do is make sure that $q is your CGI object, and move forward from there.
Related
I am getting a "csv file" from a vendor (using their API), but what they do is just spew the whole thing into their response. It wouldn't be a significant problem except that, of course, some of those pesky humans entered the data and put in "features" like line breaks. What I am doing now is creating a file for the raw data and then reopening it to read the data:
open RAW, ">", "$rawfile" or die "ERROR: Could not open $rawfile for write: $! \n";
print RAW $response->content;
close RAW;
my $csv = Text::CSV_XS->new({ binary=>1,always_quote=>1,eol=>$/ });
open my $fh, "<", "$rawfile" or die "ERROR: Could not open $rawfile for read: $! \n";
while ( $line = $csv->getline ($fh) ) { ...
Somehow this seems ... inelegant. It seems that I ought to be able to just read the data from the $response->content (multiline string) as if it were a file. But I'm drawing a total blank on how do this.
A pointer would be greatly appreciated.
Thanks,
Paul
You could use a string filehandle:
my $data = $response->content;
open my $fh, "<", \$data or croak "unable to open string filehandle : $!";
my $csv = Text::CSV_XS->new({ binary=>1,always_quote=>1,eol=>$/ });
while ( $line = $csv->getline ($fh) ) { ... }
Yes, you can use Text::CSV_XS on a string, via its functional interface
use warnings;
use strict;
use feature 'say';
use Text::CSV_XS qw(csv); # must use _XS version
my $csv = qq(a,line\nand,another);
my $aoa = csv(in => \$csv)
or die Text::CSV->error_diag;
say "#$_" for #aoa;
Note that this indeed needs Text::CSV_XS (normally Text::CSV works but not with this).
I don't know why this isn't available in the OO interface (or perhaps is but is not documented).
While the above parses the string directly as asked, one can also lessen the "inelegant" aspect in your example by writing content directly to a file as it's acquired, what most libraries support like with :content_file option in LWP::UserAgent::get method.
Let me also note that most of the time you want the library to decode content, so for LWP::UA to use decoded_content (see HTTP::Response).
I cooked up this example with Mojo::UserAgent. For the CSV input I used various data sets from the NYC Open Data. This is also going to appear in the next update for Mojo Web Clients.
I build the request without making the request right away, and that gives me the transaction object, $tx. I can then replace the read event so I can immediately send the lines into Text::CSV_XS:
#!perl
use v5.10;
use Mojo::UserAgent;
my $ua = Mojo::UserAgent->new;
my $url = ...;
my $tx = $ua->build_tx( GET => $url );
$tx->res->content->unsubscribe('read')->on(read => sub {
state $csv = do {
require Text::CSV_XS;
Text::CSV_XS->new;
};
state $buffer;
state $reader = do {
open my $r, '<:encoding(UTF-8)', \$buffer;
$r;
};
my ($content, $bytes) = #_;
$buffer .= $bytes;
while (my $row = $csv->getline($reader) ) {
say join ':', $row->#[2,4];
}
});
$tx = $ua->start($tx);
That's not as nice as I'd like it to be because all the data still show up in the buffer. This is slightly more appealing, but it's fragile in the ways I note in the comments. I'm too lazy at the moment to make it any better because that gets hairy very quickly as you figure out when you have enough data to process a record. My particular code isn't as important as the idea that you can do whatever you like as the transactor reads data and passes it into the content handler:
use v5.10;
use strict;
use warnings;
use feature qw(signatures);
no warnings qw(experimental::signatures);
use Mojo::UserAgent;
my $ua = Mojo::UserAgent->new;
my $url = ...;
my $tx = $ua->build_tx( GET => $url );
$tx->res->content
->unsubscribe('read')
->on( read => process_bytes_factory() );
$tx = $ua->start($tx);
sub process_bytes_factory {
return sub ( $content, $bytes ) {
state $csv = do {
require Text::CSV_XS;
Text::CSV_XS->new( { decode_utf8 => 1 } );
};
state $buffer = '';
state $line_no = 0;
$buffer .= $bytes;
# fragile if the entire content does not end in a
# newline (or whatever the line ending is)
my $last_line_incomplete = $buffer !~ /\n\z/;
# will not work if the format allows embedded newlines
my #lines = split /\n/, $buffer;
$buffer = pop #lines if $last_line_incomplete;
foreach my $line ( #lines ) {
my $status = $csv->parse($line);
my #row = $csv->fields;
say join ':', $line_no++, #row[2,4];
}
};
}
Here is my code. I get an internal server error with this. The subroutine is a clone from a book. So it is good to go. I just cannot get these tables to be on the screen by the time I look at the site. Is there anything that you guys see I am doing wrong?
#!/usr/bin/perl -T
use 5.010;
use DBI; #this is for database connections.
use CGI qw/:standard/;
use CGI::Carp qw(fatalsToBrowser);
#my $driver = "mysql";
my $database = "myown";
my $hostname = "whereitis";
my $dsn = "longblabla";
my $userid = "memyselfandI";
my $password = "onlymetoknow";
my $page1 = "Tables in the database: " . $database;
my $dbh = DBI->connect( $dsn, $userid, $password ) or die $DBI::errstr;
print
header,
start_html(
-title => $page1,
-meta => {
'viewport' => 'width=device-width, initial-scale=1',
'copyright' => 'copyright 2015 Noel Villaman'
},
-style => [
{ -src => 'bootstrap.min.css' },
{ -src => 'cgicssjs/style1.css' }
]
),
h1( $page1 ),
div( table_names( $dbh->table_info() ) ),
hr,
"\n";
# Disconnect from the database.
$dbh->disconnect();
print end_html;
sub table_names {
my $names = $_[0];
### Create a new statement handle to fetch table information
my $tabsth = $names; #$dbh->table_info();
### Print the header
print "<h1>Table Name</h1>";
print "<h3>===============</h3>";
### Iterate through all the tables...
while ( my ( $qual, $owner, $name, $type, $remarks ) = $tabsth->fetchrow_array() ) {
### Tidy up NULL fields
foreach ( $qual, $owner, $name, $type, $remarks ) {
$_ = "N/A" unless defined $_;
}
### Print out the table metadata...
print "<h3>$name</h3>";
}
exit;
}
In a comment, you say that you don't think that you can see the web server error log. It is ridiculous to try to develop a CGI program without access to the server error log. You should try to get that fixed as a matter of urgency.
But in the mean time, you can work round this restriction by adding the following near the top of your code.
use CGI::Carp 'fatalsToBrowser';
That will copy the error log messages to your browser so you can see them. But remember to remove or comment out that line before the code goes into production (not that this code will ever go into production in any meaningful way - I realise it's homework).
While you're editing that part of your code, also add:
use strict;
use warnings;
You should add these lines to every Perl program you write and fix all the errors and warnings that they give you.
So what's the problem with this code? I suspect that running it from the browser, you'll get an error about there being no CGI header line. That's because you exit() the program from the end of your table_names() subroutine. So the program never gets back from calling the table_names() subroutine and your main print() statement never gets executed - and that includes the header().
Also, in your main print() statement, you print the value returned from table_names(). But table_names() doesn't return anything. You need to change the logic in table_names() so that it returns the HTML it creates rather than printing it directly. Printing it directly will put it in the wrong place in the output stream.
One other point that I don't expect you're in any position to do anything about... CGI is pretty much a dead technology. This course is teaching you stuff that would have been useful fifteen years ago. Perhaps you could point your teacher at CGI::Alternatives and ask if he or she would consider teaching something that is more relevant to how web development is done today.
Update: The simplest fix is probably to split up your print statement so that things happen in the right order.
# Print all the start page stuff
print
header,
start_html(
-title => $page1,
-meta => {
'viewport' => 'width=device-width, initial-scale=1',
'copyright' => 'copyright 2015 Noel Villaman'
},
-style => [
{ -src => 'bootstrap.min.css' },
{ -src => 'cgicssjs/style1.css' }
]
),
h1( $page1 );
# No need to call print here as table_names
# does its own printing
table_names( $dbh->table_info() );
# Print all the end of page stuff.
print
hr,
"\n";
You'll still need to remove the exit() from the end of table_names, otherwise the program will never return from that subroutine.
Also, by doing this you lose a <div> around the output from table_names. Fixing that is left as an exercise for the reader.
Scenario: I have a HTML form that sends variables to a Perl CGI which then takes them and inserts them on to a SQL DB I created earlier, but the problem is that it sends only NULL values to the DB - it does send the "correct number" of nulls though so I don't know what is going wrong. I have a feeling it is something to do with the variable passing to the Perl not Perl to DB. The Perl file:
#! \xampp\perl\bin\perl.exe -w
require "dbfunc.pl";
use warnings;
use CGI qw/:standard/;
use CGI::Carp qw(fatalsToBrowser);
$table = "routes";
#$spotted = "spotted";
$booked = "bookings";
$logged = "log";
$dbh = getConnection();
print header;
print start_html("Journey Details");
$name = param($name);
$email = param($email);
$price = param($price);
$date = param($date);
$departure = param($departure);
$arrival = param($arrival);
$adults = param($adults);
$children = param($children);
$totalCost = param($totalCost);
$departureTime = param($departureTime);
$arrivalTime = param($arrivalTime);
$jid = param($jid);
$dbh->do("INSERT INTO $logged VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)", undef,
$date, $date, $name, $email, $departure, $arrival, $departureTime, $adults, $children, $totalCost);
#my $sth = $dbh->prepare(qq{INSERT INTO $logged SET DateBooked=?, Journeydate=?, Name=?, Email=?, RouteFrom=?, RouteTo=? , DepartTime=?, Adults=?, Children=?, AmountPaid=?});
#$sth->execute($date, $date, $name, $email, $departure, $arrival, $departureTime, $adults, $children, $totalCost) or die $dbh->errstr;
print end_html;
The first perl file that initially takes the vars:
#! \xampp\perl\bin\perl.exe -w
use CGI qw(:standard);
$query = new CGI;
#parameters = $query -> param;
print header, start_html("Receipt");
print p("Your Journey Receipt");
my $name = $query->param('name');
print ("Name: $name");
print br;
my $email = $query->param('email');
print ("Email: $email");
print br;
my $price = $query->param('price');
print ("Price: £$price");
print br;
my $date = $query->param('date');
print ("Journey date: $date");
print br;
my $departure = $query->param('departure');
print ("From: $departure");
print br;
my $arrival = $query->param('arrival');
print ("To: $arrival");
print br;
my $adults = $query->param('adults');
print ("Adults: $adults");
print br;
my $children = $query->param('children');
print ("Children: $children");
print br;
my $totalCost = $query->param('totalCost');
print ("Total Cost: £$totalCost");
print br;
my $departureTime = $query->param('departureTime');
print ("Departure: $departureTime");
print br;
my $arrivalTime = $query->param('arrivalTime');
print ("Arrival: $arrivalTime");
print br;
my $jid = $query->param('jid');
print ("Journey ID: $jid");
print br;
print qq!<br><form><input type="Button" value="Back" onclick="history.back()"></form>!;
print qq!<br><form method="get" action="serverside.pl">!;
print qq!<input type="submit" value="Confirm Booking" />\n</form><br />!;
print end_html;
You are misunderstanding the way CGI programs work. They don't send data to one-another: they are executed as a result of an action on a web browser, and if that action was a click on a form submit button then they will receive a set of parameters according to the names and contents of that form's <input> elements.
Your scripts don't use strict as they should, and the -w on the shebang line pretty much duplicates the action of the use warnings statement. You should use just the latter.
As Quentin says, the NULL values in the database are because you are calling $name = param($name) which, because $name is undefined, is the same as $name = param(''). You need to use a fixed string, like you did in your other script $name = param('name').
But that assumes that somewhere there is a CGI script or just an HTML file that has a <form> element with all those <input> fields. Clicking submit on such a form will execute the script specified in the action attribute and pass to it the contents of all the fields.
The first of your two scripts is expecting form input, and writes the contents of that form to the database, while the second of the two (that you say is the first perl file!) is also expecting form input but builds a web page with the information. The problem is that you don't seem to have written that form anywhere.
What I think you need is to combine the two CGI scripts, so that when submit is clicked the script both writes the information to the database and displays it on the screen. And you also need to write that form which, as I said could be just a plain HTML file.
It is also common to combine the form input and the database update in one script, which checks to see if it has been passed any parameters. If there are none then it displays the input form and waits for a response. Otherwise they are used to update the database and put up a confirmation page.
I hope this helps you.
You make the same mistake several times. I'll use the first instance an example:
$name = param($name);
You get the value of $name (which you haven't yet defined) and use it to get a param from the HTTP request. Since it isn't defined, you don't get the result you are looking for, so you don't get the submitted data in $name.
Presumably you intended:
$name = param('name');
Update now you have the form you are using:
print qq!<br><form method="get" action="serverside.pl">!;
print qq!<input type="submit" value="Confirm Booking" />\n</form><br />!;
You don't have any <input> elements except for the submit button (which doesn't have a name attribute), so there is no data to submit.
I am trying to import several .csv files into a mysql database, the script below works except that it only imports the first row of my csv data into the database. Both my tables are populated with exactly one data entry.
Any help would be appreciated.
Thank you
#!/usr/bin/perl
use DBI;
use DBD::mysql;
use strict;
use warnings;
# MySQL CONFIG VARIABLES
my $host = "localhost";
my $user = "someuser";
my $pw = "somepassword";
my $database = "test";
my $dsn = "DBI:mysql:database=" . $database . ";host=" . $host;
my $dbh = DBI->connect($dsn, $user, $pw)
or die "Can't connect to the DB: $DBI::errstr\n";
print "Connected to DB!\n";
# enter the file name that you want import
my $filename = "/home/jonathan/dep/csv/linux_datetime_test_4.26.13_.csv";
open FILE, "<", $filename or die $!;
$_ = <FILE>;
$_ = <FILE>;
while (<FILE>) {
my #f = split(/,/,$_);
if (length($f[4]) < 10) {
print "No Weight\n";
}
else {
#insert the data into the db
print "insert into datetime_stamp\n";
}
my $sql = "INSERT INTO datetime_stamp (subject, date, time, weight)
VALUES('$f[1]', '$f[2]', '$f[3]', '$f[4]')";
print "$sql\n";
my $query = $dbh->do($sql);
my $sql = "INSERT INTO subj_weight (subject, weight) VALUES('$f[1]', '$f[2]')";
my $query = $dbh->do($sql);
close(FILE);
}
As has been commented, you close the input file after reading the first data entry, and so only populate your database with a single record.
However there are a few problems with your code you may want to consider:
You should set autoflush on the STDOUT file handle if you are printing diagnostics as the program runs. Otherwise perl won't print the output until either it has a buffer full of text to print or the file handle is closed when the program exits. That means you may not see the messages you have coded until long after the event
You should use Text::CSV to parse CSV data instead of relying on split
You can interpolate variables into a double-quoted string. That avoids the use of several concatenation operators and makes the intention clearer
Your open is near-perfect - an unusual thing - because you correctly use the three-parameter form of open as well as testing whether it succeeded and putting $! in the die string. However you should also always use a lexical file handle as well instead of the old-fashioned global ones
You don't chomp the lines you read from the input, so the last field will have a trailing newline. Using Text::CSV avoids the need for this
You use indices 1 through 4 of the data split from the input record. Perl indices start at zero, so that means you are droppping the first field. Is that correct?
Similarly you are inserting fields 1 and 2, which appear to be subject and date, into fields called subject and weight. It seems unlikely that this can be right
You should prepare your SQL statements, use placeholders, and provide the actual data in an execute call
You seem to diagnose the data read from the file ("No Weight") but insert the data into the database anyway. This may be correct but it seems unlikely
Here is a version of your program that includes these amendments. I hope it is of use to you.
#!/usr/bin/perl
use strict;
use warnings;
use DBI;
use Text::CSV;
use IO::Handle;
STDOUT->autoflush;
# MySQL config variables
my $host = "localhost";
my $user = "someuser";
my $pw = "somepassword";
my $database = "test";
my $dsn = "DBI:mysql:database=$database;host=$host";
my $dbh = DBI->connect($dsn, $user, $pw)
or die "Can't connect to the DB: $DBI::errstr\n";
print "Connected to DB!\n";
my $filename = "/home/jonathan/dep/csv/linux_datetime_test_4.26.13_.csv";
open my $fh, '<', $filename
or die qq{Unable to open "$filename" for input: $!};
my $csv = Text::CSV->new;
$csv->getline($fh) for 1, 2; # Drop header lines
my $insert_datetime_stamp = $dbh->prepare( 'INSERT INTO datetime_stamp (subject, date, time, weight) VALUES(?, ?, ?, ?)' );
my $insert_subj_weight = $dbh->prepare( 'INSERT INTO subj_weight (subject, weight) VALUES(?, ?)' );
while (my $row = $csv->getline($fh)) {
if (length($row->[4]) < 10) {
print qq{Invalid weight: "$row->[4]"\n};
}
else {
#insert the data into the db
print "insert into datetime_stamp\n";
$insert_datetime_stamp->execute(#$row[1..4]);
$insert_subj_weight->execute(#$row[1,4]);
}
}
Here is the table in which I am retrieving the data from an SQLite database.
Its having lots of records, so near that ADD button I need something like
|< < > >| which would do the paging function whenever I click.
Also, besides the table each header (e.g. UserName UserId) I need a sorting
button. Something like a ^ button. Please do help me find the solution..Thank You.
#!C:\perl\bin\perl.exe
use CGI;
use CGI qw/:standard/;
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
my $q = new CGI;
use DBI;
use CGI qw(:all);
use warnings;
print $q->header ( );
my $dbh = DBI->connect(
"dbi:SQLite:DEVICE.db",
"", "",
{
RaiseError => 1,
AutoCommit => 1
}
);
my #rows = ();
my $sql = "SELECT UserId,UserName,CardNo,GroupId,Role,VerifyType FROM UsersList";
my $sth = $dbh->prepare($sql) or die("\n\nPREPARE ERROR:\n\n$DBI::errstr");
$sth->execute or die("\n\nQUERY ERROR:\n\n$DBI::errstr");
print '<table>';
print "<tr>";
print "<th>$sth->{NAME}->[0]</th>";
print "<th>$sth->{NAME}->[1]</th>";
print "<th>$sth->{NAME}->[2]</th>";
print "<th>$sth->{NAME}->[3]</th>";
print "<th>$sth->{NAME}->[4]</th>";
print "<th>$sth->{NAME}->[5]</th>";
print "<th> EDIT </th>";
print "<th> DELETE </th>";
while (my #row = $sth->fetchrow_array) {
print "
<tr>
<td>$row[0]</td>
<td>$row[1]</td>
<td>$row[2]</td>
<td>$row[3]</td>
<td>$row[4]</td>
<td>$row[5]</td>
<td>EDIT</td>
<td>DELETE</td>
</tr>";
}
print "<tr style='background-color:#CDC9C9;'><td><A HREF=\"http://localhost/cgi-
bin/AddUser.cgi\">ADD</A></td><td></td><td></td><td></td><td></td></tr>";
print"</table>";
$sth->finish();
$dbh->commit();
$dbh->disconnect;
print <<END_HTML;
<html>
<head><title></title></head>
<body>
<form action="UsersList.cgi" method="get">
<TABLE align="center">
<TR>
<TD align="left">
<input type="hidden" name="submit" value="Submit">
</TD>
</TR>
</TABLE>
</form>
</body></html>
END_HTML
----------------------------------------
Ok, first thing, get and read Learning Perl. It is, hands down, the best book to learn Perl with.
Next, take a look at Ovid's CGI Course.
Third, your code has some major problems, and you'll need to walk before you run.
I've tidied and commented the heck out of your code.
#!C:\perl\bin\perl.exe
# Windows perl ignores the shebang, except to check for flags and
# arguments to start the Perl interpreter with.
# Your webserver might use it though
# You forgot to enable strict. You enabled warnings further down in
# your code. These two pragmas will help you write bug free code by
# catching many errors.
#
# Keep your module and pragma usage at the top of your
# scripts. It aids readability.
use strict;
use warnings;
# Using CGI is a good idea, but you only need to use CGI one time.
use CGI qw/:all/;
# These are good while learning and debugging.
# Do not use them in production code.
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use DBI;
my $dbh = DBI->connect(
"dbi:SQLite:DEVICE.db",
"", "",
{
RaiseError => 1,
AutoCommit => 1
}
);
# Don't use indirect object notation. It can lead to subtle bugs.
# Use the arrow notation for method invocation instead.
my $q = CGI->new();
print $q->header ( );
# The #rows array was doing nothing.
# No need to commit when autocommit is on.
$dbh->commit();
$dbh->disconnect;
# Here we get the html table in a string.
my $table = generate_data_table( $dbi );
# And here we print your whole HTML block with the table interpolated
# into the the main text. As it was, the HTML page was printing AFTER
# the table you generated.
#
# I put a crappy improper stylesheet in the header of your html page.
# Unless you are only doing the most rudimentary HTML work, learn to
# use CSS properly. Your time will be repayed hundreds of times over.
# For only rudimentary work, there's still a good chance you'll break
# even on any time you invest in learning CSS.
print <<END_HTML;
<html>
<head>
<title>Add Users</title>
<style>
.adduser {
background-color:#CDC9C9;
}
</style>
</head>
<body>
<form action="UsersList.cgi" method="get">
$table
<input type="hidden" name="submit" value="Submit">
</form>
</body>
</html>
END_HTML
# Use subroutines to group related actions.
sub generate_data_table {
my $dbi = shift;
my $sql = "SELECT UserId,UserName,CardNo,GroupId,Role,VerifyType FROM UsersList";
my $sth = $dbh->prepare($sql)
or die("\n\nPREPARE ERROR:\n\n$DBI::errstr");
$sth->execute
or die("\n\nQUERY ERROR:\n\n$DBI::errstr");
# Actually generate the table HTML
my $table = '<table><tr>';
# Header
$table .= join '', map "<th>$sth->{NAME}[$_]</th>\n", 0..5;
$table .= "</tr>\n";
# Normal Rows
while (my #row = $sth->fetchrow_array) {
$table .= '<tr>',
$table .= join '', map "<td>$row[$_]</td>\n", 0..5;
$table .= join "\n",
'<td>EDIT</td>'
'<td>DELETE</td>'
"</tr>\n";
}
# Special Row
#
# Don't use inline CSS, use classes and either group all your css at
# the top of your html code, or better yet, load an external stylesheet.
# There is no reason to have to escape quotes when working with Perl CGI.
# First, in html ' and " are interchangeable, so you can pick a quote
# that doesn't need esacaping.
#
# Finally, if you MUST use both ' and " in a single string, you can use
# Perl's quoting operators (q and qq) to select a safe delimiter that will allow you
# to avoid escaping.
$table .=
"<tr class='adduser' >"
. '<td>ADD</td>'
. '<td></td><td></td><td></td><td></td></tr>'
. "</table>";
$sth->finish();
return $table;
}
Finally, to handle sorting and paging, you can use a library as others have suggested, or you can modify your SQL query. The keywords you want for grabbing only a range of results are LIMIT and OFFSET, use an ORDER BY clause to sort your result set. Add some parameters to your forms to indicate what sorting methods or range you want.
One of the (many) advantages that you'd get from using DBIx::Class for your database access is that all searches have built-in support for paging.
Alternatively, you might find something like Data::Page to be useful.
As for sorting, that's probably best done in your SQL query with a 'sort' clause.