X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;ds=sidebyside;f=FS%2FFS%2FRecord.pm;h=82f590f94b570786ec97140e45243adb083d00cb;hb=2066bf9d3ebb4e53c49ab8b4b447c4eb88e425a4;hp=dd8cc542c803ec30f4396c73b5e24827f5331dd8;hpb=d220c8a4bfa1aee8f17ed71c2dba655160dd3595;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index dd8cc542c..82f590f94 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -6,8 +6,8 @@ use subs qw(reload_dbdef); use Exporter; use Carp qw(carp cluck croak confess); use File::CounterFile; +use DBIx::DBSchema; use FS::UID qw(dbh checkruid swapuid getotaker datasrc driver_name); -use FS::dbdef; @ISA = qw(Exporter); @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef); @@ -74,6 +74,7 @@ FS::Record - Database record objects $value = $record->ut_alphan('column'); $value = $record->ut_phonen('column'); $value = $record->ut_anythingn('column'); + $value = $record->ut_name('column'); $dbdef = reload_dbdef; $dbdef = reload_dbdef "/non/standard/filename"; @@ -126,7 +127,7 @@ sub new { $hashref->{$field}='' unless defined $hashref->{$field}; #trim the '$' and ',' from money fields for Pg (belong HERE?) #(what about Pg i18n?) - if ( driver_name eq 'Pg' + if ( driver_name =~ /^Pg$/i && $self->dbdef_table->column($field)->type eq 'money' ) { ${$hashref}{$field} =~ s/^\$//; ${$hashref}{$field} =~ s/\,//; @@ -169,6 +170,8 @@ objects. sub qsearch { my($table, $record, $select, $extra_sql ) = @_; + $table =~ /^([\w\_]+)$/ or die "Illegal table: $table"; + $table = $1; $select ||= '*'; my $dbh = dbh; @@ -178,7 +181,7 @@ sub qsearch { if ( @fields ) { $statement .= ' WHERE '. join(' AND ', map { if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) { - if ( driver_name eq 'Pg' ) { + if ( driver_name =~ /^Pg$/i ) { "$_ IS NULL"; } else { qq-( $_ IS NULL OR $_ = "" )-; @@ -191,7 +194,7 @@ sub qsearch { $statement .= " $extra_sql" if defined($extra_sql); warn $statement if $DEBUG; - my $sth = $dbh->prepare_cached($statement) + my $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement"; $sth->execute( map $record->{$_}, @@ -313,6 +316,8 @@ sub AUTOLOAD { my($field)=$AUTOLOAD; $field =~ s/.*://; if ( defined($value) ) { + confess "errant AUTOLOAD $field for $self (arg $value)" + unless $self->can('setfield'); $self->setfield($field,$value); } else { $self->getfield($field); @@ -419,7 +424,7 @@ sub delete { map { $self->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' + ? ( driver_name =~ /^Pg$/i ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -492,7 +497,7 @@ sub replace { map { $old->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" - ? ( driver_name eq 'Pg' + ? ( driver_name =~ /^Pg$/i ? "$_ IS NULL" : "( $_ IS NULL OR $_ = \"\" )" ) @@ -541,7 +546,7 @@ sub check { =item unique COLUMN Replaces COLUMN in record with a unique number. Called by the B method -on primary keys and single-field unique columns (see L). +on primary keys and single-field unique columns (see L). Returns the new value. =cut @@ -785,8 +790,37 @@ sub ut_domain { ''; } +=item ut_name COLUMN + +Check/untaint proper names; allows alphanumerics, spaces and the following +punctuation: , . - ' + +May not be null. + +=cut + +sub ut_name { + my( $self, $field ) = @_; + $self->getfield($field) =~ /^([\w \,\.\-\']+)$/ + or return "Illegal (name) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + +=item ut_zip COLUMN + +Check/untaint zip codes. + =cut +sub ut_zip { + my( $self, $field ) = @_; + $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/ + or return "Illegal (zip) $field: ". $self->getfield($field); + $self->setfield($field,$1); + ''; +} + =item ut_anything COLUMN Untaints arbitrary data. Be careful. @@ -805,7 +839,7 @@ sub ut_anything { This can be used as both a subroutine and a method call. It returns a list of the columns in this record's table, or an explicitly specified table. -(See L). +(See L). =cut @@ -825,21 +859,23 @@ sub fields { $table_obj->columns; } +=back + =head1 SUBROUTINES =over 4 =item reload_dbdef([FILENAME]) -Load a database definition (see L), optionally from a non-default -filename. This command is executed at startup unless -I<$FS::Record::setup_hack> is true. Returns a FS::dbdef object. +Load a database definition (see L), optionally from a +non-default filename. This command is executed at startup unless +I<$FS::Record::setup_hack> is true. Returns a DBIx::DBSchema object. =cut sub reload_dbdef { my $file = shift || $dbdef_file; - $dbdef = load FS::dbdef ($file); + $dbdef = load DBIx::DBSchema $file; } =item dbdef @@ -913,7 +949,7 @@ sub DESTROY { return; } =head1 VERSION -$Id: Record.pm,v 1.12 2001-02-03 14:03:49 ivan Exp $ +$Id: Record.pm,v 1.19 2001-07-30 10:41:44 ivan Exp $ =head1 BUGS @@ -943,7 +979,7 @@ The ut_money method assumes money has two decimal digits. The Pg money kludge in the new method only strips `$'. -The ut_phonen method assumes US-style phone numbers. +The ut_phonen method only checks US-style phone numbers. The _quote function should probably use ut_float instead of a regex. @@ -956,9 +992,11 @@ As of 1.14, DBI fetchall_hashref( {} ) doesn't set fetchrow_hashref NAME_lc, or allow it to be set. Working around it is ugly any way around - DBI should be fixed. (only affects RDBMS which return uppercase column names) +ut_zip should take an optional country like ut_phone. + =head1 SEE ALSO -L, L, L +L, L, L Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.