use strict;
use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG
- $me %virtual_fields_cache $nowarn_identical );
+ $conf $me
+ %virtual_fields_cache $nowarn_identical );
use Exporter;
use Carp qw(carp cluck croak confess);
use File::CounterFile;
my $rsa_decrypt;
FS::UID->install_callback( sub {
- $File::CounterFile::DEFAULT_DIR = "/usr/local/etc/freeside/counters.". datasrc;
+ $conf = new FS::Conf;
+ $File::CounterFile::DEFAULT_DIR = $conf->base_dir . "/counters.". datasrc;
} );
+
=head1 NAME
FS::Record - Database record objects
$value = $record->unique('column');
$error = $record->ut_float('column');
+ $error = $record->ut_floatn('column');
$error = $record->ut_number('column');
$error = $record->ut_numbern('column');
$error = $record->ut_snumber('column');
}
# Check for encrypted fields and decrypt them.
- my $conf = new FS::Conf;
- if ($conf->exists('encryption') && eval 'defined(@FS::'. $table . '::encrypted_fields)') {
+ ## only in the local copy, not the cached object
+ if ( $conf && $conf->exists('encryption') # $conf doesn't exist when doing
+ # the initial search for
+ # access_user
+ && eval 'defined(@FS::'. $table . '::encrypted_fields)') {
foreach my $record (@return) {
foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
# Set it directly... This may cause a problem in the future...
dbdef->table($table);
}
+=item primary_key
+
+Returns the primary key for the table.
+
+=cut
+
+sub primary_key {
+ my $self = shift;
+ my $pkey = $self->dbdef_table->primary_key;
+}
+
=item get, getfield COLUMN
Returns the value of the column/field/key COLUMN.
$self->{'modified'};
}
+=item select_for_update
+
+Selects this record with the SQL "FOR UPDATE" command. This can be useful as
+a mutex.
+
+=cut
+
+sub select_for_update {
+ my $self = shift;
+ my $primary_key = $self->primary_key;
+ qsearchs( {
+ 'select' => '*',
+ 'table' => $self->table,
+ 'hashref' => { $primary_key => $self->$primary_key() },
+ 'extra_sql' => 'FOR UPDATE',
+ } );
+}
+
=item insert
Inserts this record to the database. If there is an error, returns the error,
my $self = shift;
my $saved = {};
+ warn "$self -> insert" if $DEBUG;
+
my $error = $self->check;
return $error if $error;
# Encrypt before the database
- my $conf = new FS::Conf;
if ($conf->exists('encryption') && defined(eval '@FS::'. $table . '::encrypted_fields')) {
foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
$self->{'saved'} = $self->getfield($field);
- $self->setfield($field, $self->enrypt($self->getfield($field)));
+ $self->setfield($field, $self->encrypt($self->getfield($field)));
}
}
dbh->rollback if $FS::UID::AutoCommit;
return dbh->errstr;
};
- #$i_sth->execute($oid) or do {
- $i_sth->execute() or do {
+ $i_sth->execute() or do { #$i_sth->execute($oid)
dbh->rollback if $FS::UID::AutoCommit;
return $i_sth->errstr;
};
=cut
sub replace {
- my $new = shift;
- my $old = shift;
-
- if (!defined($old)) {
- warn "[debug]$me replace called with no arguments; autoloading old record\n"
- if $DEBUG;
- my $primary_key = $new->dbdef_table->primary_key;
- if ( $primary_key ) {
- $old = qsearchs($new->table, { $primary_key => $new->$primary_key() } )
- or croak "can't find ". $new->table. ".$primary_key ".
- $new->$primary_key();
- } else {
- croak $new->table. " has no primary key; pass old record as argument";
- }
- }
+ my ($new, $old) = (shift, shift);
+
+ $old = $new->replace_old unless defined($old);
warn "[debug]$me $new ->replace $old\n" if $DEBUG;
# Encrypt for replace
my $conf = new FS::Conf;
my $saved = {};
- if ($conf->exists('encryption') && defined(eval '@FS::'. $new->table . 'encrypted_fields')) {
+ if ($conf->exists('encryption') && defined(eval '@FS::'. $new->table . '::encrypted_fields')) {
foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') {
$saved->{$field} = $new->getfield($field);
$new->setfield($field, $new->encrypt($new->getfield($field)));
}
+sub replace_old {
+ my( $self ) = shift;
+ warn "[$me] replace called with no arguments; autoloading old record\n"
+ if $DEBUG;
+
+ my $primary_key = $self->dbdef_table->primary_key;
+ if ( $primary_key ) {
+ $self->by_key( $self->$primary_key() ) #this is what's returned
+ or croak "can't find ". $self->table. ".$primary_key ".
+ $self->$primary_key();
+ } else {
+ croak $self->table. " has no primary key; pass old record as argument";
+ }
+
+}
+
=item rep
Depriciated (use replace instead).
grep { defined($self->getfield($_)) && $self->getfield($_) ne "" }
real_fields($self->table);
;
+
+ # If we're encrypting then don't ever store the payinfo or CVV2 in the history....
+ # You can see if it changed by the paymask...
+ if ($conf->exists('encryption') ) {
+ @fields = grep $_ ne 'payinfo' && $_ ne 'cvv2', @fields;
+ }
my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields;
"INSERT INTO h_". $self->table. " ( ".
$self->setfield($field,$1);
'';
}
+=item ut_floatn COLUMN
+
+Check/untaint floating point numeric data: 1.1, 1, 1.1e10, 1e10. May be
+null. If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+#false laziness w/ut_ipn
+sub ut_floatn {
+ my( $self, $field ) = @_;
+ if ( $self->getfield($field) =~ /^()$/ ) {
+ $self->setfield($field,'');
+ '';
+ } else {
+ $self->ut_float($field);
+ }
+}
+
+=item ut_sfloat COLUMN
+
+Check/untaint signed floating point numeric data: 1.1, 1, 1.1e10, 1e10.
+May not be null. If there is an error, returns the error, otherwise returns
+false.
+
+=cut
+
+sub ut_sfloat {
+ my($self,$field)=@_ ;
+ ($self->getfield($field) =~ /^(-?\d+\.\d+)$/ ||
+ $self->getfield($field) =~ /^(-?\d+)$/ ||
+ $self->getfield($field) =~ /^(-?\d+\.\d+[eE]-?\d+)$/ ||
+ $self->getfield($field) =~ /^(-?\d+[eE]-?\d+)$/)
+ or return "Illegal or empty (float) $field: ". $self->getfield($field);
+ $self->setfield($field,$1);
+ '';
+}
+=item ut_sfloatn COLUMN
+
+Check/untaint signed floating point numeric data: 1.1, 1, 1.1e10, 1e10. May be
+null. If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub ut_sfloatn {
+ my( $self, $field ) = @_;
+ if ( $self->getfield($field) =~ /^()$/ ) {
+ $self->setfield($field,'');
+ '';
+ } else {
+ $self->ut_sfloat($field);
+ }
+}
=item ut_snumber COLUMN
-Check/untaint signed numeric data (whole numbers). May not be null. If there
-is an error, returns the error, otherwise returns false.
+Check/untaint signed numeric data (whole numbers). If there is an error,
+returns the error, otherwise returns false.
=cut
'';
}
+=item ut_hex COLUMN
+
+Check/untaint hexadecimal values.
+
+=cut
+
+sub ut_hex {
+ my($self, $field) = @_;
+ $self->getfield($field) =~ /^([\da-fA-F]+)$/
+ or return "Illegal (hex) $field: ". $self->getfield($field);
+ $self->setfield($field, uc($1));
+ '';
+}
+
+=item ut_hexn COLUMN
+
+Check/untaint hexadecimal values. May be null.
+
+=cut
+
+sub ut_hexn {
+ my($self, $field) = @_;
+ $self->getfield($field) =~ /^([\da-fA-F]*)$/
+ or return "Illegal (hex) $field: ". $self->getfield($field);
+ $self->setfield($field, uc($1));
+ '';
+}
=item ut_ip COLUMN
Check/untaint ip addresses. IPv4 only for now.
=cut
-my @zip_reqd_countries = qw( CA ); #US implicit...
+my @zip_reqd_countries = qw( AU CA US ); #CA, US implicit...
sub ut_zip {
my( $self, $field, $country ) = @_;
} (fields($self->table)) );
}
+=item encrypt($value)
+
+Encrypts the credit card using a combination of PK to encrypt and uuencode to armour.
+
+Returns the encrypted string.
+
+You should generally not have to worry about calling this, as the system handles this for you.
+
+=cut
+
+
sub encrypt {
my ($self, $value) = @_;
my $encrypted;
return $encrypted;
}
+=item is_encrypted($value)
+
+Checks to see if the string is encrypted and returns true or false (1/0) to indicate it's status.
+
+=cut
+
+
sub is_encrypted {
my ($self, $value) = @_;
# Possible Bug - Some work may be required here....
- if (length($value) > 80) {
+ if ($value =~ /^M/ && length($value) > 80) {
return 1;
} else {
return 0;
}
}
+=item decrypt($value)
+
+Uses the private key to decrypt the string. Returns the decryoted string or undef on failure.
+
+You should generally not have to worry about calling this, as the system handles this for you.
+
+=cut
+
sub decrypt {
my ($self,$value) = @_;
my $decrypted = $value; # Will return the original value if it isn't encrypted or can't be decrypted.
$self->loadRSA;
if (ref($rsa_decrypt) =~ /::RSA/) {
my $encrypted = unpack ("u*", $value);
- $decrypted = unpack("Z*", $rsa_decrypt->decrypt($encrypted));
+ $decrypted = unpack("Z*", eval{$rsa_decrypt->decrypt($encrypted)});
+ if ($@) {warn "Decryption Failed"};
}
}
return $decrypted;