X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2FRecord.pm;h=acec9458d54b5392003ab26d1e2a3c2f5274bdb5;hb=48bade3f01a672f235d61a29ad0d0b792fc80eab;hp=9badd5bef0cef1624cc7d328e3e1ed7ae6f47f5e;hpb=86bf118b5df60143efbd1e488c4f2825e0d2df2f;p=freeside.git diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 9badd5bef..acec9458d 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -3,12 +3,16 @@ package FS::Record; use strict; use vars qw( $AUTOLOAD @ISA @EXPORT_OK $DEBUG $conf $me - %virtual_fields_cache $nowarn_identical $no_update_diff ); + %virtual_fields_cache + $nowarn_identical $no_update_diff $no_check_foreign + ); use Exporter; use Carp qw(carp cluck croak confess); use Scalar::Util qw( blessed ); use File::CounterFile; use Locale::Country; +use Text::CSV_XS; +use File::Slurp qw( slurp ); use DBI qw(:sql_types); use DBIx::DBSchema 0.33; use FS::UID qw(dbh getotaker datasrc driver_name); @@ -33,6 +37,7 @@ $me = '[FS::Record]'; $nowarn_identical = 0; $no_update_diff = 0; +$no_check_foreign = 0; my $rsa_module; my $rsa_loaded; @@ -308,17 +313,19 @@ sub qsearch { my $TYPE = SQL_VARCHAR; if ( $type =~ /(int|(big)?serial)/i && $value =~ /^\d+(\.\d+)?$/ ) { $TYPE = SQL_INTEGER; + + #DBD::Pg 1.49: Cannot bind ... unknown sql_type 6 with SQL_FLOAT } elsif ( ( $type =~ /(numeric)/i && $value =~ /^[+-]?\d+(\.\d+)?$/) || ( $type =~ /(real|float4)/i && $value =~ /[-+]?\d*\.?\d+([eE][-+]?\d+)?/ ) ) { - $TYPE = SQL_FLOAT; + $TYPE = SQL_DECIMAL; } if ( $DEBUG > 2 ) { no strict 'refs'; - %TYPE = map { &{"DBI::$_"} => $_ } @{ $DBI::EXPORT_TAGS{sql_types} } + %TYPE = map { &{"DBI::$_"}() => $_ } @{ $DBI::EXPORT_TAGS{sql_types} } unless keys %TYPE; warn " bind_param $bind (for field $field), $value, TYPE $TYPE{$TYPE}\n"; } @@ -759,6 +766,50 @@ sub select_for_update { } ); } +=item lock_table + +Locks this table with a database-driver specific lock method. This is used +as a mutex in order to do a duplicate search. + +For PostgreSQL, does "LOCK TABLE tablename IN SHARE ROW EXCLUSIVE MODE". + +For MySQL, does a SELECT FOR UPDATE on the duplicate_lock table. + +Errors are fatal; no useful return value. + +Note: To use this method for new tables other than svc_acct and svc_phone, +edit freeside-upgrade and add those tables to the duplicate_lock list. + +=cut + +sub lock_table { + my $self = shift; + my $table = $self->table; + + warn "$me locking $table table\n" if $DEBUG; + + if ( driver_name =~ /^Pg/i ) { + + dbh->do("LOCK TABLE $table IN SHARE ROW EXCLUSIVE MODE") + or die dbh->errstr; + + } elsif ( driver_name =~ /^mysql/i ) { + + dbh->do("SELECT * FROM duplicate_lock + WHERE lockname = '$table' + FOR UPDATE" + ) or die dbh->errstr; + + } else { + + die "unknown database ". driver_name. "; don't know how to lock table"; + + } + + warn "$me acquired $table table lock\n" if $DEBUG; + +} + =item insert Inserts this record to the database. If there is an error, returns the error, @@ -801,17 +852,18 @@ sub insert { } my $table = $self->table; - # Encrypt before the database - if ($conf->exists('encryption') && defined(eval '@FS::'. $table . '::encrypted_fields')) { + if ( defined(eval '@FS::'. $table . '::encrypted_fields') + && scalar( eval '@FS::'. $table . '::encrypted_fields') + && $conf->exists('encryption') + ) { foreach my $field (eval '@FS::'. $table . '::encrypted_fields') { $self->{'saved'} = $self->getfield($field); $self->setfield($field, $self->encrypt($self->getfield($field))); } } - #false laziness w/delete my @real_fields = grep { defined($self->getfield($_)) && $self->getfield($_) ne "" } @@ -1288,6 +1340,198 @@ sub check { ''; } +=item batch_import PARAM_HASHREF + +Class method for batch imports. Available params: + +=over 4 + +=item job + +FS::queue object, will be updated with progress + +=back + +=cut + +use Storable qw(thaw); +use Data::Dumper; +use MIME::Base64; +sub process_batch_import { + my($job, $opt) = ( shift, shift ); + + my $table = $opt->{table}; + my @pass_params = @{ $opt->{params} }; + my %formats = %{ $opt->{formats} }; + + my $param = thaw(decode_base64(shift)); + warn Dumper($param) if $DEBUG; + + my $files = $param->{'uploaded_files'} + or die "No files provided.\n"; + + my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files; + + my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/'; + my $file = $dir. $files{'file'}; + + my $type; + if ( $file =~ /\.(\w+)$/i ) { + $type = lc($1); + } else { + #or error out??? + warn "can't parse file type from filename $file; defaulting to CSV"; + $type = 'csv'; + } + $type = 'csv' + if $opt->{'default_csv'} && $type ne 'xls'; + + my $error = + FS::Record::batch_import( { + table => $table, + formats => \%formats, + job => $job, + file => $file, + type => $type, + format => $param->{format}, + params => { map { $_ => $param->{$_} } @pass_params }, + } ); + + unlink $file; + + die "$error\n" if $error; +} + +sub batch_import { + my $param = shift; + + my $table = $param->{table}; + my $formats = $param->{formats}; + my $params = $param->{params}; + + my $job = $param->{job}; + + my $filename = $param->{file}; + my $type = $param->{type} || 'csv'; + + my $format = $param->{'format'}; + + die "unknown format $format" unless exists $formats->{ $format }; + my @fields = @{ $formats->{ $format } }; + + my $count; + my $parser; + my @buffer = (); + if ( $type eq 'csv' ) { + + $parser = new Text::CSV_XS; + + @buffer = split(/\r?\n/, slurp($filename) ); + $count = scalar(@buffer); + + } elsif ( $type eq 'xls' ) { + + eval "use Spreadsheet::ParseExcel;"; + die $@ if $@; + + my $excel = Spreadsheet::ParseExcel::Workbook->new->Parse($filename); + + $parser = $excel->{Worksheet}[0]; #first sheet + + $count = $parser->{MaxRow} || $parser->{MinRow}; + $count++; + + } else { + die "Unknown file type $type\n"; + } + + #my $columns; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $line; + my $row = 0; + my( $last, $min_sec ) = ( time, 5 ); #progressbar foo + while (1) { + + my @columns = (); + if ( $type eq 'csv' ) { + + last unless scalar(@buffer); + $line = shift(@buffer); + + $parser->parse($line) or do { + $dbh->rollback if $oldAutoCommit; + return "can't parse: ". $parser->error_input(); + }; + @columns = $parser->fields(); + + } elsif ( $type eq 'xls' ) { + + last if $row > ($parser->{MaxRow} || $parser->{MinRow}) + || ! $parser->{Cells}[$row]; + + my @row = @{ $parser->{Cells}[$row] }; + @columns = map $_->{Val}, @row; + + #my $z = 'A'; + #warn $z++. ": $_\n" for @columns; + + } else { + die "Unknown file type $type\n"; + } + + my %hash = %$params; + + foreach my $field ( @fields ) { + + my $value = shift @columns; + + if ( ref($field) eq 'CODE' ) { + &{$field}(\%hash, $value); + } else { + $hash{$field} = $value if length($value); + } + + } + + my $class = "FS::$table"; + + my $record = $class->new( \%hash ); + + my $error = $record->insert; + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't insert record". ( $line ? " for $line" : '' ). ": $error"; + } + + $row++; + + if ( $job && time - $min_sec > $last ) { #progress bar + $job->update_statustext( int(100 * $row / $count) ); + $last = time; + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit;; + + return "Empty file!" unless $row; + + ''; #no error + +} + sub _h_statement { my( $self, $action, $time ) = @_; @@ -1300,7 +1544,7 @@ sub _h_statement { # 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') ) { + if ($conf && $conf->exists('encryption') ) { @fields = grep $_ ne 'payinfo' && $_ ne 'cvv2', @fields; } my @values = map { _quote( $self->getfield($_), $self->table, $_) } @fields; @@ -1608,6 +1852,8 @@ sub ut_phonen { $self->setfield($field,''); } elsif ( $country eq 'US' || $country eq 'CA' ) { $phonen =~ s/\D//g; + $phonen = $conf->config('cust_main-default_areacode').$phonen + if length($phonen)==7 && $conf->config('cust_main-default_areacode'); $phonen =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/ or return gettext('illegal_phone'). " $field: ". $self->getfield($field); $phonen = "$1-$2-$3"; @@ -1900,6 +2146,7 @@ on the column first. sub ut_foreign_key { my( $self, $field, $table, $foreign ) = @_; + return '' if $no_check_foreign; qsearchs($table, { $foreign => $self->getfield($field) }) or return "Can't find ". $self->table. ".$field ". $self->getfield($field). " in $table.$foreign";