Mod Perl Icon Mod Perl Icon mod_perl and Relational Databases


[ Prev | Main Page | Next ]

Table of Contents:


The Writing Apache Modules with Perl and C book can be purchased online from O'Reilly and Amazon.com.
Your corrections of either technical or grammatical errors are very welcome. You are encouraged to help me to improve this guide. If you have something to contribute please send it directly to me.

[TOC]


Why Relational (SQL) Databases

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.

[TOC]


Apache::DBI - Initiate a persistent database connection

This module initiates a persistent database connection. It is possible only with mod_perl.

[TOC]


Introduction

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.

[TOC]


Configuration

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.

[TOC]


Preopening DBI connections

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).

[TOC]


Debugging Apache::DBI

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

[TOC]


Problems and solutions

[TOC]


The morning bug

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.

[TOC]


Opening a connection with different parameters

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.

[TOC]


Cannot find the DBI handler

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.

[TOC]


Apache:DBI does not work

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.

[TOC]


skipping connection cache during server startup

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.

[TOC]


mysql_use_result vs. mysql_store_result.

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.

[TOC]


Some useful code snippets to be used with relational Databases

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.

[TOC]


Turning the SQL queries writing into an short and simple task

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.

[TOC]


My::DB module

(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;

[TOC]


My::DB Module's Usage Examples

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 ORed and ANDed 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.

[TOC]


The Writing Apache Modules with Perl and C book can be purchased online from O'Reilly and Amazon.com.
Your corrections of either technical or grammatical errors are very welcome. You are encouraged to help me to improve this guide. If you have something to contribute please send it directly to me.
[ Prev | Main Page | Next ]

Written by Stas Bekman.
Last Modified at 08/16/1999
Mod Perl Icon Use of the Camel for Perl is
a trademark of O'Reilly & Associates,
and is used by permission.