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