cvs commit: p5ee/App-Repository/lib/App Repository.pm
[email protected] (Stephen Adkins)
| Newsgroups | perl.cvs.p5ee |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/03/11 19:10:39
Modified: App-Repository/lib/App Repository.pm
Log:
default Repository now has _get_row() calling _get_rows()
Revision Changes Path
1.10 +85 -77 p5ee/App-Repository/lib/App/Repository.pm
Index: Repository.pm
===================================================================
RCS file: /cvs/public/p5ee/App-Repository/lib/App/Repository.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- Repository.pm 3 Dec 2003 16:23:31 -0000 1.9
+++ Repository.pm 12 Mar 2004 03:10:39 -0000 1.10
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: Repository.pm,v 1.9 2003/12/03 16:23:31 spadkins Exp $
+## $Id: Repository.pm,v 1.10 2004/03/12 03:10:39 spadkins Exp $
#############################################################################
package App::Repository;
@@ -420,10 +420,10 @@
=cut
sub error {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self) = @_;
my $error = $self->{error} || "";
- &App::sub_exit($error) if ($App::trace_subs);
+ &App::sub_exit($error) if ($App::trace);
return $error;
}
@@ -490,17 +490,17 @@
=cut
sub get {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
my ($row);
if (ref($cols) eq "ARRAY") {
$row = $self->get_row($table, $params, $cols, $options);
- &App::sub_exit(@$row) if ($App::trace_subs);
+ &App::sub_exit(@$row) if ($App::trace);
return(@$row);
}
else {
$row = $self->get_row($table, $params, [$cols], $options);
- &App::sub_exit($row->[0]) if ($App::trace_subs);
+ &App::sub_exit($row->[0]) if ($App::trace);
return($row->[0]);
}
}
@@ -533,7 +533,7 @@
=cut
sub set {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $col, $value, $options) = @_;
$self->_load_table_metadata($table) if (! defined $self->{table}{$table}{loaded});
my ($nrows);
@@ -543,7 +543,7 @@
else {
$nrows = $self->set_row($table, $params, $col, $value, $options);
}
- &App::sub_exit($nrows) if ($App::trace_subs);
+ &App::sub_exit($nrows) if ($App::trace);
return($nrows);
}
@@ -574,7 +574,7 @@
=cut
sub get_row {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
my ($row, $repname, $rep);
@@ -598,7 +598,7 @@
}
$row = $self->_get_row($table, $params, $cols, $options);
}
- &App::sub_exit($row) if ($App::trace_subs);
+ &App::sub_exit($row) if ($App::trace);
return($row);
}
@@ -631,11 +631,11 @@
=cut
sub set_row {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $row, $options) = @_;
$self->_load_table_metadata($table) if (! defined $self->{table}{$table}{loaded});
my $nrows = $self->_set_row($table, $params, $cols, $row, $options);
- &App::sub_exit($nrows) if ($App::trace_subs);
+ &App::sub_exit($nrows) if ($App::trace);
return($nrows);
}
@@ -663,7 +663,7 @@
=cut
sub get_column {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $col, $options) = @_;
my (@colvalues, $rows, $row);
@colvalues = ();
@@ -671,7 +671,7 @@
foreach $row (@$rows) {
push(@colvalues, $row->[0]) if ($row && $#$row >= 0);
}
- &App::sub_exit(\@colvalues) if ($App::trace_subs);
+ &App::sub_exit(\@colvalues) if ($App::trace);
return(\@colvalues);
}
@@ -703,7 +703,7 @@
=cut
sub get_rows {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
my ($rows, $repname, $rep);
if (defined $self->{table}{$table}{repository}) {
@@ -726,7 +726,7 @@
}
$rows = $self->_get_rows($table, $params, $cols, $options);
}
- &App::sub_exit($rows) if ($App::trace_subs);
+ &App::sub_exit($rows) if ($App::trace);
return($rows);
}
@@ -757,11 +757,11 @@
=cut
sub set_rows {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $rows, $options) = @_;
$self->_load_table_metadata($table) if (! defined $self->{table}{$table}{loaded});
my $nrows = $self->_set_rows($table, $params, $cols, $rows, $options);
- &App::sub_exit($nrows) if ($App::trace_subs);
+ &App::sub_exit($nrows) if ($App::trace);
return($nrows);
}
@@ -794,7 +794,7 @@
=cut
sub get_hash {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
$cols = [] if (!$cols);
my $row = $self->get_row($table, $params, $cols, $options);
@@ -807,7 +807,7 @@
$hash->{$col} = $value;
}
}
- &App::sub_exit($hash) if ($App::trace_subs);
+ &App::sub_exit($hash) if ($App::trace);
return($hash);
}
@@ -840,7 +840,7 @@
=cut
sub get_hashes {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
$cols = [] if (!$cols);
my $rows = $self->get_rows($table, $params, $cols, $options);
@@ -857,7 +857,7 @@
push(@$hashes, $hash);
}
}
- &App::sub_exit($hashes) if ($App::trace_subs);
+ &App::sub_exit($hashes) if ($App::trace);
return($hashes);
}
@@ -892,14 +892,14 @@
=cut
sub set_hash {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $values, $options) = @_;
$self->_load_table_metadata($table) if (! defined $self->{table}{$table}{loaded});
- &App::sub_exit() if ($App::trace_subs);
+ &App::sub_exit() if ($App::trace);
}
sub _params_to_hashref {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params) = @_;
if (!defined $params || $params eq "") {
@@ -909,12 +909,12 @@
$params = $self->_key_to_params($table,$params); # $params is undef/scalar => $key
}
- &App::sub_exit($params) if ($App::trace_subs);
+ &App::sub_exit($params) if ($App::trace);
return($params);
}
sub _row_matches {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $row, $table, $params, $cols, $options) = @_;
$options = {} if (!$options);
@@ -1035,12 +1035,12 @@
}
}
- &App::sub_exit($all_params_match) if ($App::trace_subs);
+ &App::sub_exit($all_params_match) if ($App::trace);
return($all_params_match);
}
sub _row_columns {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $row, $cols) = @_;
my ($idx, $native_idx, $column, @newrow);
@@ -1052,41 +1052,29 @@
$newrow[$idx] = (defined $native_idx) ? $row->[$native_idx] : undef;
}
- &App::sub_exit(\@newrow) if ($App::trace_subs);
+ &App::sub_exit(\@newrow) if ($App::trace);
return(\@newrow);
}
sub _get_row {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
- my $all_columns = (!defined $cols);
- $cols = $self->{table}{$table}{columns} if ($all_columns);
- $params = $self->_params_to_hashref($table, $params) if (ref($params) ne "HASH");
- # we only need the first row
if (!$options) {
- $options = { endrow => 1 };
+ $options = { startrow => 1, endrow => 1 };
}
elsif (! defined $options->{endrow}) {
+ $options = { %$options };
$options->{endrow} = $options->{startrow} || 1;
}
-
- my ($rows, $row, $matched_row);
- $rows = $self->{table}{$table}{data}; # get data from configuration only (no external source)
- if ($rows && ref($rows) eq "ARRAY") {
- foreach $row (@$rows) {
- if ($self->_row_matches($row, $table, $params, $cols, $options)) {
- $matched_row = $all_columns ? $row : $self->_row_columns($table, $row, $cols);
- last;
- }
- }
- }
-
- &App::sub_exit($matched_row) if ($App::trace_subs);
- return($matched_row);
+ my $rows = $self->_get_rows($table, $params, $cols, $options);
+ my ($row);
+ $row = $rows->[0] if ($#$rows > -1);
+ &App::sub_exit($row) if ($App::trace);
+ return($row);
}
sub _get_rows {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
my $all_columns = (!defined $cols);
$cols = $self->{table}{$table}{columns} if ($all_columns);
@@ -1095,23 +1083,26 @@
my $startrow = $options->{startrow} || 0;
my $endrow = $options->{endrow} || 0;
- my ($rows, $row, $matched_rows);
+ my ($rows, $row, $matched_rows, $rownum);
$rows = $self->{table}{$table}{data};
$matched_rows = [];
if ($rows && ref($rows) eq "ARRAY") {
- foreach $row (@$rows) {
+ for ($rownum = 0; $rownum <= $#$rows; $rownum++) {
+ next if ($startrow && $rownum < $startrow-1);
+ last if ($endrow && $rownum >= $endrow);
+ $row = $rows->[$rownum];
if ($self->_row_matches($row, $table, $params, $cols, $options)) {
push(@$matched_rows, $all_columns ? $row : $self->_row_columns($table, $row, $cols));
}
}
}
- &App::sub_exit($matched_rows) if ($App::trace_subs);
+ &App::sub_exit($matched_rows) if ($App::trace);
return($matched_rows);
}
sub _set_rows {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $rows, $options) = @_;
$params = $self->_params_to_hashref($table, $params) if (ref($params) ne "HASH");
@@ -1145,41 +1136,41 @@
else { # i.e. "HASH"
# $curr_rows = $self->_get_rows($table, $params, $cols, $options);
}
- &App::sub_exit($nrows) if ($App::trace_subs);
+ &App::sub_exit($nrows) if ($App::trace);
return($nrows);
}
sub _set_row {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $row, $options) = @_;
$params = $self->_params_to_hashref($table, $params) if (ref($params) ne "HASH");
my $nrows = $self->_update($table, $params, $cols, $row, $options);
- &App::sub_exit($nrows) if ($App::trace_subs);
+ &App::sub_exit($nrows) if ($App::trace);
return($nrows);
}
sub _key_to_values {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $key) = @_;
# TODO: eventually, I should handle escaping of "," and nonprintable data
my @values = split(/,/, $key);
- &App::sub_exit(@values) if ($App::trace_subs);
+ &App::sub_exit(@values) if ($App::trace);
return(@values);
}
sub _values_to_key {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, @values) = @_;
# TODO: eventually, I should handle unescaping of "," and nonprintable data
my $retval = join(",",@values);
- &App::sub_exit($retval) if ($App::trace_subs);
+ &App::sub_exit($retval) if ($App::trace);
return($retval);
}
sub _key_to_params {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $key) = @_;
my %params = ();
my $primary_key = $self->{table}{$table}{primary_key};
@@ -1206,27 +1197,27 @@
else {
$params{$primary_key} = $key;
}
- &App::sub_exit(\%params) if ($App::trace_subs);
+ &App::sub_exit(\%params) if ($App::trace);
return(\%params);
}
sub delete {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $row, $options) = @_;
my $retval = $self->_delete($table,$params,$cols,$row,$options);
- &App::sub_exit($retval) if ($App::trace_subs);
+ &App::sub_exit($retval) if ($App::trace);
return($retval);
}
sub _delete {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $row, $options) = @_;
$self->{error} = "";
my $retval = 0;
die "_delete(): not yet implemented";
- &App::sub_exit($retval) if ($App::trace_subs);
+ &App::sub_exit($retval) if ($App::trace);
return($retval);
}
@@ -1236,7 +1227,7 @@
# $nrows = $rep->_update($table, $key, \@cols, \@row, \%options);
# $nrows = $rep->_update($table, undef, \@cols, \@row, \%options);
sub _update {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $row, $options) = @_;
$self->{error} = "";
@@ -1257,7 +1248,7 @@
}
$retval = $#$rows + 1;
- &App::sub_exit($retval) if ($App::trace_subs);
+ &App::sub_exit($retval) if ($App::trace);
return($retval);
}
@@ -1760,6 +1751,7 @@
=cut
sub object {
+ &App::sub_entry if ($App::trace);
my ($self, $table, $key) = @_;
my $class = $self->{table}{$table}{object_class} || "App::RepositoryObject";
if (! $self->{used}{$class}) {
@@ -1773,6 +1765,7 @@
key => $key,
};
bless $object, $class;
+ &App::sub_exit($object) if ($App::trace);
return $object;
}
@@ -1786,7 +1779,7 @@
# this is a write lock for the table
sub _lock_table {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table) = @_;
if (! $self->{locked}) { # I have locked it myself, so I don't need to again
my ($name, $dbname, $context, $rlock);
@@ -1797,12 +1790,12 @@
$rlock->lock("db.$dbname.$table");
$self->{locked} = 1;
}
- &App::sub_exit() if ($App::trace_subs);
+ &App::sub_exit() if ($App::trace);
}
# unlocks the write lock for the table
sub _unlock_table {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $table) = @_;
if ($self->{locked}) {
my ($name, $dbname, $context, $rlock);
@@ -1813,7 +1806,7 @@
$rlock->unlock("db.$dbname.$table");
delete $self->{locked};
}
- &App::sub_exit() if ($App::trace_subs);
+ &App::sub_exit() if ($App::trace);
}
#############################################################################
@@ -1860,6 +1853,7 @@
=cut
sub summarize {
+ &App::sub_entry if ($App::trace);
my ($self, $rows, $columns, $summcolidx, $formulas) = @_;
my (@summary_rows, $summary_row, $create_summary);
@@ -1931,6 +1925,7 @@
push (@summary_rows, $summary_row);
}
}
+ &App::sub_exit(\@summary_rows) if ($App::trace);
\@summary_rows;
}
@@ -1971,13 +1966,16 @@
=cut
sub sort {
+ &App::sub_entry if ($App::trace);
my ($self, $rows, $sortcolidx, $sorttype, $sortdir) = @_;
@App::Repository::sort_keys = @$sortcolidx;
@App::Repository::sort_types = ($sorttype ? @$sorttype : ());
@App::Repository::sort_dirs = ($sortdir ? @$sortdir : ());
- return [ sort rows_by_indexed_values @$rows ];
+ my $sorted_rows = [ sort rows_by_indexed_values @$rows ];
+ &App::sub_exit($sorted_rows) if ($App::trace);
+ return($sorted_rows);
}
#############################################################################
@@ -2000,14 +1998,18 @@
my %serial_number;
sub serial {
+ &App::sub_entry if ($App::trace);
my ($self, $category) = @_;
+ my ($serial);
if (!defined $serial_number{$category}) {
$serial_number{$category} = 1;
- return 1;
+ $serial = 1;
}
else {
- return ++$serial_number{$category};
+ $serial = ++$serial_number{$category};
}
+ &App::sub_exit($serial) if ($App::trace);
+ return($serial);
}
#############################################################################
@@ -2045,6 +2047,7 @@
=cut
sub _load_rep_metadata {
+ &App::sub_entry if ($App::trace);
my ($self) = @_;
my ($table, $tables, $table_defs, $table_def, $native_table, $idx, $label, @label);
@@ -2134,6 +2137,7 @@
$type = $types->[$idx];
$self->{type}{$type}{idx} = $idx;
}
+ &App::sub_exit() if ($App::trace);
}
#############################################################################
@@ -2200,6 +2204,7 @@
=cut
sub _load_table_metadata {
+ &App::sub_exit() if ($App::trace);
my ($self, $table) = @_;
# if it's already been loaded, don't do it again
@@ -2262,6 +2267,7 @@
$table_def->{column_labels}{$column} = $column_def->{label};
}
+ &App::sub_entry if ($App::trace);
}
#############################################################################
@@ -2329,6 +2335,7 @@
=cut
sub _init {
+ &App::sub_entry if ($App::trace);
my ($self) = @_;
$self->{numrows} = 0;
@@ -2346,6 +2353,7 @@
}
$self->_load_rep_metadata();
+ &App::sub_exit() if ($App::trace);
}
#############################################################################