site_perl/Record.pm

   1 package FS::Record;
   2
   3 use strict;
   4 use vars qw($dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK);
   5 use subs qw(reload_dbdef);
   6 use Exporter;
   7 use Carp;
   8 use File::CounterFile;
   9 use FS::UID qw(dbh checkruid swapuid getotaker datasrc);
  10 use FS::dbdef;
  11
  12 @ISA = qw(Exporter);
  13 @EXPORT_OK = qw(dbh fields hfields qsearch qsearchs dbdef);
  14
  15 $File::CounterFile::DEFAULT_DIR = "/var/spool/freeside/counters" ;
  16
  17 $dbdef_file = "/var/spool/freeside/dbdef.". datasrc;
  18
  19 reload_dbdef unless $setup_hack;
  20
  21 =head1 NAME
  22
  23 FS::Record - Database record objects
  24
  25 =head1 SYNOPSIS
  26
  27     use FS::Record;
  28     use FS::Record qw(dbh fields hfields qsearch qsearchs dbdef);
  29
  30     $record = new FS::Record 'table', \%hash;
  31     $record = new FS::Record 'table', { 'column' => 'value', ... };
  32
  33     $record  = qsearchs FS::Record 'table', \%hash;
  34     $record  = qsearchs FS::Record 'table', { 'column' => 'value', ... };
  35     @records = qsearch  FS::Record 'table', \%hash;
  36     @records = qsearch  FS::Record 'table', { 'column' => 'value', ... };
  37
  38     $table = $record->table;
  39     $dbdef_table = $record->dbdef_table;
  40
  41     $value = $record->get('column');
  42     $value = $record->getfield('column');
  43     $value = $record->column;
  44
  45     $record->set( 'column' => 'value' );
  46     $record->setfield( 'column' => 'value' );
  47     $record->column('value');
  48
  49     %hash = $record->hash;
  50
  51     $hashref = $record->hashref;
  52
  53     $error = $record->add;
  54
  55     $error = $record->del;
  56
  57     $error = $new_record->rep($old_record);
  58
  59     $value = $record->unique('column');
  60
  61     $value = $record->ut_float('column');
  62     $value = $record->ut_number('column');
  63     $value = $record->ut_numbern('column');
  64     $value = $record->ut_money('column');
  65     $value = $record->ut_text('column');
  66     $value = $record->ut_textn('column');
  67     $value = $record->ut_alpha('column');
  68     $value = $record->ut_alphan('column');
  69     $value = $record->ut_phonen('column');
  70     $value = $record->ut_anythingn('column');
  71
  72     $dbdef = reload_dbdef;
  73     $dbdef = reload_dbdef "/non/standard/filename";
  74     $dbdef = dbdef;
  75
  76     $quoted_value = _quote($value,'table','field');
  77
  78     #depriciated
  79     $fields = hfields('table');
  80     if ( $fields->{Field} ) { # etc.
  81
  82     @fields = fields 'table';
  83
  84
  85 =head1 DESCRIPTION
  86
  87 (Mostly) object-oriented interface to database records.  Records are currently
  88 implemented on top of DBI.  FS::Record is intended as a base class for
  89 table-specific classes to inherit from, i.e. FS::cust_main.
  90
  91 =head1 METHODS
  92
  93 =over 4
  94
  95 =item new TABLE, HASHREF
  96
  97 Creates a new record.  It doesn't store it in the database, though.  See
  98 L<"add"> for that.
  99
 100 Note that the object stores this hash reference, not a distinct copy of the
 101 hash it points to.  You can ask the object for a copy with the I<hash>
 102 method.
 103
 104 =cut
 105
 106 sub new {
 107   my($proto,$table,$hashref) = @_;
 108   confess "Second arguement to FS::Record->new is not a HASH ref: ",
 109           ref($hashref), " ", $hashref, "\n"
 110     unless ref($hashref) eq 'HASH'; #bad practice?
 111
 112   #check to make sure $table exists? (ask dbdef)
 113
 114   foreach my $field ( FS::Record::fields $table ) {
 115      $hashref->{$field}='' unless defined $hashref->{$field};
 116   }
 117
 118   # mySQL must rtrim the inbound text strings or store them z-terminated
 119   # I simulate this for Postgres below
 120   # Turned off in favor of ChopBlanks in UID.pm (see man DBI)
 121   #if (datasrc =~ m/Pg/)
 122   #{
 123   #  foreach my $index (keys %$hashref)
 124   #  {
 125   #    $$hashref{$index} = unpack("A255", $$hashref{$index})
 126   #     if ($$hashref{$index} =~ m/ $/) ;
 127   #  }
 128   #}
 129
 130   foreach my $column (keys %{$hashref}) {
 131     #trim the '$' from money fields for Pg (beong HERE?)
 132     #(what about Pg i18n?)
 133     if ( datasrc =~ m/Pg/
 134          && $dbdef->table($table)->column($column)->type eq 'money' ) {
 135       ${$hashref}{$column} =~ s/^\$//;
 136     }
 137     #foreach my $column ( grep $dbdef->table($table)->column($_)->type eq 'money', keys %{$hashref} ) {
 138     #  ${$hashref}{$column} =~ s/^\$//;
 139     #}
 140   }
 141
 142   my $class = ref($proto) || $proto;
 143   my $self = { 'Table' => $table,
 144                'Hash' => $hashref,
 145              };
 146
 147   bless ($self, $class);
 148
 149 }
 150
 151 =item qsearch TABLE, HASHREF
 152
 153 Searches the database for all records matching (at least) the key/value pairs
 154 in HASHREF.  Returns all the records found as FS::Record objects.
 155
 156 =cut
 157
 158 # Usage: @records = &FS::Search::qsearch($table,\%hash);
 159 # Each element of @records is a FS::Record object.
 160 sub qsearch {
 161   my($table,$record) = @_;
 162   my($dbh) = dbh;
 163
 164   my(@fields)=grep exists($record->{$_}), fields($table);
 165
 166   my($sth);
 167   my($statement) = "SELECT * FROM $table". ( @fields
 168     ? " WHERE ". join(' AND ',
 169         map("$_ = ". _quote($record->{$_},$table,$_), @fields)
 170       )
 171     : ''
 172   );
 173   $sth=$dbh->prepare($statement)
 174     or croak $dbh->errstr; #is that a little too harsh?  hmm.
 175
 176   map {
 177     new FS::Record ($table,$sth->fetchrow_hashref);
 178   } ( 1 .. $sth->execute );
 179
 180 }
 181
 182 =item qsearchs TABLE, HASHREF
 183
 184 Searches the database for a record matching (at least) the key/value pairs
 185 in HASHREF, and returns the record found as an FS::Record object.  If more than
 186 one record matches, it B<carp>s but returns the first.  If this happens, you
 187 either made a logic error in asking for a single item, or your data is
 188 corrupted.
 189
 190 =cut
 191
 192 sub qsearchs { # $result_record = &FS::Record:qsearchs('table',\%hash);
 193   my(@result) = qsearch(@_);
 194   carp "Multiple records in scalar search!" if scalar(@result) > 1;
 195     #should warn more vehemently if the search was on a primary key?
 196   $result[0];
 197 }
 198
 199 =item table
 200
 201 Returns the table name.
 202
 203 =cut
 204
 205 sub table {
 206   my($self) = @_;
 207   $self -> {'Table'};
 208 }
 209
 210 =item dbdef_table
 211
 212 Returns the FS::dbdef_table object for the table.
 213
 214 =cut
 215
 216 sub dbdef_table {
 217   my($self)=@_;
 218   my($table)=$self->table;
 219   $dbdef->table($table);
 220 }
 221
 222 =item get, getfield COLUMN
 223
 224 Returns the value of the column/field/key COLUMN.
 225
 226 =cut
 227
 228 sub get {
 229   my($self,$field) = @_;
 230   # to avoid "Use of unitialized value" errors
 231   if ( defined ( $self->{Hash}->{$field} ) ) {
 232     $self->{Hash}->{$field};
 233   } else {
 234     '';
 235   }
 236 }
 237 sub getfield {
 238   get(@_);
 239 }
 240
 241 =item set, setfield COLUMN, VALUE
 242
 243 Sets the value of the column/field/key COLUMN to VALUE.  Returns VALUE.
 244
 245 =cut
 246
 247 sub set {
 248   my($self,$field,$value) = @_;
 249   $self->{'Hash'}->{$field} = $value;
 250 }
 251 sub setfield {
 252   set(@_);
 253 }
 254
 255 =item AUTLOADED METHODS
 256
 257 $record->column is a synonym for $record->get('column');
 258
 259 $record->column('value') is a synonym for $record->set('column','value');
 260
 261 =cut
 262
 263 sub AUTOLOAD {
 264   my($self,$value)=@_;
 265   my($field)=$AUTOLOAD;
 266   $field =~ s/.*://;
 267   if ( defined($value) ) {
 268     $self->setfield($field,$value);
 269   } else {
 270     $self->getfield($field);
 271   }
 272 }
 273
 274 =item hash
 275
 276 Returns a list of the column/value pairs, usually for assigning to a new hash.
 277
 278 To make a distinct duplicate of an FS::Record object, you can do:
 279
 280     $new = new FS::Record ( $old->table, { $old->hash } );
 281
 282 =cut
 283
 284 sub hash {
 285   my($self) = @_;
 286   %{ $self->{'Hash'} };
 287 }
 288
 289 =item hashref
 290
 291 Returns a reference to the column/value hash.
 292
 293 =cut
 294
 295 sub hashref {
 296   my($self) = @_;
 297   $self->{'Hash'};
 298 }
 299
 300 =item add
 301
 302 Adds this record to the database.  If there is an error, returns the error,
 303 otherwise returns false.
 304
 305 =cut
 306
 307 sub add {
 308   my($self) = @_;
 309   my($dbh)=dbh;
 310   my($table)=$self->table;
 311
 312   #single-field unique keys are given a value if false
 313   #(like MySQL's AUTO_INCREMENT)
 314   foreach ( $dbdef->table($table)->unique->singles ) {
 315     $self->unique($_) unless $self->getfield($_);
 316   }
 317   #and also the primary key
 318   my($primary_key)=$dbdef->table($table)->primary_key;
 319   $self->unique($primary_key)
 320     if $primary_key && ! $self->getfield($primary_key);
 321
 322   my (@fields) =
 323     grep defined($self->getfield($_)) && $self->getfield($_) ne "",
 324     fields($table)
 325   ;
 326
 327   my($sth);
 328   my($statement)="INSERT INTO $table ( ".
 329       join(', ',@fields ).
 330     ") VALUES (".
 331       join(', ',map(_quote($self->getfield($_),$table,$_), @fields)).
 332     ")"
 333   ;
 334   $sth = $dbh->prepare($statement) or return $dbh->errstr;
 335
 336   local $SIG{HUP} = 'IGNORE';
 337   local $SIG{INT} = 'IGNORE';
 338   local $SIG{QUIT} = 'IGNORE';
 339   local $SIG{TERM} = 'IGNORE';
 340   local $SIG{TSTP} = 'IGNORE';
 341
 342   $sth->execute or return $sth->errstr;
 343
 344   '';
 345 }
 346
 347 =item del
 348
 349 Delete this record from the database.  If there is an error, returns the error,
 350 otherwise returns false.
 351
 352 =cut
 353
 354 sub del {
 355   my($self) = @_;
 356   my($dbh)=dbh;
 357   my($table)=$self->table;
 358
 359   my($sth);
 360   my($statement)="DELETE FROM $table WHERE ". join(' AND ',
 361     map {
 362       $self->getfield($_) eq ''
 363         ? "$_ IS NULL"
 364         : "$_ = ". _quote($self->getfield($_),$table,$_)
 365     } ( $dbdef->table($table)->primary_key )
 366           ? ($dbdef->table($table)->primary_key)
 367           : fields($table)
 368   );
 369   $sth = $dbh->prepare($statement) or return $dbh->errstr;
 370
 371   local $SIG{HUP} = 'IGNORE';
 372   local $SIG{INT} = 'IGNORE';
 373   local $SIG{QUIT} = 'IGNORE';
 374   local $SIG{TERM} = 'IGNORE';
 375   local $SIG{TSTP} = 'IGNORE';
 376
 377   my($rc);
 378   $rc=$sth->execute or return $sth->errstr;
 379   #not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
 380
 381   undef $self; #no need to keep object!
 382
 383   '';
 384 }
 385
 386 =item rep OLD_RECORD
 387
 388 Replace the OLD_RECORD with this one in the database.  If there is an error,
 389 returns the error, otherwise returns false.
 390
 391 =cut
 392
 393 sub rep {
 394   my($new,$old)=@_;
 395   my($dbh)=dbh;
 396   my($table)=$old->table;
 397   my(@fields)=fields($table);
 398   my(@diff)=grep $new->getfield($_) ne $old->getfield($_), @fields;
 399
 400   if ( scalar(@diff) == 0 ) {
 401     carp "Records identical";
 402     return '';
 403   }
 404
 405   return "Records not in same table!" unless $new->table eq $table;
 406
 407   my($sth);
 408   my($statement)="UPDATE $table SET ". join(', ',
 409     map {
 410       "$_ = ". _quote($new->getfield($_),$table,$_)
 411     } @diff
 412   ). ' WHERE '.
 413     join(' AND ',
 414       map {
 415         $old->getfield($_) eq ''
 416           ? "$_ IS NULL"
 417           : "$_ = ". _quote($old->getfield($_),$table,$_)
 418 #      } @fields
 419 #      } ( primary_key($table) ? (primary_key($table)) : @fields )
 420       } ( $dbdef->table($table)->primary_key
 421             ? ($dbdef->table($table)->primary_key)
 422             : @fields
 423         )
 424     )
 425   ;
 426   #warn $statement;
 427   $sth = $dbh->prepare($statement) or return $dbh->errstr;
 428
 429   local $SIG{HUP} = 'IGNORE';
 430   local $SIG{INT} = 'IGNORE';
 431   local $SIG{QUIT} = 'IGNORE';
 432   local $SIG{TERM} = 'IGNORE';
 433   local $SIG{TSTP} = 'IGNORE';
 434
 435   my($rc);
 436   $rc=$sth->execute or return $sth->errstr;
 437   #not portable #return "Record not found (or records identical)." if $rc eq "0E0";
 438
 439   '';
 440
 441 }
 442
 443 =item unique COLUMN
 444
 445 Replaces COLUMN in record with a unique number.  Called by the B<add> method
 446 on primary keys and single-field unique columns (see L<FS::dbdef_table>).
 447 Returns the new value.
 448
 449 =cut
 450
 451 sub unique {
 452   my($self,$field) = @_;
 453   my($table)=$self->table;
 454
 455   croak("&FS::UID::checkruid failed") unless &checkruid;
 456
 457   croak "Unique called on field $field, but it is ",
 458         $self->getfield($field),
 459         ", not null!"
 460     if $self->getfield($field);
 461
 462   #warn "table $table is tainted" if is_tainted($table);
 463   #warn "field $field is tainted" if is_tainted($field);
 464
 465   &swapuid;
 466   my($counter) = new File::CounterFile "$table.$field",0;
 467 # hack for web demo
 468 #  getotaker() =~ /^([\w\-]{1,16})$/ or die "Illegal CGI REMOTE_USER!";
 469 #  my($user)=$1;
 470 #  my($counter) = new File::CounterFile "$user/$table.$field",0;
 471 # endhack
 472
 473   my($index)=$counter->inc;
 474   $index=$counter->inc
 475     while qsearchs($table,{$field=>$index}); #just in case
 476   &swapuid;
 477
 478   $index =~ /^(\d*)$/;
 479   $index=$1;
 480
 481   $self->setfield($field,$index);
 482
 483 }
 484
 485 =item ut_float COLUMN
 486
 487 Check/untaint floating point numeric data: 1.1, 1, 1.1e10, 1e10.  May not be
 488 null.  If there is an error, returns the error, otherwise returns false.
 489
 490 =cut
 491
 492 sub ut_float {
 493   my($self,$field)=@_ ;
 494   ($self->getfield($field) =~ /^(\d+\.\d+)$/ ||
 495    $self->getfield($field) =~ /^(\d+)$/ ||
 496    $self->getfield($field) =~ /^(\d+\.\d+e\d+)$/ ||
 497    $self->getfield($field) =~ /^(\d+e\d+)$/)
 498     or return "Illegal or empty (float) $field!";
 499   $self->setfield($field,$1);
 500   '';
 501 }
 502
 503 =item ut_number COLUMN
 504
 505 Check/untaint simple numeric data (whole numbers).  May not be null.  If there
 506 is an error, returns the error, otherwise returns false.
 507
 508 =cut
 509
 510 sub ut_number {
 511   my($self,$field)=@_;
 512   $self->getfield($field) =~ /^(\d+)$/
 513     or return "Illegal or empty (numeric) $field!";
 514   $self->setfield($field,$1);
 515   '';
 516 }
 517
 518 =item ut_numbern COLUMN
 519
 520 Check/untaint simple numeric data (whole numbers).  May be null.  If there is
 521 an error, returns the error, otherwise returns false.
 522
 523 =cut
 524
 525 sub ut_numbern {
 526   my($self,$field)=@_;
 527   $self->getfield($field) =~ /^(\d*)$/
 528     or return "Illegal (numeric) $field!";
 529   $self->setfield($field,$1);
 530   '';
 531 }
 532
 533 =item ut_money COLUMN
 534
 535 Check/untaint monetary numbers.  May be negative.  Set to 0 if null.  If there
 536 is an error, returns the error, otherwise returns false.
 537
 538 =cut
 539
 540 sub ut_money {
 541   my($self,$field)=@_;
 542   $self->getfield($field) =~ /^(\-)? ?(\d*)(\.\d{2})?$/
 543     or return "Illegal (money) $field!";
 544   $self->setfield($field,"$1$2$3" || 0);
 545   '';
 546 }
 547
 548 =item ut_text COLUMN
 549
 550 Check/untaint text.  Alphanumerics, spaces, and the following punctuation
 551 symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
 552 May not be null.  If there is an error, returns the error, otherwise returns
 553 false.
 554
 555 =cut
 556
 557 sub ut_text {
 558   my($self,$field)=@_;
 559   $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]+)$/
 560     or return "Illegal or empty (text) $field";
 561   $self->setfield($field,$1);
 562   '';
 563 }
 564
 565 =item ut_textn COLUMN
 566
 567 Check/untaint text.  Alphanumerics, spaces, and the following punctuation
 568 symbols are currently permitted: ! @ # $ % & ( ) - + ; : ' " , . ? /
 569 May be null.  If there is an error, returns the error, otherwise returns false.
 570
 571 =cut
 572
 573 sub ut_textn {
 574   my($self,$field)=@_;
 575   $self->getfield($field) =~ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/]*)$/
 576     or return "Illegal (text) $field";
 577   $self->setfield($field,$1);
 578   '';
 579 }
 580
 581 =item ut_alpha COLUMN
 582
 583 Check/untaint alphanumeric strings (no spaces).  May not be null.  If there is
 584 an error, returns the error, otherwise returns false.
 585
 586 =cut
 587
 588 sub ut_alpha {
 589   my($self,$field)=@_;
 590   $self->getfield($field) =~ /^(\w+)$/
 591     or return "Illegal or empty (alphanumeric) $field!";
 592   $self->setfield($field,$1);
 593   '';
 594 }
 595
 596 =item ut_alpha COLUMN
 597
 598 Check/untaint alphanumeric strings (no spaces).  May be null.  If there is an
 599 error, returns the error, otherwise returns false.
 600
 601 =cut
 602
 603 sub ut_alphan {
 604   my($self,$field)=@_;
 605   $self->getfield($field) =~ /^(\w*)$/
 606     or return "Illegal (alphanumeric) $field!";
 607   $self->setfield($field,$1);
 608   '';
 609 }
 610
 611 =item ut_phonen COLUMN
 612
 613 Check/untaint phone numbers.  May be null.  If there is an error, returns
 614 the error, otherwise returns false.
 615
 616 =cut
 617
 618 sub ut_phonen {
 619   my($self,$field)=@_;
 620   my $phonen = $self->getfield($field);
 621   if ( $phonen eq '' ) {
 622     $self->setfield($field,'');
 623   } else {
 624     $phonen =~ s/\D//g;
 625     $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
 626       or return "Illegal (phone) $field!";
 627     $phonen = "$1-$2-$3";
 628     $phonen .= " x$4" if $4;
 629     $self->setfield($field,$phonen);
 630   }
 631   '';
 632 }
 633
 634 =item ut_anything COLUMN
 635
 636 Untaints arbitrary data.  Be careful.
 637
 638 =cut
 639
 640 sub ut_anything {
 641   my($self,$field)=@_;
 642   $self->getfield($field) =~ /^(.*)$/ or return "Illegal $field!";
 643   $self->setfield($field,$1);
 644   '';
 645 }
 646
 647
 648 =head1 SUBROUTINES
 649
 650 =over 4
 651
 652 =item reload_dbdef([FILENAME])
 653
 654 Load a database definition (see L<FS::dbdef>), optionally from a non-default
 655 filename.  This command is executed at startup unless
 656 I<$FS::Record::setup_hack> is true.  Returns a FS::dbdef object.
 657
 658 =cut
 659
 660 sub reload_dbdef {
 661   my $file = shift || $dbdef_file;
 662   $dbdef = load FS::dbdef ($file);
 663 }
 664
 665 =item dbdef
 666
 667 Returns the current database definition.  See L<FS::dbdef>.
 668
 669 =cut
 670
 671 sub dbdef { $dbdef; }
 672
 673 =item _quote VALUE, TABLE, COLUMN
 674
 675 This is an internal function used to construct SQL statements.  It returns
 676 VALUE DBI-quoted (see L<DBI/"quote">) unless VALUE is a number and the column
 677 type (see L<dbdef_column>) does not end in `char' or `binary'.
 678
 679 =cut
 680
 681 sub _quote {
 682   my($value,$table,$field)=@_;
 683   my($dbh)=dbh;
 684   if ( $value =~ /^\d+(\.\d+)?$/ &&
 685 #       ! ( datatype($table,$field) =~ /^char/ )
 686        ! ( $dbdef->table($table)->column($field)->type =~ /(char|binary)$/i )
 687   ) {
 688     $value;
 689   } else {
 690     $dbh->quote($value);
 691   }
 692 }
 693
 694 =item hfields TABLE
 695
 696 This is depriciated.  Don't use it.
 697
 698 It returns a hash-type list with the fields of this record's table set true.
 699
 700 =cut
 701
 702 sub hfields {
 703   carp "hfields is depriciated";
 704   my($table)=@_;
 705   my(%hash);
 706   foreach (fields($table)) {
 707     $hash{$_}=1;
 708   }
 709   \%hash;
 710 }
 711
 712 =item fields TABLE
 713
 714 This returns a list of the columns in this record's table
 715 (See L<dbdef_table>).
 716
 717 =cut
 718
 719 # Usage: @fields = fields($table);
 720 sub fields {
 721   my($table) = @_;
 722   #my(@fields) = $dbdef->table($table)->columns;
 723   croak "Usage: \@fields = fields(\$table)" unless $table;
 724   my($table_obj) = $dbdef->table($table);
 725   croak "Unknown table $table" unless $table_obj;
 726   $table_obj->columns;
 727 }
 728
 729 #sub _dump {
 730 #  my($self)=@_;
 731 #  join("\n", map {
 732 #    "$_: ". $self->getfield($_). "|"
 733 #  } (fields($self->table)) );
 734 #}
 735
 736 #sub DESTROY {
 737 #  my $self = shift;
 738 #  #use Carp qw(cluck);
 739 #  #cluck "DESTROYING $self";
 740 #  warn "DESTROYING $self";
 741 #}
 742
 743 #sub is_tainted {
 744 #             return ! eval { join('',@_), kill 0; 1; };
 745 #         }
 746
 747 =back
 748
 749 =head1 BUGS
 750
 751 This module should probably be renamed, since much of the functionality is
 752 of general use.  It is not completely unlike Adapter::DBI (see below).
 753
 754 Exported qsearch and qsearchs should be depriciated in favor of method calls
 755 (against an FS::Record object like the old search and searchs that qsearch
 756 and qsearchs were on top of.)
 757
 758 The whole fields / hfields mess should be removed.
 759
 760 The various WHERE clauses should be subroutined.
 761
 762 table string should be depriciated in favor of FS::dbdef_table.
 763
 764 No doubt we could benefit from a Tied hash.  Documenting how exists / defined
 765 true maps to the database (and WHERE clauses) would also help.
 766
 767 The ut_ methods should ask the dbdef for a default length.
 768
 769 ut_sqltype (like ut_varchar) should all be defined
 770
 771 A fallback check method should be provided with uses the dbdef.
 772
 773 The ut_money method assumes money has two decimal digits.
 774
 775 The Pg money kludge in the new method only strips `$'.
 776
 777 The ut_phonen method assumes US-style phone numbers.
 778
 779 The _quote function should probably use ut_float instead of a regex.
 780
 781 All the subroutines probably should be methods, here or elsewhere.
 782
 783 =head1 SEE ALSO
 784
 785 L<FS::dbdef>, L<FS::UID>, L<DBI>
 786
 787 Adapter::DBI from Ch. 11 of Advanced Perl Programming by Sriram Srinivasan.
 788
 789 =head1 HISTORY
 790
 791 ivan@voicenet.com 97-jun-2 - 9, 19, 25, 27, 30
 792
 793 DBI version
 794 ivan@sisd.com 97-nov-8 - 12
 795
 796 cleaned up, added autoloaded $self->any_field calls, moved DBI login stuff
 797 to FS::UID
 798 ivan@sisd.com 97-nov-21-23
 799
 800 since AUTO_INCREMENT is MySQL specific, use my own unique number generator
 801 (again)
 802 ivan@sisd.com 97-dec-4
 803
 804 untaint $user in unique (web demo hack...bah)
 805 make unique skip multiple-field unique's from dbdef
 806 ivan@sisd.com 97-dec-11
 807
 808 merge with FS::Search, which after all was just alternate constructors for
 809 FS::Record objects.  Makes lots of things cleaner.  :)
 810 ivan@sisd.com 97-dec-13
 811
 812 use FS::dbdef::primary key in replace searches, hopefully for all practical
 813 purposes the string/number problem in SQL statements should be gone?
 814 (SQL bites)
 815 ivan@sisd.com 98-jan-20
 816
 817 Put all SQL statments in $statment before we $sth=$dbh->prepare( them,
 818 for debugging reasons (warn $statement) ivan@sisd.com 98-feb-19
 819
 820 (sigh)... use dbdef type (char, etc.) instead of a regex to decide
 821 what to quote in _quote (more sillines...)  SQL bites.
 822 ivan@sisd.com 98-feb-20
 823
 824 more friendly error messages ivan@sisd.com 98-mar-13
 825
 826 Added import of datasrc from FS::UID to allow Pg6.3 to work
 827 Added code to right-trim strings read from Pg6.3 databases
 828 Modified 'add' to only insert fields that actually have data
 829 Added ut_float to handle floating point numbers (for sales tax).
 830 Pg6.3 does not have a "SHOW FIELDS" statement, so I faked it 8).
 831         bmccane@maxbaud.net     98-apr-3
 832
 833 commented out Pg wrapper around `` Modified 'add' to only insert fields that
 834 actually have data '' ivan@sisd.com 98-apr-16
 835
 836 dbdef usage changes ivan@sisd.com 98-jun-1
 837
 838 sub fields now asks dbdef, not database ivan@sisd.com 98-jun-2
 839
 840 added debugging method ->_dump ivan@sisd.com 98-jun-16
 841
 842 use FS::dbdef::primary key in delete searches as well as replace
 843 searches (SQL still bites) ivan@sisd.com 98-jun-22
 844
 845 sub dbdef_table ivan@sisd.com 98-jun-28
 846
 847 removed Pg wrapper around `` Modified 'add' to only insert fields that
 848 actually have data '' ivan@sisd.com 98-jul-14
 849
 850 sub fields croaks on errors ivan@sisd.com 98-jul-17
 851
 852 $rc eq '0E0' doesn't mean we couldn't delete for all rdbmss
 853 ivan@sisd.com 98-jul-18
 854
 855 commented out code to right-trim strings read from Pg6.3 databases;
 856 ChopBlanks is in UID.pm ivan@sisd.com 98-aug-16
 857
 858 added code (with Pg wrapper) to deal with Pg money fields
 859 ivan@sisd.com 98-aug-18
 860
 861 added pod documentation ivan@sisd.com 98-sep-6
 862
 863 ut_phonen got ''; at the end ivan@sisd.com 98-sep-27
 864
 865 =cut
 866
 867 1;
 868