I'm getting this compilation error when running my code. Can anyone help what is wrong with this code. ?
Operating system is AIX
Error -
Can't modify constant item in scalar assignment at pet_logical_date.pl line 29, near "1}" Execution of
pet_logical_date.pl aborted due to compilation errors.
Line 29 is - *print $cgi=>table({border=1});
CODE is -
#!/usr/bin/perl -w
#####################################################################################
$\="\n";
$ENV{ORACLE_HOME}='/oravl01/11.2.0.3';
$LD_LIBRARY_PATH='/oravl01/11.2.0.3/lib';
use Shell;
use DBI ;
use CGI ;
my $cgi = new CGI;
print $cgi->header;
print $cgi->start_html(-title=>'Basic CGI');
my $dsn = "DBI:Oracle:$db_inst";
$dbh = DBI->connect( 'dbi:Oracle:ABC',"DEF","IJK") or die "Database connection not made: $DBI::errstr";
my $sql = qq{SELECT logical_date,logical_date_type from logical_date where expiration_date is null };
my $sth = $dbh->prepare( $sql ) || die $dbh->errstr;
$sth->execute() || die $dbh->errstr;
print $cgi->table({border=1});
print "<tr align=center><th>$sth->{NAME}->[0]</th><th>$sth->{NAME}->[1]</th></tr>";
while (#data = $sth->fetchrow_array()) {
$Logical_Date_O = $data[0];
$Logical_Date_B = $data[1];
$Logical_Date_R = $data[2];
print "<tr><td><font color='black'>$Logical_Date_O</font></td>
<td>$Logical_Date_B</td><td>$Logical_Date_R</td></tr>\n";
}
print $cgi->end_table;
print $cgi->end_html;
Line 29 should be like this:
print $cgi->table( { -border=>"1" } );
There is something else that, although is not the cause of the error can produce some unexpected behavior: your SQL query return a two fields recordset;
but inside the while loop you try to read a third field:
$Logical_Date_R = $data[2];
the variable Logical_Date_R is likely going to have a null value.
print $cgi=>table({border=1}); is trying to assign border=1. I think you meant border => 1 (changing the assignment operator, =, to the fat comma, =>).
Related
Edit: modified code and output to make it more clear
Edit 2: Added example input for reproduction
I have a JSON file and a CSV file and I am running comparisons on the two. The problem is that $asset_ip is correctly defined in the outer foreach loop, but when in the nested loop $asset_ip becomes undefined.
Why is $asset_ip becoming undefined?
#!/usr/bin/perl
# perl -e'use CPAN; install "Text::CSV"'
use strict;
use warnings;
use JSON::XS;
use File::Slurp;
use Text::CSV;
my $csv = Text::CSV->new( { sep_char => ',' } );
my $csv_source = "servers.csv";
my $json_source = "assets.json";
my $dest = "servers_for_upload.csv";
# defined these here as I need to use them in foreach loop and if statement:
my $csv_ip;
my #fields;
open( my $csv_fh, '<', $csv_source ) or die "$! error trying to read";
open( my $dest_fh, '>', $dest ) or die "$! error trying to read";
my $json = read_file($json_source);
my $json_array = decode_json $json;
foreach my $item (#$json_array) {
my $id = $item->{id};
my $asset_ip = $item->{interfaces}->[0]->{ip_addresses}->[0]->{value};
# test the data is there:
if ( defined $asset_ip ) {
print "id: " . $id . "\nip: " . $asset_ip . "\n";
}
while (my $line = <$csv_fh>) {
chomp $line;
if ( $csv->parse($line) ) {
#fields = $csv->fields();
$csv_ip = $fields[0];
}
else {
warn "Line could not be parsed: $line\n";
}
if ( $csv_ip eq $asset_ip ) {
# preppend id to csv array and write these lines to new file
unshift( #fields, $id );
print $dest_fh join( ", ", #fields );
}
}
}
close $csv_fh;
Output:
Use of uninitialized value $asset_ip in string eq at script.pl line 43, <$csv_fh> line 1.
Use of uninitialized value $asset_ip in string eq at script.pl line 43, <$csv_fh> line 2.
Use of uninitialized value $asset_ip in string eq at script.pl line 43, <$csv_fh> line 3.
id: 1003
ip: 192.168.0.2
id: 1004
ip: 192.168.0.3
id: 1005
ip: 192.168.0.4
assets.json:
[{"id":1001,"interfaces":[]},{"id":1003,"interfaces":[{"ip_addresses":[{"value":"192.168.0.2"}]}]},{"id":1004,"interfaces":[{"ip_addresses":[{"value":"192.168.0.3"}]}]},{"id":1005,"interfaces":[{"ip_addresses":[{"value":"192.168.0.4"}]}]}]
Note, that for the first iteration, $asset_ip will be undefined. I will therefore alter the code to only run the eq comparison if $asset_ip is defined. However, for this example I am not doing the check because all iterations are undefined.
servers.csv:
192.168.0.3,Brian,Germany
192.168.0.4,Billy,UK
192.168.0.5,Ben,UK
I think your problem will be this:
foreach my $line (<$csv_fh>) {
You execute this within our outer loop. But when you do this, your $csv_fh ends up at the end of file.
Once you have done this, subsequent iterations of your outer loop will not execute this inner loop, because there's nothing left for it to read from $csv_fh.
An easy test if this is your problem is to add a seek e.g. seek ( $csv_fh, 0, 0 );.
But this isn't an efficient thing to do, because then you'll be looping through the file multiple times - you should instead read it into a data structure and use that.
Edit: Here is your problem:
[{"id":1001,"interfaces":[]},{"id":1003,"interfaces":[{"ip_addresses":[{"value":"192.168.0.2"}]}]},{"id":1004,"interfaces":[{"ip_addresses":[{"value":"192.168.0.3"}]}]},{"id":1005,"interfaces":[{"ip_addresses":[{"value":"192.168.0.4"}]}]}]
And specifically:
[{"id":1001,"interfaces":[]}
Your first element in that array doesn't have a $asset_ip defined.
This means - on your first pass - $asset_ip is undefined and generates the errors. (no line is printed because of your if defined test).
But then - the code proceeds to traverse $csv_fh - reading to the end of file - looking for matches (and fails 3 times, generating 3 error messages.
Second iteration - for id 1002 - the IP isn't in the file anyway, but $csv_fh has already been read to end-of-file (EOF) - so that foreach loop doesn't execute at all.
This can be made workable by:
adding else next; after that if defined.
adding seek to after the while loop.
But really - a rewrite would be in order so you're not re-reading a file over and over anyway.
Very crudely:
#!/usr/bin/perl
# perl -e'use CPAN; install "Text::CSV"'
use strict;
use warnings;
use JSON::XS;
use File::Slurp;
use Text::CSV;
my $csv = Text::CSV->new( { sep_char => ',' } );
my $csv_source = "servers.csv";
my $json_source = "assets.json";
my $dest = "servers_for_upload.csv";
# defined these here as I need to use them in foreach loop and if statement:
my $csv_ip;
my #fields;
open( my $csv_fh, '<', $csv_source ) or die "$! error trying to read";
open( my $dest_fh, '>', $dest ) or die "$! error trying to read";
my $json = read_file($json_source);
my $json_array = decode_json $json;
foreach my $item (#$json_array) {
my $id = $item->{id};
my $asset_ip = $item->{interfaces}->[0]->{ip_addresses}->[0]->{value};
# test the data is there:
if ( defined $asset_ip ) {
print "id: " . $id . "\nip: " . $asset_ip . "\n";
}
else {
print "asset_ip undefined for id $id\n";
next;
}
while ( my $line = <$csv_fh> ) {
chomp $line;
if ( $csv->parse($line) ) {
#fields = $csv->fields();
$csv_ip = $fields[0];
}
else {
warn "Line could not be parsed: $line\n";
}
if ( $csv_ip eq $asset_ip ) {
# preppend id to csv array and write these lines to new file
unshift( #fields, $id );
print {$dest_fh} join( ", ", #fields ),"\n";
}
}
seek( $csv_fh, 0, 0 );
}
close $csv_fh;
I would suggest this also needs:
change of while so you're not re-reading the file each time
You're using Text::CSV so using a print join ( ","... doesn't seem a consistent choice. If your data warrants Text::CSV it's worth keeping it for output too.
I am trying to insert a record into a MySQL database using Perl DBI. I am not getting any errors but the insert is not working. However, I am able to successfully fetch records from the database using DBI.
Here is the code that does the insert:
#!"C:\xampp\perl\bin\perl.exe"
use diagnostics;
use DBI;
use strict;
use warnings;
my $driver = "mysql";
my $database = "mysql";
my $dsn = "DBI:$driver:database=$database";
my $userid = "root";
my $password = "password";
my $buffer;
my #pairs;
my $pair;
my $name;
my $value;
my %FORM;
# Read in text
my $ENV;
$ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
if ($ENV{'REQUEST_METHOD'} eq "GET")
{
$buffer = $ENV{'QUERY_STRING'};
}
# Split information into name/value pairs
#pairs = split(/&/, $buffer);
foreach $pair (#pairs)
{
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%(..)/pack("C", hex($1))/eg;
$FORM{$name} = $value;
}
my $first_name= $FORM{name};
my $address = $FORM{address};
my $city = $FORM{city};
my $occupation = $FORM{occupation};
my $age = $FORM{age};
my $dbh = DBI->connect("dbi:mysql:dbname=mysql", "root", "password",{ AutoCommit => 0,RaiseError => 1}, ) or die ("Couldn't connect to database: ") , $DBI::errstr;
# my $sth = $dbh->prepare("INSERT INTO persons
# (FirstName, LastName,Address,City)
# values
# ($first_name, $last_name,$address,$city)");
my $query = "insert into userrecords(Address,Age,City,Name,Occupation)
values (?, ?, ?, ?, ?) ";
my $statement = $dbh->prepare($query) or die ("Couldn't connect to database: "), $DBI::errstr;
$statement->execute($address,$age,$city,$name,$occupation) or die ("Couldn't connect to database: "), $DBI::errstr;
$dbh->disconnect();
my $URL = "http://.....:81/cgi-bin/showdata.cgi";
print "Location: $URL\n\n";
exit(0);
When I run my code in the Padre IDE, I get the following errors:
****Error*********
Useless use of a variable in void context at InsertRecord.cgi line 50 (#1)
(W void) You did something without a side effect in a context that does
nothing with the return value, such as a statement that doesn't return a
value from a block, or the left side of a scalar comma operator. Very
often this points not to stupidity on your part, but a failure of Perl
to parse your program the way you thought it would. For example, you'd
get this if you mixed up your C precedence with Python precedence and
said
$one, $two = 1, 2;
when you meant to say
($one, $two) = (1, 2);
Another common error is to use ordinary parentheses to construct a list
reference when you should be using square or curly brackets, for
example, if you say
$array = (1,2);
when you should have said
$array = [1,2];
The square brackets explicitly turn a list value into a scalar value,
while parentheses do not. So when a parenthesized list is evaluated in
a scalar context, the comma is treated like C's comma operator, which
throws away the left argument, which is not what you want. See
perlref for more on this.
This warning will not be issued for numerical constants equal to 0 or 1
since they are often used in statements like
1 while sub_with_side_effects();
String constants that would normally evaluate to 0 or 1 are warned
about.
Useless use of a variable in void context at InsertRecord.cgi line 59 (#1)
Useless use of a variable in void context at InsertRecord.cgi line 60 (#1)
Use of uninitialized value in transliteration (tr///) at InsertRecord.cgi line
23 (#2)
(W uninitialized) An undefined value was used as if it were already
defined. It was interpreted as a "" or a 0, but maybe it was a mistake.
To suppress this warning assign a defined value to your variables.
To help you figure out what was undefined, perl will try to tell you the
name of the variable (if any) that was undefined. In some cases it cannot
do this, so it also tells you what operation you used the undefined value
in. Note, however, that perl optimizes your program and the operation
displayed in the warning may not necessarily appear literally in your
program. For example, "that $foo" is usually optimized into "that "
. $foo, and the warning will refer to the concatenation (.) operator,
even though there is no . in your program.
Use of uninitialized value $ENV{"REQUEST_METHOD"} in string eq at
InsertRecord.cgi line 24 (#2)
Use of uninitialized value $buffer in split at InsertRecord.cgi line 29 (#2)
Location: http://.......:81/cgi-bin/showdata.cgi
Press any key to continue . . .
***********END***********************
What is the issue?
When I was editing your code so that it was more readable, I stumbled upon what I assume is the solution:
You are using $name when inserting into the database, but you use $first_name when getting the value $FORM{name}. So since you used $name above, it has the value of the last name used, whatever that might be. The relevant code snippets:
($name, $value) = split(/=/, $pair);
...
$FORM{$name} = $value;
...
my $first_name = $FORM{name};
...
$statement->execute($address,$age,$city,$name,$occupation)
# ^^^^^--- should be $first_name
Your problem would have been solved if you had used proper scope on your variables, namely something like this:
foreach my $pair (#pairs) {
my ($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%(..)/pack("C", hex($1))/eg;
$FORM{$name} = $value;
}
Then when you later would try to use $name, you would get the error
Global variable "$name" requires explicit package name ...
Which would alert you to your mistake and save you hours in debugging time. When you declare variables at the top of the script, instead of in the smallest possible scope, you effectively disable the protection that use strict 'vars' offers. So don't do that.
Also, you should probably use the CGI module instead of trying to handle it manually. It will make things easier, and safer. Don't forget to perform sanity checks on your data to prevent database injection attacks.
Your script when cleaned up and properly formatted looks like this.
What happens when you replace your code with this:
#!"C:\xampp\perl\bin\perl.exe"
use strict;
use warnings;
use diagnostics;
use DBI;
use CGI qw[param redirect];
my $driver = "mysql";
my $database = "mysql";
my $dsn = "DBI:$driver:database=$database";
my $userid = "root";
my $password = "password";
my $dbh = DBI->connect("dbi:mysql:dbname=mysql", "root", "password",
{ AutoCommit => 0,RaiseError => 1}, )
or die "Couldn't connect to database: ", $DBI::errstr;
my $query = "insert into userrecords(Address,Age,City,Name,Occupation)
values (?, ?, ?, ?, ?) ";
my $statement = $dbh->prepare($query)
or die "Couldn't connect to database: " , $DBI::errstr;
$statement->execute(param('address'), param('age'), param('city'),
param('name'), param('occupation'))
or die "Couldn't connect to database: " , $DBI::errstr;
$dbh->disconnect();
my $URL = "http://.....:81/cgi-bin/showdata.cgi";
print redirect($URL);
I've basically made two changes:
Use the CGI.pm module to handle the CGI interaction (getting the parameters and printing the redirection header).
Fixed your "void context" errors by removing the misplaced parentheses in all of your calls to die.
I'm made no substantive changes to the code, but at least we now have a clean version to go with.
Update: D'oh. It's obvious now the code is cleaned up a bit. If you have "Autocommit" turned off, then you need to commit your changes. Add $dbh->commit between the calls to execute() and disconnect().
The warning comes from this:
or die ("Couldn't connect to database: ") , $DBI::errstr;
The , $DBI::errstr is outside of the die and nothing is done with it, thus being in void context. You want something like this:
or die ("Couldn't connect to database: $DBI::errstr");
Also, your form handling code has some issues. If you're writing CGI scripts, you may as well use the CGI module. Here's a quick cleanup of your code:
#!"C:\xampp\perl\bin\perl.exe"
use diagnostics;
use CGI ':standard';
use DBI;
use strict;
use warnings;
my $driver = "mysql";
my $database = "mysql";
my $dsn = "DBI:$driver:database=$database";
my $userid = "root";
my $password = "password";
my $name = param('name');
my $address = param('address');
my $city = param('city');
my $occupation = param('occupation');
my $age = param('age');
my $dbh = DBI->connect( $dsn, $userid, $password,
{ AutoCommit => 1, RaiseError => 1 },
) or die("Couldn't connect to database: $DBI::errstr");
my $query = <<'END';
INSERT INTO userrecords(Address,Age,City,Name,Occupation)
VALUES ( ?, ?, ?, ?, ?)
END
my $statement = $dbh->prepare($query);
$statement->execute( $address, $age, $city, $name, $occupation );
$dbh->disconnect();
my $URL = "http://.....:81/cgi-bin/showdata.cgi";
print "Location: $URL\n\n";
Note that I've removed many or die statements because you already have RaiseError set to a true value.
For simplicity's sake, I've also (reluctantly) turned on AutoCommit.
I've created a Perl script which is meant to loop through an array (a shortlist of customers who meet certain criteria), execute an external command using system() , then update a field within each row once the operation has completed.
It works on the first record (ie external command executes, customer record updates), however when it gets to the second record I receive this error:
DBD::mysql::st fetchrow_array failed: fetch() without execute() at customer_update.pl
Through some googling I added the $sth->finish(); command, however whether I include it or not (either inside the loop as shown, or straight afterward) I still get the same error.
Can anyone shed any light for me as to what I am doing wrong here?
Here's an extract:
# PERL MYSQL CONNECT()
$dbh = DBI->connect('dbi:mysql:signups', $user, $pw)
or die "Connection Error: $DBI::errstr\n";
# DEFINE A MySQL QUERY
$myquery = "SELECT * FROM accounts WHERE field3 = false";
$sth = $dbh->prepare($myquery);
# EXECUTE THE QUERY
$sth->execute
or die "SQL Error: $DBI::errstr\n";
#records = $sth->rows;
print "Amount of new customers: #records\n\n";
while ( my ($field1, $field2, $field3) = $sth->fetchrow_array() ) {
#execute external command via system();
$update_customer_status = "UPDATE accounts SET field3=true WHERE id=$id";
$sth = $dbh->prepare($update_customer_status);
$sth->execute
or die "SQL Error: $DBI::errstr\n";
print "Customer record modified & MySQL updated accordingly\n\n";
$sth->finish();
}
Building a SQL statement with variables and then prepare()ing it defeats the purpose of the prepare. You should build the SQL statement with a placeholder ? instead of $id, prepare() it, and then execute($id) it. As it is, you are leaving yourself open to SQL injection attacks.
Also, it seems that you are not using the warnings and strict pragmas. These two lines should be at the top of every program you write:
use warnings;
use strict;
They will save you much heartache and frustration in the future.
In your loop, you overwrite the handle over from which you are fetching. Use a different variable. (Changing $sth = ...; to my $sth = ...; will do.) While we're at it, let's move the prepare out of the loop.
my $sth_get = $dbh->prepare("SELECT * FROM accounts WHERE field3 = false");
my $sth_upd = $dbh->prepare("UPDATE accounts SET field3=true WHERE id = ?");
$sth_get->execute();
while ( my ($field1, $field2, $field3) = $sth_get->fetchrow_array() ) {
...
$sth_upd->execute($id);
}
You are stomping on your $sth variable when you execute this line ...
$sth = $dbh->prepare($update_customer_status);
Why not save off the result of $sth->fetchrow_array() to an array variable.
Something like ...
my #select_results_AoA = $sth->fetchrow_array();
... and then iterate over the array ...
for my #row ( #select_resilts_AoA ) {
... instead of ...
while ( my ($field1, $field2, $field3) = $sth->fetchrow_array() ) {
Below, is the code to connect mysql database and retrieving results using perl.
In the below example, samples table has 10 columns. I just want the second and third columns of record 99 into variables.
Can some one help me in this?
use strict;
use warnings;
use DBI;
my $dbh = DBI->connect('dbi:mysql:perltest','root','password') or die "Connection Error: $DBI::errstr\n";
my $sql = "select * from samples where record='99'";
my $sth = $dbh->prepare($sql);
$sth->execute or die "SQL Error: $DBI::errstr\n";
while (my #row = $sth->fetchrow_array) {
print "#row\n";
}
Thanks in advance
This code will get you the second and third columns of the row into variables:
while (my #row = $sth->fetchrow_array) {
$var1 = #row[1];
$var2 = #row[2];
}
How do I call MySQL stored procedures from Perl? Stored procedure functionality is fairly new to MySQL and the MySQL modules for Perl don't seem to have caught up yet.
MySQL stored procedures that produce datasets need you to use Perl DBD::mysql 4.001 or later. (http://www.perlmonks.org/?node_id=609098)
Below is a test program that will work in the newer version:
mysql> delimiter //
mysql> create procedure Foo(x int)
-> begin
-> select x*2;
-> end
-> //
perl -e 'use DBI; DBI->connect("dbi:mysql:database=bonk", "root", "")->prepare("call Foo(?)")->execute(21)'
But if you have too old a version of DBD::mysql, you get results like this:
DBD::mysql::st execute failed: PROCEDURE bonk.Foo can't return a result set in the given context at -e line 1.
You can install the newest DBD using CPAN.
There's an example in the section on Multiple result sets in the DBD::mysql docs.
#!/usr/bin/perl
# Stored Proc - Multiple Values In, Multiple Out
use strict;
use Data::Dumper;
use DBI;
my $dbh = DBI->connect('DBI:mysql:RTPC;host=db.server.com',
'user','password',{ RaiseError => 1 }) || die "$!\n";
my $sth = $dbh->prepare('CALL storedProcedure(?,?,?,?,#a,#b);');
$sth->bind_param(1, 2);
$sth->bind_param(2, 1003);
$sth->bind_param(3, 5000);
$sth->bind_param(4, 100);
$sth->execute();
my $response = $sth->fetchrow_hashref();
print Dumper $response . "\n";
It took me a while to figure it out, but I was able to get what I needed with the above. if you need to get multiple return "lines" I'm guessing you just...
while(my $response = $sth->fetchrow_hashref()) {
print Dumper $response . "\n";
}
I hope it helps.
First of all you should be probably connect through the DBI library and then you should use bind variables. E.g. something like:
#!/usr/bin/perl
#
use strict;
use DBI qw(:sql_types);
my $dbh = DBI->connect(
$ConnStr,
$User,
$Password,
{RaiseError => 1, AutoCommit => 0}
) || die "Database connection not made: $DBI::errstr";
my $sql = qq {CALL someProcedure(1);} }
my $sth = $dbh->prepare($sql);
eval {
$sth->bind_param(1, $argument, SQL_VARCHAR);
};
if ($#) {
warn "Database error: $DBI::errstr\n";
$dbh->rollback(); #just die if rollback is failing
}
$dbh->commit();
Mind you i haven't tested this, you'll have to lookup the exact syntax on CPAN.
Hi, similar to above but using SQL exec. I could not get the CALL command to work. You will need to fill in anything that is within square brackets and remove the square brackets.
use DBI;
#START: SET UP DATABASE AND CONNECT
my $host = '*[server]*\\*[database]*';
my $database = '*[table]*';
my $user = '*[user]*';
my $auth = '*[password]*';
my $dsn = "dbi:ODBC:Driver={SQL Server};Server=$host;Database=$database";
my $dbh = DBI->connect($dsn, $user, $auth, { RaiseError => 1 });
#END : SET UP DATABASE AND CONNECT
$sql = "exec *[stored procedure name]* *[param1]*,*[param2]*,*[param3]*;";
$sth = $dbh->prepare($sql);
$sth->execute or die "SQL Error: $DBI::errstr\n";