Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

CGI::SQL.pm initial release

by markjugg (Curate)
on Aug 13, 2000 at 10:38 UTC ( #27685=sourcecode: print w/ replies, xml ) Need Help??

Category: CGI Programming
Author/Contact Info Mark Stosberg <mark@summersault.com>
Description: CGI::SQL is a set of routines I find useful when working with CGI.pm and DBI.pm. To use these functions you must have an existing database handle which is used to create the CGI::SQL object. Documentation is included as POD.
# Copyright (c) 2000 Mark Stosberg <mark@stosberg.com>
# Licensed under the the GNU GPL, available here: http://www.gnu.org/c
+opyleft/gpl.html

=head1 NAME

CGI::SQL - A collection of useful routines for web/database developmen
+t. 

=head1 SYNOPSIS

  use CGI::SQL;
  
  $db = new CGI::SQL($DBH);
  
  $html = $db->db_form_select(
             table       => 'state_codes',
             key_col     => 'code',
             label_col   => 'name',
             default     => $DEFAULT_STATE, 
             name        => 'state',
             null_label  => 'N/A'
        );
             
  $sql = $db->build_sql_from_keywords(
              words      => 'cat,brown,whiskers',
              fields     => ['pets','colors','names']
          );
             
  $rv = $db->insert_from_param('products');
  
  $rv = $db->update_from_param('products',"id = $id"); 
  
  $prefix = $db->prefix($prefix);                    

=head1 DESCRIPTION

CGI::SQL is a set of routines I find useful when working with CGI.pm
and DBI.pm. To use these functions you must have an existing
database handle which is used to create the CGI::SQL object.

=cut

package CGI::SQL;
use CGI qw(param);

use strict;

use vars qw/
        $DEFAULT_PREFIX
        $VERSION
        /;

# You can change this, bit it will break my documentation. :) 
$DEFAULT_PREFIX = 'col_';

$VERSION = '.7';

=head2 CREATING A CGI::SQL OBJECT

    $db = new CGI::SQL($DBH);
    
    $db = new CGI::SQL($DBH, $prefix);
    
$DBH must be an existing DBI database handle. 'undef' will be
returned if a database handle is not passed in. You may wish to
check for this condition.

The second item, I<$prefix> allows you to specify a prefix other
than the default 'col_' for use with the C<insert_from_param> and
C<update_from_param>. By changing the prefix you could insert into
more than one table from the same set of I<param> variables

=cut
sub new {
        my ($class, $dbh, $prefix) = @_;
        return undef unless $dbh;
        my %self = (
                dbh             => $dbh,
                prefix          => $prefix || $DEFAULT_PREFIX,
        );
        bless (\%self, $class);
    return \%self;
}

=head2 CHANGING THE PREFIX USED FOR insert_from_param AND update_from_
+param

        $prefix = $db->prefix($prefix);
        
By default, C<insert_from_param> and C<update_from_param> operate on
form fields named with the prefix 'col_'. You can use this function
to change the prefix for the life of your CGI::SQL object. 

=head2 FETCHING THE CURRENT PREFIX

        $db->prefix;

=cut

sub prefix {
        my $self = shift;
        if (@_) { $self->{prefix} = shift }
        return $self->{prefix};
}       

=head2 BUILDING A SQL KEYWORD SEARCH

        $sql = $db->build_sql_from_keywords(
                      words      => 'cat,brown,whiskers',
                      fields     => ['pets','colors','names']
                  );
                  
        $sql = $db->build_sql_from_keywords(
                      words             => 'cat,brown,whiskers',
                      fields            => ['pets','colors','names'],
                      intrafield_style  => 'and',
                      interfield_style  => 'or'
                  );
                  
B<build_sql_from_keywords> builds a sql statement based on a
variable containing a list of comma, space, semicolon or colon
seperated keywords. This prepares a case-insensitive search using
the SQL "LIKE" operator. 

=over 4

=item B<words> 

A string of comma,space,semicolon or color seperated
keywords. Required.

=item B<fields>

 An anonymous array of fields to perform the keyword
search on. Required.

=item B<intrafield_style>

 By default, words can match in one or more
columns. If you would like all words to match in all columns, you
set this 'AND'

=item B<interfield_style>

 By default, one or more words can match in
a particular column. If you would like all words to match in
particular column for it to be considered a match, set this value to
'AND'

=back

If you find the interfield_style and intrafield_style options
confusing, don't worry-- the defaults are almost always what you
want for a keyword search. 

=cut

sub build_sql_from_keywords {
        my $self = shift; 
        
        my %args = (
                words                                 => '',      # ke
+ywords
                intrafield_style                      => 'or',    # an
+d/or (defaults to 'or') This the joiner within the same field
                interfield_style                                      
+    => 'or',        # and/or (defaults to 'or') This the joiner betwe
+en fields
                fields                                => undef,   # ar
+ray of fields to search on
                @_,
        );
        
        my $sql;
        
        # If there are no words passed in, there is nothing to do..
        if ($args{words}) {
        
                my @list = split /[\s\,\;\:]+/, $args{words};
                my @fields = @{ $args{fields} };
                
                $sql = "(\n";
                foreach (my $j = 0; $j <= $#list; $j++) {
                        if (@fields) {
                                $sql .= "(";
                                foreach  (my $i = 0; $i <= $#fields; $
+i ++) {
                                        $sql .= lc $fields[$i]." LIKE 
+".lc $self->{dbh}->quote("$list[$j]")."\n" if defined $list[$j];
                                        $sql .= " $args{intrafield_sty
+le} " unless $i == $#fields;
                                }
                                $sql .= ")";
                            $sql .= "\n $args{interfield_style} \n" un
+less $j == $#list;
                    }
                }
                $sql .= "\n)\n";
                
                return $sql;
        }
}

