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