I just started using Perl. I am able to connect to my MySQL database, create tables and get query results using my Perl Script. I came across a task that involves "You MUST use the provided DB.pm for all database interaction, and you must use it as it is (DB.pm cannot be modified except for the connection settings)."
What does that mean? Any one can guide me in the right direction ?
DB.pm file contains the following code
package GUI::DB;
use strict;
use DBI;
use vars qw(#ISA #EXPORT);
use Exporter;
#ISA = qw(Exporter);
#EXPORT = qw(dbConnect query);
#
# dbConnect - connect to the database, get the database handle
#
sub dbConnect {
# Read database settings from config file:
my $dsn = "DBI:mysql:database=test";
my $dbh = DBI->connect( $dsn,
'',
'',
{ RaiseError => 1 }
);
return $dbh;
}
#
# query - execute a query with parameters
# query($dbh, $sql, #bindValues)
#
sub query {
my $dbh = shift;
my $sql = shift;
my #bindValues = #_; # 0 or several parameters
my #returnData = ();
# issue query
my $sth = $dbh->prepare($sql);
if ( #bindValues ) {
$sth->execute(#bindValues);
} else {
$sth->execute();
}
if ( $sql =~ m/^select/i ) {
while ( my $row = $sth->fetchrow_hashref ) {
push #returnData, $row;
}
}
# finish the sql statement
$sth->finish();
return #returnData;
}
__END__
Probably, it means, that in your code you must use something like this:
use GUI::DB;
my $dbh = dbConnect();
my $sql = qq{SELECT * FROM my_table};
my #data = query($sql, $dbh);
You interact with the database through the provided module.
Related
I am trying to achieve this sample output from a small Perl project like this
content1
relatedcontent1
relatedcontent2
relatedcontent2
content2
relatedcontent1
relatedcontent2
here is my code
#!C:/Perl64/bin/perl.exe
use strict;
use warnings;
use v5.10; # for say() function
use DBI;
use HTML::Table;
# MySQL database configurations
my $dsn = "DBI:mysql:naxum";
my $username = "root";
my $password = '';
print "Content-Type:text/html\r\n\r\n";
# connect to MySQL database
my %attr = ( PrintError=>0, # turn off error reporting via warn()
RaiseError=>1 # report error via die()
);
my $dbh = DBI->connect($dsn,$username,$password,\%attr);
# query data from the sponsor table
query_sponsor($dbh);
query_person_by_target($dbh);
sub query_sponsor{
# query from the table
my ($dbh) = #_;
my $sql = "SELECT name,id FROM sponsor";
my $sth = $dbh->prepare($sql);
# execute the query
$sth->execute();
print "<table>\n";
print "<thead>\n";
print "<tr>\n";
print "<th>Id</th>\n";
print "<th>Name</th>\n";
print "</tr>\n";
print "</thead>\n";
print "<tbody>\n";
while(my #row = $sth->fetchrow_array()){
print "<tr>\n";
print "<td>\n";
print $row['1'];
sub query_person_by_target{
my ($dbhPerson) = #_;
my $sqlPerson = "SELECT username, firstname FROM person WHERE sponsor_id = ?";
my $sthPerson = $dbhPerson->prepare($sqlPerson);
$sthPerson->execute($row['1']) or die "execution failed: $dbhPerson->errstr()";
while ( my #rowPerson = $sthPerson->fetchrow_array()){
print "<p>$rowPerson['0']</p>\n";
}
$sth->finish();
}
print "</td>\n";
print "<td>$row['0']</td>\n";
print "</tr>\n";
}
$sth->finish();
print "</tbody>\n";
print "</table>\n";
}
$dbh->disconnect();
However, I can't get the output what I am trying to achieve. Here is the result
content1
content2
content3
.....
relatedcontent1
It will just print one related content outside contents. Every content and its own at least 3 relatedcontent each.
You define your subroutines in the middle of other code in your program. This makes me think you expect them to be executed as they are defined, but that's not the case - they are executed as you call them. And you call them like this:
query_sponsor($dbh);
query_person_by_target($dbh);
So it should come as no surprise that you get all of the output from query_sponsor() followed by all of the output from query_person_by_name().
A far better approach would be to call query_person_by_target() from within query_sponsor(). I'd also split this into two phases - phase one to extract the data into a data structure and phase two to display that data.
As I don't have your database, this code is untested.
#!/usr/bin/perl
use strict;
use warnings;
use feature 'state'; # for state variables
use feature 'say';
use CGI 'header';
sub get_dbh {
# MySQL database configurations
my $dsn = "DBI:mysql:naxum";
my $username = "root";
my $password = '';
# connect to MySQL database
my %attr = (
PrintError=>0, # turn off error reporting via warn()
RaiseError=>1, # report error via die()
);
return DBI->connect($dsn, $username, $password, \%attr);
}
sub query_sponsor {
state $dbh = get_dbh();
my $sql = 'select name, id from sponsor';
my $sth = $dbh->prepare($sql);
$sth->execute;
my #sponsors;
while (my #row = $dbh->fetchrow_array) {
push #sponsors, {
name => $row[0],
id => $row[1],
people => get_people_for_sponsor($row[1]),
};
}
return #sponsors;
}
sub get_people_for_sponsor {
my ($sponsor_id) = #_;
state $dbh = get_dbh;
my $sql = 'select username, firstname
from person
where sponsor_id = ?';
my $sth = $dbh->prepare;
$sth->execute($sponsor_id);
my #people;
while (my #row = $sth->fetchrow_array) {
push #people, {
username => $row[0],
firstname => $row[1],
};
}
return \#people;
}
my #sponsors = query_sponsor();
# Now you have all of your data in #sponsors. You simply need
# to walk that array and use the data to build the output you
# want. My example is plain text - it shouldn't be too hard to
# convert it to HTML.
print header('text/plain');
for my $s (#sponsors) {
say "$s->{id}: $s->{name}";
for my $p (#{$s->{people}}) {
say "* $p->{firstname} / $p->{username}";
}
}
I'd also recommend that you look at using something like the Template Toolkit to produce your output. Putting raw HTML into your Perl program is a terrible idea - it is guaranteed to turn into an unmaintainable mess :-)
You have declared the two subroutines and you are calling one after one so it is executing like that for example consider the following one
sub1();
sub2();
sub sub1()
{
for(0..5)
{
print "hello\n";
sub sub2()
{
print "hi\n";
}
}
}
#output
hello
hello
hello
hello
hello
hello
hi
So you should remove the child query_person_by_target subroutine or call the child subroutine inside the parent subroutine query_sponsor and declare the child subroutine outside of the sub and loop, like below (not tested)
query_sponsor($dbh);
sub query_sponsor
{
# query from the table
my ($dbh) = #_;
my $sql = "SELECT name,id FROM sponsor";
my $sth = $dbh->prepare($sql);
# execute the query
$sth->execute();
print "<table>\n";
print "<thead>\n";
print "<tr>\n";
print "<th>Id</th>\n";
print "<th>Name</th>\n";
print "</tr>\n";
print "</thead>\n";
print "<tbody>\n";
while(my #row = $sth->fetchrow_array())
{
print "<tr>\n";
print "<td>\n";
print $row['1'];
query_person_by_target($dbh);
print "</td>\n";
print "<td>$row['0']</td>\n";
print "</tr>\n";
}
$sth->finish();
print "</tbody>\n";
print "</table>\n";
}
sub query_person_by_target{
my ($dbhPerson) = #_;
my $sqlPerson = "SELECT username, firstname FROM person WHERE sponsor_id = ?";
my $sthPerson = $dbhPerson->prepare($sqlPerson);
$sthPerson->execute($row['1']) or die "execution failed: $dbhPerson->errstr()";
while ( my #rowPerson = $sthPerson->fetchrow_array()){
print "<p>$rowPerson['0']</p>\n";
}
$sth->finish();
}
$dbh->disconnect();
I have currently working on perl script.
Select Column1,Column2,Column3.. from table.
This query contain some part in $cmd="Select Column1 ";
and other $cmd1=",Column2,Column3 from table"; // This is dynamic part, so split query in two different variable.
After this execute whole query.
How to do this query splitting part.?
use DBI;
use strict;
use warnings;
# Your input !
my $cmd = "Select Column1 ";
my $cmd1 = ",Column2,Column3 from table";
# I am wondering why you have your query like this ...
# but anyway, lets assume there's a reason behind this!
my $dbh =
DBI->connect(
'DBI:mysql:databasename;host=db.example.com', # TODO Change this
'username', # TODO change this
'password', # TODO change this
{ RaiseError => 1 }
) or die "Could not connect to database: $DBI::errstr";
my $sth = $dbh->prepare( $cmd . $cmd1 );
$sth->execute();
my #row;
while ( #row = $sth->fetchrow_array ) {
print "#row\n";
}
I can't seem to figure out the issue with my .pm file and script. I am fairly new to Perl.
I have a database with name "project" and there is table with name "mailing".
mailing table has 7 entries, which I want to display using module.
So, I have this custom module to log in to database and do a query. This module is names as DB.pm
DB.pm is stored on my FEDORA 20 at /root/mysql/GUI/DB.pm.
DB.pm is defined as follows:
package GUI::DB;
use strict;
use DBI;
use vars qw(#ISA #EXPORT);
use Exporter;
#ISA = qw(Exporter);
#EXPORT = qw(dbConnect query);
#
# dbConnect - connect to the database, get the database handle
#
sub dbConnect {
# Read database settings from config file:
print "Works";
my $dsn = "DBI:mysql:project";
my $dbh = DBI->connect( $dsn,
'root',
'mydatabasepassword',
{ RaiseError => 1 }
);
return $dbh;
}
#
# query - execute a query with parameters
# query($dbh, $sql, #bindValues)
#
sub query {
my $dbh = shift;
my $sql ="SELECT * FROM mailing";
my #bindValues = #_; # 0 or serveral parameters
my #returnData = ();
# issue query
my $sth = $dbh->prepare($sql); //**line number 39 that is giving** error
if ( #bindValues ) {
$sth->execute(#bindValues);
} else {
$sth->execute();
}
if ( $sql =~ m/^select/i ) {
while ( my $row = $sth->fetchrow_hashref ) {
push #returnData, $row;
}
}
# finish the sql statement
$sth->finish();
return #returnData;
}
1;
Now I want to use this module inside my per script. This is what I tried:
#!/usr/bin/perl
use warnings;
use strict;
use lib '/root/mysql/';
use GUI::DB qw(dbConnect query);
dbConnect();
query();
This is the error I'm getting -->
Can't call method "prepare" on an undefined value at /root/mysql/GUI/DB.pm line 39.
Please help me with this. I am not sure how to proceed. I am guessing it has something to do with argument passing. Nothing is wrong with database. It works fine from CLI.
Thanks :)
_x_X_X_X_X_X_X_X_X_X_X_X_X_X_X_X__X_X_X_X_X__X
TILL HERE IT IS RESOLVED
_X_X_X_X_X_X_X_X_X_X_X_X_X_X_X_X_X__X_X_X
FURTHER ISSUE is SQL command is not working.
In the mailing table of my database I have email id with different domains.
For example, some id's are xyz#gmail.com, 12343#gmail.com , bae#yahoo.com as so on and I am assuming new email ids will be added to mailing tables every day with different domains.
I am trying to write a scripts that updates another table which holds a daily count of email addresses by their domain name. This is what I tried:
#!/usr/bin/perl
use warnings;
use strict;
use lib '/root/mysql/';
use 5.016;
use Data::Dumper;
use GUI::DB qw(dbConnect query);
my $data = dbConnect();
my #domain = query($data, "SELECT substr(addr,locate('\#',addr)+1) as maildomain, count (*) as mailcount FROM mailing GROUP BY maildomain ORDER BY mailcount DESC");
for my $key (#domain){
say Dumper ($key);
}
But I am getting an error,
You have an error in your SQL syntax; check the manual that corresponds to your MariaDB server version for the right syntax to use near '*) as mailcount FROM mailing GROUP BY maildomain ORDER BY mailcount DESC' at line 1 at /root/mysql/GUI/DB.pm line 44.
Same SQL statement works from CLI with no issues.
Any help would be appreciated. :)
1) Your error is saying that $dbh is undefined here:
sub query {
my $dbh = shift;
...
# issue query
my $sth = $dbh->prepare($sql); #<***LOOK HERE***
...which means $dbh must be undefined here:
sub query {
my $dbh = shift; #<***LOOK HERE***
...
# issue query
my $sth = $dbh->prepare($sql);
2) Let's see why. Your dbConnect() method returns $dbh:
sub dbConnect {
# Read database settings from config file:
print "Works";
my $dsn = "DBI:mysql:project";
my $dbh = DBI->connect(
$dsn,
'root',
'mydatabasepassword',
{ RaiseError => 1 }
);
return $dbh; #<***LOOK HERE*****
}
3) But, you call dbConnect() like this:
dbConnect();
Because you never save the return value anywhere, $dbh is discarded.
4) Furthermore, you call query() like this:
query();
Yet, you defined query() like this:
sub query {
my $dbh = shift;
The query() sub believes that the first argument will be the database handle--but you didn't call query() with any arguments.
You need to do this:
my $data_base_handle = dbConnect();
my #results = query($data_base_handle);
#do something with #results
Response to comment:
I printed #results, this is what I see HASH(0x1d05be8)
HASH(0x1d05ba0) HASH(0x1d05b58) HASH(0x1d05b10) HASH(0x1d05ac8)
HASH(0x1d05a80) HASH(0x1d05a38)
You wrote:
my $row = $sth->fetchrow_hashref;
...which asks DBI to return each row as a reference to a hash. Then you wrote:
push #returnData, $row;
...which pushed each hash reference into an array. So query() returns an array of hash references. The notation HASH(0x1d05be8) is what perl outputs when you print a hash reference.
If you want to see what's in those hashes, then do this:
use 5.016; #enable say()
use Data::Dumper;
...
...
for my $href (#results) {
say Dumper($href);
}
To access the data in a hash reference, you can do this:
use strict;
use warnings;
use 5.016;
use Data::Dumper;
my $href = {
c => 3,
a => 1,
b => 2,
};
my %hash = %{$href}; #dereference, {}, the reference into a hash, %
for my $key ( keys %hash ) {
say "$key $hash{$key}";
}
--output:--
c 3
a 1
b 2
Response to next comment:
(Answer posted in comments under op.)
By the way, perl is pretty good at text processing, so if you couldn't figure out the problem with your query, you could process the email addresses with perl:
use strict;
use warnings;
use 5.012;
use Data::Dumper;
use DBI;
use DBD::mysql;
# CONFIG VARIABLES
my $db_type = "mysql";
my $database = "my_db";
my $host = "localhost";
my $port = "3306";
my $user = "root";
my $pword = "";
# DATA SOURCE NAME
my $dsn = "dbi:$db_type:$database:$host:$port";
# PERL DBI CONNECT
my $dbh = DBI->connect($dsn, $user, $pword);
# PREPARE THE QUERY
my $tablename = "mailing";
my $select =<<"END_OF_SELECT";
select addr from $tablename
END_OF_SELECT
my $addr_aref = $dbh->selectcol_arrayref($select); #Returns a reference to a flat array containing all the email addresses
$dbh->disconnect;
my %count_for;
for my $addr (#{$addr_aref}) {
$addr =~ s/.*#//;
$count_for{$addr}++;
}
say Dumper(\%count_for);
--output:--
$VAR1 = {
'google.com' => 2,
'gorilla.com' => 1,
'yahoo.com' => 3
};
I have created a code that connects to database and i want to delete data from database using a button the same for update. but i just can display data in a table and cant delete.
my $q= new CGI;
print $q->header;
print $q-> start_html(
-title => "",
);
# print $q->start_form;
## mysql user database name
my $db = "people";
## mysql database user name
my $user = "root";
## mysql database password
my $pass = "";
## user hostname : This should be "localhost" but it can be diffrent too
my $host="127.0.0.1";
## SQL query
my $query = "select ID,Name,Surname,Gender from person";
my $dbh = DBI->connect("DBI:mysql:$db:$host", $user, $pass);
my $sqlQuery = $dbh->prepare($query)
or die "Can't prepare $sqlQuery: $dbh->errstr\n";
my $rv = $sqlQuery->execute
or die "can't execute the query: $sqlQuery->errstr";
print start_form (-method => 'post', -action => "modify.pl" );
my #aRows;
while (my #data = $sqlQuery->fetchrow_array()) {
my $cRowId = hidden('ID', $data[0]);
my $bt1 = submit('action','delete');
my $bt2 = submit('action','update');
push #aRows, ($cRowId, $q->Tr($q->td([$data[1], $data[2], $data[3],$bt1,$bt2])));
}
print $q->table({-border =>'1', -align =>'center', -width => '100%'},
$q->Tr([$q->th([ 'Name', 'Surname', 'Gender', 'Delete', 'Update', ])]),
#aRows,
);
print $q->input({-type => 'button', -class => 'button', -onclick => "window.location.href='insert.pl';", -value => 'Shto'});
print $q->end_form;
print $q->end_html;
delete.pl
use CGI;
use CGI qw(standard);
use DBI;
use CGI::Carp qw(set_die_handler);
use CGI qw/:all/;
BEGIN {
sub handle_errors {
my $msg = shift;
print "content-type: text/html\n\n";
#proceed to send an email to a system administrator,
#write a detailed message to the browser and/or a log,
#etc....
}
set_die_handler(\&handle_errors);
}
my $q = CGI->new();
my $db = "people";
my $user = "root";
my $pass = "";
my $host="127.0.0.1";
my $dbh = DBI->connect("DBI:mysql:$db:$host", $user, $pass);
my $action = $q->param('action'){
given ($action){
when('delete'){
my $row_id = $q->param('ID');
my $sth = $dbh->prepare("DELETE FROM person WHERE ID = $row_id ") or die "Can't prepare $query: $dbh->errstr\n";
my $rv = $sth->execute() or die $DBI::errstr;
print "deleted";
my $sth->finish();
my $dbh->commit or die $DBI::errstr;
}
} }
I dont know where may be the problem
The vast majority of Perl CGI problems can be solved by:
Adding use strict and use warnings to your code
Fixing all of the errors that now appear in your error log
You assign a value to $row_id after you try to use that variable to create your query.
Additionally, using raw user input in SQL queries makes you vulnerable to XSS attacks. Rewrite your code to use parameterized queries
Do not use my if you do not want a new variable. Remove all my's from the method calls:
my $sth->finish();
my $dbh->commit or die $DBI::errstr;
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";