eval "use FS::Conf;";
die $@ if $@;
- $conf = FS::Conf->new;
+ $conf = FS::Conf->new;
$conf_encryption = $conf->exists('encryption');
$conf_encryptionmodule = $conf->config('encryptionmodule');
$conf_encryptionpublickey = join("\n",$conf->config('encryptionpublickey'));
$record = qsearchs FS::Record 'table', \%hash;
$record = qsearchs FS::Record 'table', { 'column' => 'value', ... };
- @records = qsearch FS::Record 'table', \%hash;
+ @records = qsearch FS::Record 'table', \%hash;
@records = qsearch FS::Record 'table', { 'column' => 'value', ... };
$table = $record->table;
L<"insert"> for that.
Note that the object stores this hash reference, not a distinct copy of the
-hash it points to. You can ask the object for a copy with the I<hash>
+hash it points to. You can ask the object for a copy with the I<hash>
method.
TABLE can only be omitted when a dervived class overrides the table method.
=cut
-sub new {
+sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
carp "warning: FS::Record::new called with table name ". $self->{'Table'}
unless $nowarn_classload;
}
-
+
$self->{'Hash'} = shift;
- foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
+ foreach my $field ( grep !defined($self->{'Hash'}{$_}), $self->fields ) {
$self->{'Hash'}{$field}='';
}
push @statement, $statement;
warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug;
-
+
foreach my $field (
grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
# Check for encrypted fields and decrypt them.
## only in the local copy, not the cached object
no warnings 'deprecated'; # XXX silence the warning for now
- if ( $conf_encryption
+ if ( $conf_encryption
&& eval 'defined(@FS::'. $table . '::encrypted_fields)' ) {
foreach my $record (@return) {
foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
- next if $field eq 'payinfo'
- && ($record->isa('FS::payinfo_transaction_Mixin')
+ next if $field eq 'payinfo'
+ && ($record->isa('FS::payinfo_transaction_Mixin')
|| $record->isa('FS::payinfo_Mixin') )
&& $record->payby
&& !grep { $record->payby eq $_ } @encrypt_payby;
push @statement, $statement;
warn "[debug]$me $statement\n" if $DEBUG > 1 || $debug;
-
+
foreach my $field (
grep defined( $record->{$_} ) && $record->{$_} ne '', @real_fields
# Check for encrypted fields and decrypt them.
## only in the local copy, not the cached object
- if ( $conf_encryption
+ if ( $conf_encryption
&& eval 'defined(@FS::'. $table . '::encrypted_fields)' ) {
foreach my $record (@return) {
foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
- next if $field eq 'payinfo'
- && ($record->isa('FS::payinfo_transaction_Mixin')
+ next if $field eq 'payinfo'
+ && ($record->isa('FS::payinfo_transaction_Mixin')
|| $record->isa('FS::payinfo_Mixin') )
&& $record->payby
&& !grep { $record->payby eq $_ } @encrypt_payby;
my $real_fields = shift;
## could be optimized more for readability
- return (
+ return (
map {
my $op = '=';
}
} @{ $real_fields }
- );
+ );
}
=item by_key PRIMARY_KEY_VALUE
method calls. Interface will almost definately change in an incompatible
fashion.
-Arguments:
+Arguments:
=cut
# to avoid "Use of unitialized value" errors
if ( defined ( $self->{Hash}->{$field} ) ) {
$self->{Hash}->{$field};
- } else {
+ } else {
'';
}
}
=cut
-sub set {
+sub set {
my($self,$field,$value) = @_;
$self->{'modified'} = 1;
$self->{'Hash'}->{$field} = $value;
confess "errant AUTOLOAD $field for $self (no args)"
unless blessed($self) && $self->can('getfield');
$self->getfield($field);
- }
+ }
}
# efficient
# $_[0]->setfield($field, $_[1]);
# } else {
# $_[0]->getfield($field);
-# }
+# }
#}
=item hash
my($self) = @_;
confess $self. ' -> hash: Hash attribute is undefined'
unless defined($self->{'Hash'});
- %{ $self->{'Hash'} };
+ %{ $self->{'Hash'} };
}
=item hashref
}
my $table = $self->table;
-
+
# Encrypt before the database
if ( scalar( eval '@FS::'. $table . '::encrypted_fields')
&& $conf_encryption
) {
foreach my $field (eval '@FS::'. $table . '::encrypted_fields') {
- next if $field eq 'payinfo'
- && ($self->isa('FS::payinfo_transaction_Mixin')
+ next if $field eq 'payinfo'
+ && ($self->isa('FS::payinfo_transaction_Mixin')
|| $self->isa('FS::payinfo_Mixin') )
&& $self->payby
&& !grep { $self->payby eq $_ } @encrypt_payby;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
# get inserted id from the database, if applicable & needed
if ( $db_seq && ! $self->getfield($primary_key) ) {
warn "[debug]$me retreiving sequence from database\n" if $DEBUG;
-
+
my $insertid = '';
if ( driver_name eq 'Pg' ) {
} else {
dbh->rollback if $FS::UID::AutoCommit;
- return "don't know how to retreive inserted ids from ". driver_name.
+ return "don't know how to retreive inserted ids from ". driver_name.
", try using counterfiles (maybe run dbdef-create?)";
}
dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
- # Now that it has been saved, reset the encrypted fields so that $new
+ # Now that it has been saved, reset the encrypted fields so that $new
# can still be used.
foreach my $field (keys %{$saved}) {
$self->setfield($field, $saved->{$field});
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
my $rc = $sth->execute or return $sth->errstr;
#not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
$h_sth->execute or return $h_sth->errstr if $h_sth;
-
+
dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
#no need to needlessly destoy the data either (causes problems actually)
my $error = $new->check;
return $error if $error;
-
+
# Encrypt for replace
my $saved = {};
if ( scalar( eval '@FS::'. $new->table . '::encrypted_fields')
&& $conf_encryption
) {
foreach my $field (eval '@FS::'. $new->table . '::encrypted_fields') {
- next if $field eq 'payinfo'
- && ($new->isa('FS::payinfo_transaction_Mixin')
+ next if $field eq 'payinfo'
+ && ($new->isa('FS::payinfo_transaction_Mixin')
|| $new->isa('FS::payinfo_Mixin') )
&& $new->payby
&& !grep { $new->payby eq $_ } @encrypt_payby;
#my @diff = grep $new->getfield($_) ne $old->getfield($_), $old->fields;
my %diff = map { ($new->getfield($_) ne $old->getfield($_))
? ($_, $new->getfield($_)) : () } $old->fields;
-
+
unless (keys(%diff) || $no_update_diff ) {
carp "[warning]$me ". ref($new)."->replace ".
( $primary_key ? "$primary_key ".$new->get($primary_key) : '' ).
my $statement = "UPDATE ". $old->table. " SET ". join(', ',
map {
- "$_ = ". _quote($new->getfield($_),$old->table,$_)
+ "$_ = ". _quote($new->getfield($_),$old->table,$_)
} real_fields($old->table)
). ' WHERE '.
join(' AND ',
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
- local $SIG{QUIT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
local $SIG{TERM} = 'IGNORE';
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
- # Now that it has been saved, reset the encrypted fields so that $new
+ # Now that it has been saved, reset the encrypted fields so that $new
# can still be used.
foreach my $field (keys %{$saved}) {
$new->setfield($field, $saved->{$field});
=cut
-sub check {
+sub check {
my $self = shift;
foreach my $field ($self->virtual_fields) {
my $error = $self->ut_textn($field);
=item virtual_fields [ TABLE ]
-Returns a list of virtual fields defined for the table. This should not
+Returns a list of virtual fields defined for the table. This should not
be exported, and should only be called as an instance or class method.
=cut
=back
-PARAMS is a hashref (or base64-encoded Storable hashref) containing the
-POSTed data. It must contain the field "uploaded files", generated by
+PARAMS is a hashref (or base64-encoded Storable hashref) containing the
+POSTed data. It must contain the field "uploaded files", generated by
/elements/file-upload.html and containing the list of uploaded files.
Currently only supports a single file named "file".
my $param = shift;
# because some job-spawning code (JSRPC) pre-freezes the arguments,
- # and then the 'frozen' attribute doesn't get set, and thus $job->args
+ # and then the 'frozen' attribute doesn't get set, and thus $job->args
# doesn't know to thaw them, we have to do this everywhere.
if (!ref $param) {
$param = thaw(decode_base64($param));
}
warn Dumper($param) if $DEBUG;
-
+
my $files = $param->{'uploaded_files'}
or die "No files provided.\n";
next if $line =~ /^\s*$/; #skip empty lines
$line = &{$row_callback}($line) if $row_callback;
-
+
next if $line =~ /^\s*$/; #skip empty lines
$parser->parse($line) or do {
foreach my $field ( @fields ) {
my $value = shift @columns;
-
+
if ( ref($field) eq 'CODE' ) {
#&{$field}(\%hash, $value);
push @later, $field, $value;
=item unique COLUMN
-B<Warning>: External use is B<deprecated>.
+B<Warning>: External use is B<deprecated>.
Replaces COLUMN in record with a unique number, using counters in the
filesystem. Used by the B<insert> method on single-field unique columns
=item ut_decimal COLUMN[, DIGITS]
-Check/untaint decimal numbers (up to DIGITS decimal places. If there is an
+Check/untaint decimal numbers (up to DIGITS decimal places. If there is an
error, returns the error, otherwise returns false.
=item ut_decimaln COLUMN[, DIGITS]
sub ut_alphan {
my($self,$field)=@_;
- $self->getfield($field) =~ /^(\w*)$/
+ $self->getfield($field) =~ /^(\w*)$/
or return "Illegal (alphanumeric) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
sub ut_alphasn {
my($self,$field)=@_;
- $self->getfield($field) =~ /^([\w ]*)$/
+ $self->getfield($field) =~ /^([\w ]*)$/
or return "Illegal (alphanumeric) $field: ". $self->getfield($field);
$self->setfield($field,$1);
'';
$self->getfield($field) =~ /^([\p{Word} \,\.\-\']+)$/
or return gettext('illegal_name'). " $field: ". $self->getfield($field);
my $name = $1;
- $name =~ s/^\s+//;
- $name =~ s/\s+$//;
+ $name =~ s/^\s+//;
+ $name =~ s/\s+$//;
$name =~ s/\s+/ /g;
$self->setfield($field, $name);
'';
sub ut_country {
my( $self, $field ) = @_;
unless ( $self->getfield($field) =~ /^(\w\w)$/ ) {
- if ( $self->getfield($field) =~ /^([\w \,\.\(\)\']+)$/
+ if ( $self->getfield($field) =~ /^([\w \,\.\(\)\']+)$/
&& country2code($1) ) {
$self->setfield($field,uc(country2code($1)));
}
if ($conf_encryptionpublickey && $conf_encryptionpublickey ne '') {
$rsa_encrypt = $rsa_module->new_public_key($conf_encryptionpublickey);
}
-
+
# Intitalize Decryption
if ($conf_encryptionprivatekey && $conf_encryptionprivatekey ne '') {
$rsa_decrypt = $rsa_module->new_private_key($conf_encryptionprivatekey);
=item count [ WHERE [, PLACEHOLDER ...] ]
-Convenience method for the common case of "SELECT COUNT(*) FROM table",
-with optional WHERE. Must be called as method on a class with an
+Convenience method for the common case of "SELECT COUNT(*) FROM table",
+with optional WHERE. Must be called as method on a class with an
associated table.
=cut
=item real_fields [ TABLE ]
-Returns a list of the real columns in the specified table. Called only by
+Returns a list of the real columns in the specified table. Called only by
fields() and other subroutines elsewhere in FS::Record.
=cut
=item pvf FIELD_NAME
-Returns the FS::part_virtual_field object corresponding to a field in the
+Returns the FS::part_virtual_field object corresponding to a field in the
record (specified by FIELD_NAME).
=cut
my $concat = [ "'cf_'", "name" ];
return qsearchs({ table => 'part_virtual_field',
hashref => { dbtable => $self->table,
- name => $name
+ name => $name
},
select => 'vfieldpart, dbtable, length, label, '.concat_sql($concat).' as name',
});
cluck "WARNING: Attempting to set non-null integer $table.$column null; ".
"using 0 instead";
0;
- } elsif ( $value =~ /^\d+(\.\d+)?$/ &&
+ } elsif ( $value =~ /^\d+(\.\d+)?$/ &&
! $column_type =~ /(char|binary|text)$/i ) {
$value;
} elsif (( $column_type =~ /^bytea$/i || $column_type =~ /(blob|varbinary)/i )
=cut
-sub str2time_sql {
+sub str2time_sql {
my $driver = shift || driver_name;
return 'UNIX_TIMESTAMP(' if $driver =~ /^mysql/i;
=cut
-sub str2time_sql_closing {
+sub str2time_sql_closing {
my $driver = shift || driver_name;
return ' )::INTEGER ' if $driver =~ /^Pg/i;
=item group_concat_sql COLUMN, DELIMITER
-Returns an SQL expression to concatenate an aggregate column, using
+Returns an SQL expression to concatenate an aggregate column, using
GROUP_CONCAT() for mysql and array_to_string() and array_agg() for Pg.
=cut
=item midnight_sql DATE
-Returns an SQL expression to convert DATE (a unix timestamp) to midnight
+Returns an SQL expression to convert DATE (a unix timestamp) to midnight
on that day in the system timezone, using the default driver name.
=cut
=cut
1;
-
###
'title' => 'Page title',
-
+
'name_singular' => 'item', #singular name for the records returned
#OR# # (preferred, will be pluralized automatically)
'name' => 'items', #plural name for the records returned
'addl_from' => '', #'LEFT JOIN othertable USING ( key )',
'extra_sql' => '', #'AND otherstuff', #'WHERE onlystuff',
'order_by' => 'ORDER BY something',
-
+
},
# "select * from tablename";
-
+
#required unless 'query' is an SQL query string (shouldn't be...)
'count_query' => 'SELECT COUNT(*) FROM tablename',
'header' => [ '#',
'Item',
{ 'label' => 'Another Item',
-
+
},
],
'redirect_empty' => sub { my( $cgi ) = @_;
popurl(2).'view/item.html';
},
-
+
###
# optional
###
-
+
# some HTML callbacks...
'menubar' => '', #menubar arrayref
'html_init' => '', #after the header/menubar and before the pager
'html_foot' => '', #at the bottom
'html_posttotal' => '', #at the bottom
# (these three can be strings or coderefs)
-
+
'count_addl' => [], #additional count fields listref of sprintf strings or coderefs
# [ $money_char.'%.2f total paid', ],
-
+
#second (smaller) header line, currently only for HTML
'header2 => [ '#',
'Item',
{ 'label' => 'Another Item',
-
+
},
],
#listref of column footers
'footer' => [],
-
+
#disabling things
'disable_download' => '', # set true to hide the CSV/Excel download links
'disable_total' => '', # set true to hide the total"
'disable_nonefound' => '', # set true to disable the "No matching Xs found"
# message
'nohtmlheader' => '', # set true to remove the header and menu bar
-
+
#handling "disabled" fields in the records
'disableable' => 1, # set set to 1 (or column position for "disabled"
# status col) to enable if this table has a "disabled"
'order_by_sql' => { #to keep complex SQL expressions out of cgi order_by value,
'fieldname' => 'sql snippet', # maps fields/sort_fields values to sql snippets
}
-
+
#listref - each item is the empty string,
# or a listref of link and method name to append,
# or a listref of link and coderef to run and append
#one letter for each column, left/right/center/none
# or pass a listref with full values: [ 'left', 'right', 'center', '' ]
'align' => 'lrc.',
-
+
#listrefs of ( scalars or coderefs )
# currently only HTML, maybe eventually Excel too
'color' => [],
# Excel-specific listref of ( hashrefs or coderefs )
# each hashref: http://search.cpan.org/dist/Spreadsheet-WriteExcel/lib/Spreadsheet/WriteExcel.pm#Format_methods_and_Format_properties
'xls_format' => => [],
-
+
# miscellany
'download_label' => 'Download this report',
- # defaults to 'Download full results'
+ # defaults to 'Download full results'
'link_field' => 'pkgpart'
# will create internal links for each row,
# with the value of this field as the NAME attribute
)
%>
%
-% }
+% }
<%init>
my(%opt) = @_;
$opt{$att} ||= [ map '', @{ $opt{'fields'} } ];
}
- splice @{ $opt{'header'} }, $pos, 0, 'Agent';
- splice @{ $opt{'align'} }, $pos, 0, 'c';
- splice @{ $opt{'style'} }, $pos, 0, '';
- splice @{ $opt{'size'} }, $pos, 0, '';
+ splice @{ $opt{'header'} }, $pos, 0, 'Agent';
+ splice @{ $opt{'align'} }, $pos, 0, 'c';
+ splice @{ $opt{'style'} }, $pos, 0, '';
+ splice @{ $opt{'size'} }, $pos, 0, '';
splice @{ $opt{'fields'} }, $pos, 0,
sub { $_[0]->agentnum ? $_[0]->agent->agent : '(global)'; };
splice @{ $opt{'color'} }, $pos, 0, '';
my $table = $query->{'table'};
- $count_query .=
+ $count_query .=
( $count_query =~ /\bWHERE\b/i ? ' AND ' : ' WHERE ' ).
"( $table.disabled = '' OR $table.disabled IS NULL )";
$opt{$att} ||= [ map '', @{ $opt{'fields'} } ];
}
- splice @{ $opt{'header'} }, $pos, 0, 'Status';
- splice @{ $opt{'align'} }, $pos, 0, 'c';
- splice @{ $opt{'style'} }, $pos, 0, 'b';
- splice @{ $opt{'size'} }, $pos, 0, '';
+ splice @{ $opt{'header'} }, $pos, 0, 'Status';
+ splice @{ $opt{'align'} }, $pos, 0, 'c';
+ splice @{ $opt{'style'} }, $pos, 0, 'b';
+ splice @{ $opt{'size'} }, $pos, 0, '';
splice @{ $opt{'fields'} }, $pos, 0,
sub { shift->disabled ? 'DISABLED' : 'Active'; };
splice @{ $opt{'color'} }, $pos, 0,
],
#'order_by' => $opt{order_by}. " ". $limit,
)
- ];
+ ];
} else { # not ref $query; plain SQL (still used as of 07/2015)
projects / freeside.git / commitdiff