Table of Contents:
Nowadays millions of users surf the Internet. There are millions of
Terabytes of data laying around. To manipulate that data new smart
techniques and technologies were invented. One of the major inventions was
a relational database, which allows to search and modify huge data storages
in zero time. It uses SQL (Structured Query Language) to manipulate contents of these databases. Of
course once we started to use the web, we have found a need to write web
interfaces to these databases and CGI was and is the mostly used technology
for building such interfaces. The main limitation for a CGI script driving
a database versus application, is its statelessness - on every request the
CGI script has to initiate a connection to the database, when the request
is completed the connection is lost. Apache::DBI
was written to remove this limitation. When you use it, you have a
persistent database connection over the process' life. As you understand
this possible only with CGI running under mod_perl enabled server, since
the child process does not quit when the request has been served. So when a
mod_perl script needs to _talk_ to a database, he starts _talking_ right
away, without initiating a database connection first, Apache::DBI
worries to provide a valid connection immediately. Of course the are more
nuances, which will be talked about in the following sections.
This module initiates a persistent database connection. It is possible only with mod_perl.
When loading the DBI module (do not confuse this with the Apache::DBI module) it looks if the environment variable GATEWAY_INTERFACE starts with 'CGI-Perl' and if the module Apache::DBI has been loaded. In this case every connect request will be forwarded to the Apache::DBI module. This looks if a database handle from a previous connect request is already stored and if this handle is still valid using the ping method. If these two conditions are fulfilled it just returns the database handle. If there is no appropriate database handle or if the ping method fails, a new connection is established and the handle is stored for later re-use. In other words when the script is run again from a child that has already (and is still) connected, the host/username/password is checked against the cache of open connections, and if one is available, uses that one. There is no need to delete the disconnect statements from your code. They won't do anything because the Apache::DBI module overloads the disconnect method with a NOP (like an empty call).
You want to use this module if you are opening a few DB connections to the server. Apache::DBI
will make them persistent per child, so if you have 10 children and each
opens 2 different connections you will have in total 20 opened persistent
connections. Thus after initial connect you will save up the connection
time for every connect request from your DBI module. Which is a huge
benefit for the mod_perl apache server with high traffic of users deploying
the relational DB.
As you understand you must NOT use this module if you are opening a special
connection for each of your users, since each of them will stay persistent
and in a short time the number of connections will be so big that your
machine will scream and die. If you want to use
Apache::DBI
in both situations, as of this moment the only available solution is to run
2 mod_perl servers, one using
Apache::DBI
and one not.
After installing this module, the configuration is simple - add to the
httpd.conf
the following directive.
PerlModule Apache::DBI
Note that it is important, to load this module before any other ApacheDBI module !
You can skip preloading DBI
, since Apache::DBI
does that. But there is no harm if you leave it in.
If you want that when you call the script after server restart, the
connection will be already preopened, you should use
connect_on_init()
method in the startup file to preload every connection you are going to
use. For example:
Apache::DBI->connect_on_init ("DBI:mysql:myDB::myserver", "username", "passwd", { PrintError => 1, # warn() on errors RaiseError => 0, # don't die on error AutoCommit => 1, # commit executes immediately } );
As noted before, it is wise to you this method only if you only want all of apache to be able to connect to the database server as one user (or few users).
Be warned though, that if your database is down, apache children will get
delayed trying to connect_on_init()
. They won't begin serving requests until they get logged in, or the login
attempt fails (which can take several minutes (depending on your DBD
driver).
If you are not sure this module is working as advertised, you should enable the Debug mode in the startup script by:
$Apache::DBI::DEBUG = 1;
Since now on you will see in the error.log
file when Apache::DBI initializes a connection and when it just returns it
from its cache. Use the following command to see it in the real time (your
error.log
file might be locate at a different path):
tail -f /usr/local/apache/logs/error_log
I use alias
(in tcsh
) so I will not have to remember the path:
alias err "tail -f /usr/local/apache/logs/error_log"
Another approach is to add to httpd.conf
(which does the same):
PerlModule Apache::DebugDBI
SQL server keeps the connection to the client open for a limited period of
time. So many developers were bitten by so called Morning
bug when every morning the first users to use the site were receiving:
No Data Returned
message, but then everything worked as usual. The error caused by Apache::DBI
returning a handle of the invalid connection (server closed it because of
timeout), and the script was dying on that error. The infamous and well
documented in the man page,
ping()
method was introduced to solve this problem. But seems that people are
still being beaten by this problem. Another solution was found - to rise
the timeout parameter at the SQL server startup. Currently I startup mySQL
server with safe_mysql
script, so I have updated it to use this option:
nohup $ledir/mysqld [snipped other options] -O wait_timeout=172800
Where 172800 secs equal to 48 hours. And it works.
Note that starting from ver. 0.82
, Apache::DBI
implements ping inside the eval
block, so if the handle has been timed out, it should reconnect without
creating the morning bug.
Q: Currently I am running into a problem where I found out that
Apache::DBI
insists that the connection will opened exactly the same way before it will
decide to use a cached connection. I.e. if I have one script that sets LongReadLen
and one that does not, it will be two different connections. Instead of
having a max of 40 open connections, I end up with 80.
A: indeed, Apache::DBI
returns a cached database handle, if and only if all parameters including
all options are identical. But you are free to modify the handle right
after you got it from the cache. Initiate the connections always using the
same parameters and set LongReadLen
afterwards.
Q: I cannot find the handler name with which to manipulate my connection; hence I seem to be unable to do anything to my database.
A: You did not use DBI::connect()
as with usual DBI usage to get your $dbh
database handler.
Using the Apache::DBI
does not eliminate the need to write a proper DBI
code. As the man page states - you should program as if you did not use Apache::DBI
at all. Apache::DBI
will override and return you a cached connection. And in case of disconnect()
call it will be just ignored.
Make sure you have it installed.
Make sure you configured mod_perl with EVERYTHING=1.
Use the example script eg/startup.pl (remove the comment from the line
#use Apache::DebugDBI;
and adapt the connect string. Do not change anything in your scripts, for using Apache::DBI.
Does your error_log looks like this:
10169 Apache::DBI PerlChildInitHandler 10169 Apache::DBI skipping connection cache during server startup Database handle destroyed without explicit disconnect at /usr/lib/perl5/site_perl/5.005/Apache/DBI.pm line 29.
then you are trying to open a database connection in the parent httpd process. If you do, children will get a copy of this handle, causing clashes when the handle is used by two processes at the same time. Each child must have its own unique connection handle.
To avoid this problem, Apache::DBI
checks whether it is called during server startup. In this case the module
skips the connection cache and returns immediately without a database
handle.
You have to use the method Apache::DBI->connect_on_init()
in the startup file.
Since many mod_perl developers uses mysql as their preferable engine, these
notes explain the difference between mysql_use_result()
and
mysql_store_result()
. The two influence the speed/size of the processes. DBD::mysql
documentation includes the following (version 2.0217) snippet:
mysql_use_result attribute: This forces the driver to use mysql_use_result rather than mysql_store_result. The former is faster and less memory consuming, but tends to block other processes. (That's why mysql_store_result is the default.)
Think about it in client/server terms. When you ask the server to
spoon-feed you the data as you use it, the server process must now buffer
the data and tie up that thread and possibly keep any database locks open
for a much longer time. So if you read a row of data, and ponder it for a
while, the tables you have locked are still locked, and the server is busy
talking to you every so often. That is
mysql_use_result()
.
If you just suck down the whole dataset to the client, then the server is
free to go about its business serving other requests. This results in
parallelism since the server and client are doing work at the same time,
rather than blocking on each other doing frequent I/O. That is
mysql_store_result()
.
As mysql manual suggests: you should not use mysql_use_result()
if you are doing a lot of processing for each row on the client side. This
will tie up the server and prevent other threads from updating any tables
from which the data are fetched.
In this section you will find scripts, modules and code snippets to help
get yourself started to use relational Databases with mod_perl scripts.
Note that I work with mysql
( http://www.mysql.com ), so the code
you will find will work out of box with mysql, if you use some other SQL
engine, it might work for you as well, or some changes should be applied.
Having to write many queries in my CGI scripts, made me to write a stand alone module that saves me a lot of time in writing and debugging my code. It also makes my scripts are much smaller and easier to read. I will present the module here, afterwards examples will follow:
Notice the DESTROY
block at the end of the module, which makes various cleanups and allows
this module to be used under mod_cgi
as well.
(note that you will not find it on CPAN)
package My::DB; use strict; use 5.004; use DBI; use vars qw(%c); %c = ( # DB debug #db_debug => 1, db_debug => 0, db => { DB_NAME => 'foo', SERVER => 'localhost', USER => 'put_username_here', USER_PASSWD => 'put_passwd_here', }, ); use Carp qw(croak verbose); #local $SIG{__WARN__} = \&Carp::cluck; # untaint the path by explicit setting local $ENV{PATH} = '/bin:/usr/bin'; ####### sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; # connect to the DB, Apache::DBI worries to cache the connections # save into a dbh - Database handle object $self->{dbh} = DBI->connect("DBI:mysql:$c{db}{DB_NAME}::$c{db}{SERVER}", $c{db}{USER}, $c{db}{USER_PASSWD}, { PrintError => 1, # warn() on errors RaiseError => 0, # don't die on error AutoCommit => 1, # commit executes immediately } ) or DBI->disconnect("Cannot connect to database: $DBI::errstr\n"); # we want to die on errors if in debug mode $self->{dbh}->{RaiseError} = 1 if $c{'db_debug'}; # init the sth - Statement handle object $self->{sth} = ''; bless ($self, $class); $self; } # end of sub new ###################################################################### ################################### ### ### ### SQL Functions ### ### ### ################################### ###################################################################### # print debug messages sub d{ # we want to print in debug mode the trace print "<DT><B>".join("<BR>", @_)."</B>\n" if $c{'db_debug'}; } # end of sub d ###################################################################### # return a count of matched rows, by conditions # # $count = sql_count_matched($table_name,\@conditions); # # conditions must be an array so we can path more than one column with # the same name. # # @conditions = ( column => ['comp_sign','value'], # foo => ['>',15], # foo => ['<',30], # ); # # The sub knows automatically to detect and quote strings # ########################## sub sql_count_matched{ my $self = shift; my $table = shift || ''; my $r_conds = shift || []; # we want to print in debug mode the trace d( "[".(caller(2))[3]." - ".(caller(1))[3]." - ". (caller(0))[3]."]"); # build the query my $do_sql = "SELECT COUNT(*) FROM $table "; my @where = (); for(my $i=0;$i<@{$r_conds};$i=$i+2) { push @where, join " ", $$r_conds[$i], $$r_conds[$i+1][0], sql_quote(sql_escape($$r_conds[$i+1][1])); } # Add the where clause if we have one $do_sql .= "WHERE ". join " AND ", @where if @where; d("SQL: $do_sql"); # do query $self->{sth} = $self->{dbh}->prepare($do_sql); $self->{sth}->execute(); my ($count) = $self->{sth}->fetchrow_array; d("Result: $count"); $self->{sth}->finish; return $count; } # end of sub sql_count_matched ###################################################################### # return a single (first) matched value or undef, by conditions and # restrictions # # sql_get_matched_value($table_name,$column,\@conditions,\@restrictions); # # column is a name of the column # # conditions must be an array so we can path more than one column with # the same name. # @conditions = ( column => ['comp_sign','value'], # foo => ['>',15], # foo => ['<',30], # ); # The sub knows automatically to detect and quote strings # # restrictions is a list of restrictions like ('order by email') # ########################## sub sql_get_matched_value{ my $self = shift; my $table = shift || ''; my $column = shift || ''; my $r_conds = shift || []; my $r_restr = shift || []; # we want to print in debug mode the trace d( "[".(caller(2))[3]." - ".(caller(1))[3]." - ". (caller(0))[3]."]"); # build the query my $do_sql = "SELECT $column FROM $table "; my @where = (); for(my $i=0;$i<@{$r_conds};$i=$i+2) { push @where, join " ", $$r_conds[$i], $$r_conds[$i+1][0], sql_quote(sql_escape($$r_conds[$i+1][1])); } # Add the where clause if we have one $do_sql .= " WHERE ". join " AND ", @where if @where; # restrictions (DONT put commas!) $do_sql .= " ". join " ", @{$r_restr} if @{$r_restr}; d("SQL: $do_sql"); # do query return $self->{dbh}->selectrow_array($do_sql); } # end of sub sql_get_matched_value ###################################################################### # return a single row of first matched rows, by conditions and # restrictions. The row is being inserted into @results_row array # (value1,value2,...) or empty () if non matched # # sql_get_matched_row(\@results_row,$table_name,\@columns,\@conditions,\@restrictions); # # columns is a list of columns to be returned (username, fname,...) # # conditions must be an array so we can path more than one column with # the same name. # @conditions = ( column => ['comp_sign','value'], # foo => ['>',15], # foo => ['<',30], # ); # The sub knows automatically to detect and quote strings # # restrictions is a list of restrictions like ('order by email') # ########################## sub sql_get_matched_row{ my $self = shift; my $r_row = shift || {}; my $table = shift || ''; my $r_cols = shift || []; my $r_conds = shift || []; my $r_restr = shift || []; # we want to print in debug mode the trace d( "[".(caller(2))[3]." - ".(caller(1))[3]." - ". (caller(0))[3]."]"); # build the query my $do_sql = "SELECT "; $do_sql .= join ",", @{$r_cols} if @{$r_cols}; $do_sql .= " FROM $table "; my @where = (); for(my $i=0;$i<@{$r_conds};$i=$i+2) { push @where, join " ", $$r_conds[$i], $$r_conds[$i+1][0], sql_quote(sql_escape($$r_conds[$i+1][1])); } # Add the where clause if we have one $do_sql .= " WHERE ". join " AND ", @where if @where; # restrictions (DONT put commas!) $do_sql .= " ". join " ", @{$r_restr} if @{$r_restr}; d("SQL: $do_sql"); # do query @{$r_row} = $self->{dbh}->selectrow_array($do_sql); } # end of sub sql_get_matched_row ###################################################################### # return a ref to hash of single matched row, by conditions # and restrictions. return undef if nothing matched. # (column1 => value1, column2 => value2) or empty () if non matched # # sql_get_hash_ref($table_name,\@columns,\@conditions,\@restrictions); # # columns is a list of columns to be returned (username, fname,...) # # conditions must be an array so we can path more than one column with # the same name. # @conditions = ( column => ['comp_sign','value'], # foo => ['>',15], # foo => ['<',30], # ); # The sub knows automatically to detect and quote strings # # restrictions is a list of restrictions like ('order by email') # ########################## sub sql_get_hash_ref{ my $self = shift; my $table = shift || ''; my $r_cols = shift || []; my $r_conds = shift || []; my $r_restr = shift || []; # we want to print in debug mode the trace d( "[".(caller(2))[3]." - ".(caller(1))[3]." - ". (caller(0))[3]."]"); # build the query my $do_sql = "SELECT "; $do_sql .= join ",", @{$r_cols} if @{$r_cols}; $do_sql .= " FROM $table "; my @where = (); for(my $i=0;$i<@{$r_conds};$i=$i+2) { push @where, join " ", $$r_conds[$i], $$r_conds[$i+1][0], sql_quote(sql_escape($$r_conds[$i+1][1])); } # Add the where clause if we have one $do_sql .= " WHERE ". join " AND ", @where if @where; # restrictions (DONT put commas!) $do_sql .= " ". join " ", @{$r_restr} if @{$r_restr}; d("SQL: $do_sql"); # do query $self->{sth} = $self->{dbh}->prepare($do_sql); $self->{sth}->execute(); return $self->{sth}->fetchrow_hashref; } # end of sub sql_get_hash_ref ###################################################################### # returns a reference to an array, matched by conditions and # restrictions, which contains one reference to array per row. If # there are no rows to return, returns a reference to an empty array: # [ # [array1], # ...... # [arrayN], # ]; # # $ref = sql_get_matched_rows_ary_ref($table_name,\@columns,\@conditions,\@restrictions); # # columns is a list of columns to be returned (username, fname,...) # # conditions must be an array so we can path more than one column with # the same name. @conditions are being cancatenated with AND # @conditions = ( column => ['comp_sign','value'], # foo => ['>',15], # foo => ['<',30], # ); # results in # WHERE foo > 15 AND foo < 30 # # to make an OR logic use (then ANDed ) # @conditions = ( column => ['comp_sign',['value1','value2']], # foo => ['=',[15,24] ], # bar => ['=',[16,21] ], # ); # results in # WHERE (foo = 15 OR foo = 24) AND (bar = 16 OR bar = 21) # # The sub knows automatically to detect and quote strings # # restrictions is a list of restrictions like ('order by email') # ########################## sub sql_get_matched_rows_ary_ref{ my $self = shift; my $table = shift || ''; my $r_cols = shift || []; my $r_conds = shift || []; my $r_restr = shift || []; # we want to print in debug mode the trace d( "[".(caller(2))[3]." - ".(caller(1))[3]." - ". (caller(0))[3]."]"); # build the query my $do_sql = "SELECT "; $do_sql .= join ",", @{$r_cols} if @{$r_cols}; $do_sql .= " FROM $table "; my @where = (); for(my $i=0;$i<@{$r_conds};$i=$i+2) { if (ref $$r_conds[$i+1][1] eq 'ARRAY') { # multi condition for the same field/comparator to be ORed push @where, map {"($_)"} join " OR ", map { join " ", $r_conds->[$i], $r_conds->[$i+1][0], sql_quote(sql_escape($_)); } @{$r_conds->[$i+1][1]}; } else { # single condition for the same field/comparator push @where, join " ", $r_conds->[$i], $r_conds->[$i+1][0], sql_quote(sql_escape($r_conds->[$i+1][1])); } } # end of for(my $i=0;$i<@{$r_conds};$i=$i+2 # Add the where clause if we have one $do_sql .= " WHERE ". join " AND ", @where if @where; # restrictions (DONT put commas!) $do_sql .= " ". join " ", @{$r_restr} if @{$r_restr}; d("SQL: $do_sql"); # do query return $self->{dbh}->selectall_arrayref($do_sql); } # end of sub sql_get_matched_rows_ary_ref ###################################################################### # insert a single row into a DB # # sql_insert_row($table_name,\%data,$delayed); # # data is hash of type (column1 => value1 ,column2 => value2 , ) # # $delayed: 1 => do delayed insert, 0 or none passed => immediate # # * The sub knows automatically to detect and quote strings # # * The insert id delayed, so the user will not wait untill the insert # will be completed, if many select queries are running # ########################## sub sql_insert_row{ my $self = shift; my $table = shift || ''; my $r_data = shift || {}; my $delayed = (shift) ? 'DELAYED' : ''; # we want to print in debug mode the trace d( "[".(caller(2))[3]." - ".(caller(1))[3]." - ". (caller(0))[3]."]"); # build the query my $do_sql = "INSERT $delayed INTO $table "; $do_sql .= "(".join(",",keys %{$r_data}).")"; $do_sql .= " VALUES ("; $do_sql .= join ",", sql_quote(sql_escape( values %{$r_data} ) ); $do_sql .= ")"; d("SQL: $do_sql"); # do query $self->{sth} = $self->{dbh}->prepare($do_sql); $self->{sth}->execute(); } # end of sub sql_insert_row ###################################################################### # update rows in a DB by condition # # sql_update_rows($table_name,\%data,\@conditions,$delayed); # # data is hash of type (column1 => value1 ,column2 => value2 , ) # # conditions must be an array so we can path more than one column with # the same name. # @conditions = ( column => ['comp_sign','value'], # foo => ['>',15], # foo => ['<',30], # ); # # $delayed: 1 => do delayed insert, 0 or none passed => immediate # # * The sub knows automatically to detect and quote strings # # ########################## sub sql_update_rows{ my $self = shift; my $table = shift || ''; my $r_data = shift || {}; my $r_conds = shift || []; my $delayed = (shift) ? 'LOW_PRIORITY' : ''; # we want to print in debug mode the trace d( "[".(caller(2))[3]." - ".(caller(1))[3]." - ". (caller(0))[3]."]"); # build the query my $do_sql = "UPDATE $delayed $table SET "; $do_sql .= join ",", map { "$_=".join "",sql_quote(sql_escape($$r_data{$_})) } keys %{$r_data}; my @where = (); for(my $i=0;$i<@{$r_conds};$i=$i+2) { push @where, join " ", $$r_conds[$i], $$r_conds[$i+1][0], sql_quote(sql_escape($$r_conds[$i+1][1])); } # Add the where clause if we have one $do_sql .= " WHERE ". join " AND ", @where if @where; d("SQL: $do_sql"); # do query $self->{sth} = $self->{dbh}->prepare($do_sql); $self->{sth}->execute(); # my ($count) = $self->{sth}->fetchrow_array; # # d("Result: $count"); } # end of sub sql_update_rows ###################################################################### # delete rows from DB by condition # # sql_delete_rows($table_name,\@conditions); # # conditions must be an array so we can path more than one column with # the same name. # @conditions = ( column => ['comp_sign','value'], # foo => ['>',15], # foo => ['<',30], # ); # # * The sub knows automatically to detect and quote strings # # ########################## sub sql_delete_rows{ my $self = shift; my $table = shift || ''; my $r_conds = shift || []; # we want to print in debug mode the trace d( "[".(caller(2))[3]." - ".(caller(1))[3]." - ". (caller(0))[3]."]"); # build the query my $do_sql = "DELETE FROM $table "; my @where = (); for(my $i=0;$i<@{$r_conds};$i=$i+2) { push @where, join " ", $$r_conds[$i], $$r_conds[$i+1][0], sql_quote(sql_escape($$r_conds[$i+1][1])); } # Must be very carefull with deletes, imagine somehow @where is # not getting set, "DELETE FROM NAME" deletes the contents of the table warn("Attempt to delete a whole table $table from DB\n!!!"),return unless @where; # Add the where clause if we have one $do_sql .= " WHERE ". join " AND ", @where; d("SQL: $do_sql"); # do query $self->{sth} = $self->{dbh}->prepare($do_sql); $self->{sth}->execute(); } # end of sub sql_delete_rows ###################################################################### # executes the passed query and returns a reference to an array which # contains one reference per row. If there are no rows to return, # returns a reference to an empty array. # # $r_array = sql_execute_and_get_r_array($query); # # ########################## sub sql_execute_and_get_r_array{ my $self = shift; my $do_sql = shift || ''; # we want to print in debug mode the trace d( "[".(caller(2))[3]." - ".(caller(1))[3]." - ". (caller(0))[3]."]"); d("SQL: $do_sql"); $self->{dbh}->selectall_arrayref($do_sql); } # end of sub sql_execute_and_get_r_array # # # return current date formatted for a DATE field type # YYYYMMDD # ############ sub sql_date{ my $self = shift; my ($sec,$min,$hour,$mday,$mon,$year) = localtime(); $year = ($year>70) ? sprintf "19%0.2d",$year : sprintf "20%0.2d",$year; return sprintf "%0.4d%0.2d%0.2d",$year,++$mon,$mday; } # end of sub sql_date # # # return current date formatted for a DATE field type # YYYYMMDDHHMMSS # ############ sub sql_datetime{ my $self = shift; my ($sec,$min,$hour,$mday,$mon,$year) = localtime(); $year = ($year>70) ? sprintf "19%0.2d",$year : sprintf "20%0.2d",$year; return sprintf "%0.4d%0.2d%0.2d%0.2d%0.2d%0.2d",$year,++$mon,$mday,$hour,$min,$sec; } # end of sub sql_datetime # Quote the list of parameters , alldigits parameters are unquoted (int) # print sql_quote("one",2,"three"); => 'one' 2 'three' ############# sub sql_quote{ map{ /^(\d+|NULL)$/ ? $_ : "\'$_\'" } @_ } # Escape the list of parameters (all unsafe chars like ",' are escaped ) # must make a copy of @_ since we might try to change the passed # (Modification of a read-only value attempted) ############## sub sql_escape{ my @a = @_; map { s/([\'])/\\$1/g;$_} @a } # DESTROY makes all kinds of cleanups if the fuctions were interuppted # before their completion and haven't had a chance to make a clean up. ########### sub DESTROY{ my $self = shift; $self->{sth}->finish if defined $self->{sth} and $self->{sth}; $self->{dbh}->disconnect if defined $self->{dbh} and $self->{dbh}; } # end of sub DESTROY # Don't remove 1;
In your code that wants to use My::DB
, you have to create a
My::DB
object first:
use vars qw($db_obj); my $db_obj = new My::DB or croak "Can't initialize My::DB object: $!\n";
From this moment, you can use any My::DB
's methods. I will start from a very simple query - I want to know where
the users are and produce statistics. tracker
is the name of the table.
# fetch the statistics of where users are my $r_ary = $db_obj->sql_get_matched_rows_ary_ref ("tracker", [qw(where_user_are)], ); my %stats = (); my $total = 0; foreach my $r_row (@$r_ary){ $stats{$r_row->[0]}++; $total++; }
Now let's count how many users do we have (in users
table):
my $count = $db_obj->sql_count_matched("users");
Check whether user exists:
my $username = 'stas'; my $exists = $db_obj->sql_count_matched ("users", [username => ["=",$username]] );
Check whether user online and get time since when she is online (since
a column in the tracker
table telling since when user is online):
my @row = (); $db_obj->sql_get_matched_row (\@row, "tracker", ['UNIX_TIMESTAMP(since)'], [username => ["=",$username]] ); if (@row) { my $idle = int( (time() - $row[0]) / 60); return "Current status: Is Online and idle for $idle minutes."; }
A complex query. I do join of 2 tables, and want to get a reference to
array, which will store a slice of the matched query (LIMIT
$offset,$hits
), sorted by username
and each row in array_ref to include the fields from the users
table, but only those listed in
@verbose_cols
. Then we print it out.
my $r_ary = $db_obj->sql_get_matched_rows_ary_ref ( "tracker STRAIGHT_JOIN users", [map {"users.$_"} @verbose_cols], [], ["WHERE tracker.username=users.username", "ORDER BY users.username", "LIMIT $offset,$hits"], ); foreach my $r_row (@$r_ary){ print ... }
Another complex query. User checks checkboxes to be queried by, selects
from lists and types in match strings, we process input and build the @where
array. Then we want to get the number of matches and the matched rows as
well.
my @where = (); # process chekoxes - we turn them into REGEXP foreach (keys %search_keys) { next unless defined $q->param($_) and $q->param($_); my $regexp = "[".join("",$q->param($_))."]"; push @where, ($_ => ['REGEXP',$regexp]); } # Now add all the single answer , selected => exact macth push @where,(country => ['=',$q->param('country')]) if $q->param('country'); # Now add all the typed params foreach (qw(city state)) { push @where,($_ => ['LIKE',$q->param($_)]) if $q->param($_); } # Do the count all matched query my $total_matched_users = $db_obj->sql_count_matched ( "users", \@where, ); # Now process the orderby my $orderby = $q->param('orderby') || 'username'; # Do the query and fetch the data my $r_ary = $db_obj->sql_get_matched_rows_ary_ref ( "users", \@display_columns, \@where, ["ORDER BY $orderby", "LIMIT $offset,$hits"], );
sql_get_matched_rows_ary_ref
knows to handle both OR
ed and
AND
ed params. This example shows how to use OR
on parameters:
This snippet is an implementation of the watchdog. Users register usernames
of the people they want to know when these are going online, so we have to
make 2 queries - one to get a list of these usernames, second to query
whether any of these users is online. In the second query we use OR
keyword.
# check who we are looking for $r_ary = $db_obj->sql_get_matched_rows_ary_ref ("watchdog", [qw(watched)], [username => ['=',$username)], ], ); # put them into an array my @watched = map {$_->[0]} @{$r_ary}; my %matched = (); # Do user has some registered usernames? if (@watched) { # try to bring all the users who match (exactly) the usernames - put # it into array and compare with a hash! $r_ary = $db_obj->sql_get_matched_rows_ary_ref ("tracker", [qw(username)], [username => ['=',\@watched], ] ); map {$matched{$_->[0]} = 1} @{$r_ary}; } # Now %matched includes the usernames of the users who are being # watched by $username and currently are online.
|
||
Written by Stas Bekman.
Last Modified at 08/16/1999 |
![]() |
Use of the Camel for Perl is a trademark of O'Reilly & Associates, and is used by permission. |