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; |
Back to
Code Catacombs