cvsuser 05/10/12 06:56:17
Modified: App-Repository/lib/App Repository.pm
Log:
table redirection, more flexible sorting, beginnings of expression evaluation
Revision Changes Path
1.23 +248 -28 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.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- Repository.pm 10 Aug 2005 18:32:39 -0000 1.22
+++ Repository.pm 12 Oct 2005 13:56:14 -0000 1.23
@@ -13,6 +13,7 @@
use Date::Format;
use App::RepositoryObject;
+use App::Reference;
=head1 NAME
@@ -782,9 +783,13 @@
my ($self, $table, $params, $cols, $options) = @_;
my ($rows);
my $repname = $self->{table}{$table}{repository};
+ my $realtable = $self->{table}{$table}{table} || $table;
if (defined $repname && $repname ne $self->{name}) {
my $rep = $self->{context}->repository($repname);
- $rows = $rep->get_rows($table, $params, $cols, $options);
+ $rows = $rep->get_rows($realtable, $params, $cols, $options);
+ }
+ elsif (defined $realtable && $realtable ne $table) {
+ $rows = $self->get_rows($realtable, $params, $cols, $options);
}
else {
$self->_load_table_metadata($table) if (! defined
$self->{table}{$table}{loaded});
@@ -832,8 +837,20 @@
sub set_rows {
&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);
+ my ($nrows);
+ my $repname = $self->{table}{$table}{repository};
+ my $realtable = $self->{table}{$table}{table} || $table;
+ if (defined $repname && $repname ne $self->{name}) {
+ my $rep = $self->{context}->repository($repname);
+ $nrows = $rep->set_rows($realtable, $params, $cols, $rows, $options);
+ }
+ elsif (defined $realtable && $realtable ne $table) {
+ $nrows = $self->set_rows($realtable, $params, $cols, $rows,
$options);
+ }
+ else {
+ $self->_load_table_metadata($table) if (! defined
$self->{table}{$table}{loaded});
+ $nrows = $self->_set_rows($table, $params, $cols, $rows, $options);
+ }
&App::sub_exit($nrows) if ($App::trace);
return($nrows);
}
@@ -2558,50 +2575,195 @@
=head2 sort()
- * Signature: $sorted_rows = $rep->sort($rows, $sortcolidx);
- * Signature: $sorted_rows = $rep->sort($rows, $sortcolidx, $sorttype);
- * Signature: $sorted_rows = $rep->sort($rows, $sortcolidx, $sorttype,
$sortdir);
+ * Signature: $sorted_rows = $rep->sort($rows, $sortkeys);
+ * Signature: $sorted_rows = $rep->sort($rows, $sortkeys, $sorttype);
+ * Signature: $sorted_rows = $rep->sort($rows, $sortkeys, $sorttype,
$sortdir);
* Param: $rows [][]
- * Param: $sortcolidx []
+ * Param: $sortkeys []
* Param: $sorttype []
* Param: $sortdir []
* Return: $sorted_rows []
* Throws: App::Exception::Repository
* Since: 0.01
- Sample Usage:
-
- @rows = (
- [ 5, "Jim", "Green", 13.5, 320, ],
- [ 3, "Bob", "Green", 4.2, 230, ],
- [ 9, "Ken", "Green", 27.4, 170, ],
- [ 2, "Kim", "Blue", 11.7, 440, ],
- [ 7, "Jan", "Blue", 55.1, 90, ],
- [ 1, "Ben", "Blue", 22.6, 195, ],
- );
- # @columns = ( "id", "name", "team", "rating", "score" ); # not needed
- @sortcolidx = ( 2, 4 ); # "team", "score" (descending)
- @sorttype = ( "C", "N" ); # Character, Numeric
- @sortdir = ( "UP", "DOWN" );
+ Sample Usage: (to sort arrayrefs)
- $sorted_rows = $rep->sort([EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL
PROTECTED], [EMAIL PROTECTED]);
+ @rows = (
+ [ 5, "Jim", "Green", 13.5, 320, ],
+ [ 3, "Bob", "Green", 4.2, 230, ],
+ [ 9, "Ken", "Green", 27.4, 170, ],
+ [ 2, "Kim", "Blue", 11.7, 440, ],
+ [ 7, "Jan", "Blue", 55.1, 90, ],
+ [ 1, "Ben", "Blue", 22.6, 195, ],
+ );
+ # @columns = ( "id", "name", "team", "rating", "score" ); # not needed
+ @sortkeys = ( 2, 4 ); # "team", "score" (descending)
+ @sorttype = ( "C", "N" ); # Character, Numeric
+ @sortdir = ( "asc", "desc" ); # Ascending, Descending
+ $sorted_rows = $rep->sort([EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL
PROTECTED], [EMAIL PROTECTED]);
+
+ OR (to sort hashrefs)
+
+ @rows = (
+ { id => 5, name => "Jim", team => "Green", rating => 13.5, score
=> 320, },
+ { id => 3, name => "Bob", team => "Green", rating => 4.2, score
=> 230, },
+ { id => 9, name => "Ken", team => "Green", rating => 27.4, score
=> 170, },
+ { id => 2, name => "Kim", team => "Blue", rating => 11.7, score
=> 440, },
+ { id => 7, name => "Jan", team => "Blue", rating => 55.1, score
=> 90, },
+ { id => 1, name => "Ben", team => "Blue", rating => 22.6, score
=> 195, },
+ );
+ # @columns = ( "id", "name", "team", "rating", "score" ); # not needed
+ @sortkeys = ( "team", "score" ); # "team", "score"
(descending)
+ @sorttype = ( "C", "N" ); # Character, Numeric
+ @sortdir = ( "asc", "desc" ); # Ascending, Descending
+ $sorted_rows = $rep->sort([EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL
PROTECTED], [EMAIL PROTECTED]);
=cut
sub sort {
&App::sub_entry if ($App::trace);
- my ($self, $rows, $sortcolidx, $sorttype, $sortdir) = @_;
+ my ($self, $rows, $sortkeys, $sorttype, $sortdir) = @_;
- @App::Repository::sort_keys = @$sortcolidx;
+ @App::Repository::sort_keys = @$sortkeys;
@App::Repository::sort_types = ($sorttype ? @$sorttype : ());
@App::Repository::sort_dirs = ($sortdir ? @$sortdir : ());
- my $sorted_rows = [ sort rows_by_indexed_values @$rows ];
+ my ($sorted_rows);
+ if ($rows && ref($rows) eq "ARRAY" && $#$rows > 0) {
+ if (ref($rows->[0]) eq "ARRAY") {
+ $sorted_rows = [ sort rows_by_indexed_values @$rows ];
+ }
+ else {
+ $sorted_rows = [ sort hashes_by_indexed_values @$rows ];
+ }
+ }
+ else {
+ $sorted_rows = $rows;
+ }
&App::sub_exit($sorted_rows) if ($App::trace);
return($sorted_rows);
}
#############################################################################
+# evaluate_expressions()
+#############################################################################
+
+=head2 evaluate_expressions()
+
+ * Signature: $nrows = $rep->evaluate_expressions($table, $params, $cols,
$rows, $options);
+ * Param: $table string
+ * Param: $params HASH,scalar
+ * Param: $cols ARRAY
+ * Param: $rows ARRAY
+ * Param: $options undef,HASH
+ * Return: $nrows integer
+ * Throws: App::Exception::Repository
+ * Since: 0.50
+
+ Sample Usage:
+
+ $rep->evaluate_expressions($table, $params, [EMAIL PROTECTED], $rows,
\%options);
+
+tbd.
+
+=cut
+
+sub evaluate_expressions {
+ &App::sub_entry if ($App::trace);
+ my ($self, $table, $params, $cols, $rows, $options) = @_;
+ $options ||= {};
+ my %options = %$options;
+ my $column_defs = $self->{table}{$table}{column};
+ my (@expr_col_idx, @expr_col, $col, %colidx);
+
+ for (my $i = 0; $i <= $#$cols; $i++) {
+ $col = $cols->[$i];
+ $colidx{$col} = $i;
+ if ($column_defs->{$col}{expr}) {
+ push(@expr_col, $col);
+ push(@expr_col_idx, $i);
+ }
+ }
+
+ if ($#expr_col > -1) {
+ foreach my $row (@$rows) {
+ for (my $i = 0; $i <= $#expr_col; $i++) {
+ $col = $expr_col[$i];
+ $row->[$expr_col_idx[$i]] =
$self->evaluate_expression($column_defs->{$col}{expr}, $row, \%colidx,
$column_defs);
+ }
+ }
+ }
+
+ &App::sub_exit() if ($App::trace);
+}
+
+sub evaluate_expression {
+ &App::sub_entry if ($App::trace);
+ my ($self, $expr, $values, $validx, $column_defs) = @_;
+
+ my $value = $expr;
+ if ($values) {
+ my ($col, $val, $idx);
+ if (ref($values) eq "ARRAY") {
+ while ($value =~ /\{([^{}]+)\}/) {
+ $col = $1;
+ $idx = $validx->{$col};
+ if (defined $idx) {
+ $val = $values->[$idx];
+ $val = $column_defs->{$col}{expr} if (!defined $val);
+ $val = $column_defs->{$col}{default} if (!defined $val);
+ $val = "undef" if (!defined $val);
+ $val = "($val)" if ($val =~ /[-\+\*\/]/);
+ }
+ else {
+ $val = "undef";
+ }
+ $value =~ s/\{$col\}/$val/g || last;
+ }
+ }
+ else {
+ while ($value =~ /\{([^{}]+)\}/) {
+ $col = $1;
+ $val = $values->{$col};
+ $val = App::Reference->get($col, $values) if (!defined $val
&& $col =~ /[\[\]\{\}\.]/);
+ $val = $column_defs->{$col}{expr} if (!defined $val);
+ $val = $column_defs->{$col}{default} if (!defined $val);
+ $val = "undef" if (!defined $val);
+ $val = "($val)" if ($val =~ /[-\+\*\/]/);
+ $value =~ s/\{$col\}/$val/g || last;
+ }
+ }
+ }
+ $value = $self->evaluate_constant_expression($value);
+
+ &App::sub_exit($value) if ($App::trace);
+ return($value);
+}
+
+sub evaluate_constant_expression {
+ &App::sub_entry if ($App::trace);
+ my ($self, $value) = @_;
+ my $NUM = "-?[0-9.]+";
+
+ while ($value =~ /\([^()]*\)/) {
+ $value =~ s/\(([^()]+)\)/$self->evaluate_constant_expression($1)/eg;
+ }
+ if ($value =~ m!^[-\+\*/0-9\.\s]+$!) { # all numeric expression
+ $value =~ s/\s+//g;
+ }
+ while ($value =~ s!($NUM)\s*([\*/])\s*($NUM)!($2 eq "*") ? ($1 * $3) :
($3 ? ($1 / $3) : "undef")!e) {
+ # nothing else needed
+ }
+ while ($value =~ s!($NUM)\s*([\+-])\s*($NUM)!($2 eq "+") ? ($1 + $3) :
($1 - $3)!e) {
+ # nothing else needed
+ }
+ $value = undef if ($value =~ /undef/);
+
+ &App::sub_exit($value) if ($App::trace);
+ return($value);
+}
+
+#############################################################################
# serial()
#############################################################################
@@ -3080,7 +3242,9 @@
@App::Repository::sort_keys = ( 1, 3, 2 );
@App::Repository::sort_types = ("C", "N", "C");
- @App::Repository::sort_dirs = ("UP", "DOWN", "DOWN");
+ @App::Repository::sort_dirs = ("asc", "desc", "desc");
+ # OR @App::Repository::sort_dirs = ("_asc", "_desc", "_desc");
+ # OR @App::Repository::sort_dirs = ("UP", "DOWN", "DOWN");
@sorted_data = sort rows_by_indexed_values @data;
@@ -3102,7 +3266,63 @@
$sign = ($a->[$idx] cmp $b->[$idx]);
}
if ($sign) {
- $sign = -$sign if (defined $dir && $dir =~ /^[Dd]/); # ("DOWN",
"desc", etc.)
+ $sign = -$sign if (defined $dir && $dir =~ /^_?[Dd]/); #
("DOWN", "desc", "_desc", etc.)
+ return ($sign);
+ }
+ }
+ return 0;
+}
+
+#############################################################################
+# hashes_by_indexed_values()
+#############################################################################
+
+=head2 hashes_by_indexed_values()
+
+ * Signature: &App::Repository::hashes_by_indexed_values($a,$b);
+ * Param: $a []
+ * Param: $b []
+ * Return: void
+ * Throws: App::Exception::Repository
+ * Since: 0.01
+
+ Sample Usage:
+
+ @data = (
+ { size => 5, name => "Jim", color => "Red", score => 13.5, ],
+ { size => 3, name => "Bob", color => "Green", score => 4.2, ],
+ { size => 9, name => "Ken", color => "Blue", score => 27.4, ],
+ { size => 2, name => "Kim", color => "Yellow", score => 11.7, ],
+ { size => 7, name => "Jan", color => "Purple", score => 55.1, ],
+ );
+
+ @App::Repository::sort_keys = ( "size", "color", "name" );
+ @App::Repository::sort_types = ("C", "N", "C");
+ @App::Repository::sort_dirs = ("asc", "desc", "desc");
+ # OR @App::Repository::sort_dirs = ("_asc", "_desc", "_desc");
+ # OR @App::Repository::sort_dirs = ("UP", "DOWN", "DOWN");
+
+ @sorted_data = sort hashes_by_indexed_values @data;
+
+The hashes_by_indexed_values() function is used to sort rows of data
+based on indexes, data types, and directions.
+
+=cut
+
+sub hashes_by_indexed_values {
+ my ($pos, $key, $type, $dir, $sign);
+ for ($pos = 0; $pos <= $#App::Repository::sort_keys; $pos++) {
+ $key = $App::Repository::sort_keys[$pos];
+ $type = $App::Repository::sort_types[$pos];
+ $dir = $App::Repository::sort_dirs[$pos];
+ if (defined $type && $type eq "N") {
+ $sign = ($a->{$key} <=> $b->{$key});
+ }
+ else {
+ $sign = ($a->{$key} cmp $b->{$key});
+ }
+ if ($sign) {
+ $sign = -$sign if (defined $dir && $dir =~ /^_?[Dd]/); #
("DOWN", "desc", "_desc", etc.)
return ($sign);
}
}