=head2 INSERTING SQL BASED ON THE PARAM ENVIRONMENT

        $rv = $db->insert_from_param('products');
        
        $rv = $db->insert_from_param('products',$extra,$q);
        
This auto-quotes and inserts into the database based on CGI.pm's
C<param> system. All param variables with the prefix 'col_' are used
as the column names, and their associated values are used as the
data to insert. The table named in the first argument is used for
the insert. 

=over 4

=item 1. 

The first argument is the table name to insert into.
Required. 

=item 2. 

The second argument allows you to add extra SQL onto the
end of the generated insert statement for custom functions.
Optional.

=item 3. 

The third argument is used to pass in an optional CGI.pm
object to allow you to use param variables from an environment other
than the default. This gives you the flexibility of creating
name-value pairs from nonstandard places. 

=back

If you get an error like this: "execute called with 18 bind
variables, 17 needed"
That means that you accidently are collecting values for a key
twice. Look for duplicates in your form. 

=cut

sub insert_from_param {
        my ($self,$table,$extra,$q) = @_; 

        $q ||= new CGI;
        
        my (@keys,@vals,@qs);
        foreach my $key ($q->param) {
                if ($key =~ /^$self->prefix(.*)/i) { 
                        push @keys, $1; 
                        push @vals, $q->param($key); 
                        push @qs, '?'
                }
        }

        my $sql = "INSERT into $table (". (join ',', @keys) .') values
+ ('. (join ',',@qs) .") $extra";

        my $rv = $self->{dbh}->do($sql,undef,@vals);
        return $rv;
}

=head2 UPDATING SQL BASED ON THE PARAM ENVIRONMENT

         $rv = $db->update_from_param('products',"id = $id");   

         $rv = $db->update_from_param('products',"id = $id",$from,$q);

This auto-quotes and updates the database based on CGI.pm's C<param> s
+ystem. All param variables that begin with $db->prefix (usually 'col_
+') and their associated values are updated in the table named in the 
+first argument. 

=over 4  

=item 1. 

The first argument is the name of the table to update. Required.

=item 2. 

The second argument is an optional I<FROM> clause to include in your S
+QL

=item 3. 

The third argument is an optional CGI.pm object to allow to use a C<pa
+ram> from someplace other then the default. 

=back

=cut

sub update_from_param {
        my ($self,$table, $where, $from, $q) = @_;
        
        $q ||= new CGI;
        
        my (@pairs,@vals);
        foreach my $key ($q->param) {
                if ($key =~ /^$self->prefix(.*)/) { 
                        push @pairs, ("$1 = ?"); 
                        push @vals, $q->param($key)
                }
        }

        my $sql = "UPDATE $table SET ". (join ', ', @pairs). 
                           ($where ? " WHERE $where " : ""). 
                           ($from  ? " FROM  $where "  : "");
        my $rv = $self->{dbh}->do($sql,undef,@vals);
        return $rv;
}

=head2 CREATING A POP UP MENU OR FORM SELECTION MENU FROM A DATABASE T
+ABLE

      $html = $db->db_form_select(
             table       => 'state_codes',
             key_col     => 'code',
             label_col   => 'name',
             default     => $DEFAULT_STATE, 
             name        => 'state',
             null_label  => 'N/A'
        );
        
      $html = $db->db_form_select(
            table        => 'colors',
            key_col      => 'id',
            label_col    => 'name',
            name         => 'color_id',
            null_label   => 'No Colors Selected',
            default      => ['blue','green','purple'],
            size         => 6,
            multiple     => 'true',
        );        

C<db_form_select()> creates a popup menu or a selection list from a da
+tabase.

There are four required fields, I<table,key_col,label_col, and name>. 
+If these are not present, the function will return an undefined value
+. 

=over 4

=item B<table> 

The database table used to build the list. Required. 

=item B<key_col>

 The database column used to provide the keys for the list. Required.

=item B<key_col>

 The database column used to provide the keys for the list. Required. 

=item B<name>

 The name of the form element. Required. 

=item B<default>

 The default value selected in the menu. This can be a single element 
+as shown in the first example, an anonymous array, as shown the secon
+d example. It only really makes sense to have more than one default i
+tem if you have a multi-valued selection list. You may omit this and 
+nothing will be selected by default. 

=item B<null_label>

 The null label is used to provide a label for an entry that correspon
+ds to a null key. 

=item B<multiple>

 Used to denote that multiple items are selectable. Set to a non-zero 
+value to trigger this option. 

=item B<size>

 The size in text lines of the selection list. If there are less value
+s returned from the database then 'size', the size will be reduced to
+ match the number of rows returned from the database

=back

=cut
# Creates a popup menu or selection list from database table. 
sub db_form_select {
        my $self = shift;
        # Ideas for improving this:
        #       - allow for more flexible sorting
        my %in = (
                table           => '',
                key_col         => '',
                label_col       => '',
                where           => '', # "WHERE clause" if any
                name            => '', # Name of the form field
                null_label      => '', # Label for a null value
                default => '', # can be a single item or an array of i
+tems (for the select list} 
                size            => '', # number of lines for displayed
+ (null for popup menu)
                multiple        => '', # set to non-zero value to allo
+w people to select multipe items
                @_
        );
        
        # We need at least this information to work:
        return undef unless ($self->{dbh} 
                && $in{table} 
                && $in{key_col} 
                && $in{label_col} 
                && $in{name}
        );
        
        # H is for hash. 
        my %h;
        $h{''} => $in{null_label} if $in{null_label};

        my $sth = $self->{dbh}->prepare("select $in{key_col}, $in{labe
+l_col} from $in{table} ".($in{where} && "WHERE $in{where}"));
        return undef unless $sth;
        my $rv = $sth->execute;
        while (my $row = $sth->fetchrow_hashref) {
                $h{ $row->{ $in{key_col} } } = $row->{ $in{label_col} 
+};
        }       
        if ($in{size} || $in{multiple}) {
                # Display the smaller size of $in{size} and the actual
+ results
                $in{size} = (scalar (keys %h)) if ((scalar keys %h) < 
+$in{size});
                return scrolling_list(
                        -name=>$in{name},
                        -values=>[sort { $h{$a} cmp $h{$b} } keys %h],
                        -default=>$in{default},
                        -labels=>\%h,
                        -size=>$in{size},
            -multiple=>($in{multiple} && 'true'),
                );
        } else {
                return popup_menu(
                        -name=>$in{name},
                        -values=>[sort { $h{$a} cmp $h{$b} } keys %h],
                        -default=>$in{default},
                        -labels=>\%h
                );
        }       
}

=head1 COPYRIGHT AND AUTHOR INFO

The CGI::SQL module is Copyright (c) 2000 Mark Stosberg. USA.
All rights reserved.

You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README file.

Address bug reports and comments to: mark@stosberg.com .  When sending
bug reports, please provide the version of CGI::SQL.pm, the version of
Perl, the name and version of your Web server, the name and
version of the operating system you are using, and the name and versio
+n of 
the database you are using.  If the problem is even remotely browser d
+ependent, 
please provide information about the affected browers as well. 

=cut

1;

Comment on CGI::SQL.pm initial release
Download Code
RE: CGI::SQL.pm initial release
by merlyn (Sage) on Aug 13, 2000 at 11:59 UTC
    I voted this one negative because the author forgot to use {code} and {/code} (with curlies replaced by less-thans and greater-thans) to surround the code. Evil.

    -- Randal L. Schwartz, Perl hacker

      I would have made the same mistake today, but noticed a fellow Monk do so last week.

      A reminder to wrap your code inside of <code></code> just above the "Code:" form would cut down on how often this happens.   Some fine Monk suggested that Code Catacombs posts automatically be <code>ed, but that would break the consistancy of the site.
          cheers,
          ybiC

Re: CGI::SQL.pm initial release (a note from the author)
by markjugg (Curate) on Jan 14, 2002 at 18:28 UTC
    Hello,

    Now that some time has passed, I no longer use this module, nor really recommend it. I still the like spirit of the routines here, but have found replacements I like better. In place of the insert and update routines, I use similar routines in DBIx::Abstract. In place of the selection list builder, I use the newer DBI API to get a hash back directly through DBI, and then pass that straight into a CGI.pm function, and am happy to keep the abstraction. I still use and like the "build_sql_from_keywords" function, but this is mostly because I'm familiar with it-- there is probably a better replacement on CPAN.

    -mark

      Now that even more time has passed, I use SQL::Abstract instead of DBIx::Abstract.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://27685]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (7)
As of 2014-07-13 18:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (251 votes), past polls