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