Front page | perl.cvs.p5ee |
Postings from April 2013
[svn:p5ee] r15609 - p5ee/trunk/App-Repository/lib/App
From:
spadkins
Date:
April 1, 2013 21:46
Subject:
[svn:p5ee] r15609 - p5ee/trunk/App-Repository/lib/App
Message ID:
20130401214647.01856184BB6@xx12.develooper.com
Author: spadkins
Date: Mon Apr 1 14:46:46 2013
New Revision: 15609
Modified:
p5ee/trunk/App-Repository/lib/App/Repository.pm
Log:
added get_array() and get_unique_array()
Modified: p5ee/trunk/App-Repository/lib/App/Repository.pm
==============================================================================
--- p5ee/trunk/App-Repository/lib/App/Repository.pm (original)
+++ p5ee/trunk/App-Repository/lib/App/Repository.pm Mon Apr 1 14:46:46 2013
@@ -1724,6 +1724,294 @@
return($unique_index);
}
+# $self->get_array(\@rows, \@key_columns, \%options);
+# $self->get_array(\@rows, [0,3,2]);
+# $self->get_array(\@rows, [0,3,2], { keydata => [{ values => ["2012-01", "2012-02"] }, { values => ["3070", "4195"] }], data => 4 });
+# $self->get_array(\@hashrows, ["month","product","store"]);
+# $self->get_array(\@hashrows, ["month","product","store"], { keydata => { month => { values => ["2012-01", "2012-02"] } }, data => "sales" });
+sub get_array {
+ &App::sub_entry if ($App::trace);
+ my ($self, $rows, $key_columns, $options) = @_;
+
+ my ($subarray, $c, $column, $v, $value, $keydata, $array_column, $key_value_idx, $key_values);
+ my $array = [];
+ my $is_array_of_arrays = ($#$rows > -1 && ref($rows->[0]) eq "ARRAY") ? 1 : 0;
+
+ if ($is_array_of_arrays) {
+
+ $keydata = $options->{keydata} || [];
+ $array_column = $options->{data};
+
+ for (my $k = 0; $k <= $#$key_columns; $k++) {
+ $keydata->[$k]{key_value_idx} = {} if (! defined $keydata->[$k]{key_value_idx});
+ $keydata->[$k]{key_values} = [] if (! defined $keydata->[$k]{key_values});
+ $key_value_idx = $keydata->[$k]{key_value_idx};
+ $key_values = $keydata->[$k]{key_values};
+
+ for (my $v = 0; $v <= $#$key_values; $v++) {
+ $value = $key_values->[$v];
+ if (! defined $key_value_idx->{$value}) {
+ $key_value_idx->{$value} = $v;
+ }
+ elsif ($key_value_idx->{$value} != $v) {
+ die "get_array(): keydata is inconsistent for key $k. value [$value] is index [$v] in the list but [$key_value_idx->{$value}] in the lookup";
+ }
+ }
+
+ foreach $value (keys %$key_value_idx) {
+ $v = $key_value_idx->{$value};
+ if (! defined $key_values->[$v]) {
+ $key_values->[$v] = $value;
+ }
+ elsif ($key_values->[$v] ne $value) {
+ die "get_array(): keydata is inconsistent for key $k. value [$value] is index [$v] in the lookup but that index has value [$key_values->[$v]] in the list";
+ }
+ }
+ }
+
+ foreach my $row (@$rows) {
+ $subarray = $array;
+ for (my $c = 0; $c <= $#$key_columns; $c++) {
+ $column = $key_columns->[$c];
+ $key_value_idx = $keydata->[$c]{key_value_idx};
+ $value = $row->[$column];
+ $v = $key_value_idx->{$value};
+ if (!defined $v) {
+ $key_values = $keydata->[$c]{key_values};
+ push(@$key_values, $value);
+ $v = $#$key_values;
+ $key_value_idx->{$value} = $v;
+ }
+ if ($c < $#$key_columns) {
+ $subarray->[$v] = [] if (! defined $subarray->[$v]);
+ $subarray = $subarray->[$v];
+ }
+ else {
+ $subarray->[$v] = [] if (! defined $subarray->[$v]);
+ push(@{$subarray->[$v]}, (defined $array_column) ? $row->[$array_column] : $row);
+ }
+ }
+ }
+ }
+ else {
+
+ $keydata = $options->{keydata} || {};
+ $array_column = $options->{data};
+
+ for (my $k = 0; $k <= $#$key_columns; $k++) {
+ $column = $key_columns->[$k];
+ $keydata->{$column}{key_value_idx} = {} if (! defined $keydata->{$column}{key_value_idx});
+ $keydata->{$column}{key_values} = [] if (! defined $keydata->{$column}{key_values});
+ $key_value_idx = $keydata->{$column}{key_value_idx};
+ $key_values = $keydata->{$column}{key_values};
+
+ for (my $v = 0; $v <= $#$key_values; $v++) {
+ $value = $key_values->[$v];
+ if (! defined $key_value_idx->{$value}) {
+ $key_value_idx->{$value} = $v;
+ }
+ elsif ($key_value_idx->{$value} != $v) {
+ die "get_array(): keydata is inconsistent for key $k. value [$value] is index [$v] in the list but [$key_value_idx->{$value}] in the lookup";
+ }
+ }
+
+ foreach $value (keys %$key_value_idx) {
+ $v = $key_value_idx->{$value};
+ if (! defined $key_values->[$v]) {
+ $key_values->[$v] = $value;
+ }
+ elsif ($key_values->[$v] ne $value) {
+ die "get_array(): keydata is inconsistent for key $k. value [$value] is index [$v] in the lookup but that index has value [$key_values->[$v]] in the list";
+ }
+ }
+ }
+
+ foreach my $row (@$rows) {
+ $subarray = $array;
+ for (my $c = 0; $c <= $#$key_columns; $c++) {
+ $column = $key_columns->[$c];
+ $key_value_idx = $keydata->{$column}{key_value_idx};
+ $value = $row->{$column};
+ $v = $key_value_idx->{$value};
+ if (!defined $v) {
+ $key_values = $keydata->{$column}{key_values};
+ push(@$key_values, $value);
+ $v = $#$key_values;
+ $key_value_idx->{$value} = $v;
+ }
+ if ($c < $#$key_columns) {
+ $subarray->[$v] = [] if (! defined $subarray->[$v]);
+ $subarray = $subarray->[$v];
+ }
+ else {
+ $subarray->[$v] = [] if (! defined $subarray->[$v]);
+ push(@{$subarray->[$v]}, (defined $array_column) ? $row->{$array_column} : $row);
+ }
+ }
+ }
+ }
+
+ # Extend the final element to the full dimensions of the array
+ $subarray = $array;
+ for (my $c = 0; $c <= $#$key_columns; $c++) {
+ $column = $key_columns->[$c];
+ $key_values = $keydata->{$column}{key_values};
+ $v = $#$key_values;
+ if ($c < $#$key_columns) {
+ $subarray->[$v] = [] if (! defined $subarray->[$v]);
+ $subarray = $subarray->[$v];
+ }
+ else {
+ $subarray->[$v] = undef if (! defined $subarray->[$v]);
+ }
+ }
+ &App::sub_exit($array) if ($App::trace);
+ return($array);
+}
+
+# $self->get_unique_array(\@rows, \@key_columns, \%options);
+# $self->get_unique_array(\@rows, [0,3,2]);
+# $self->get_unique_array(\@rows, [0,3,2], { keydata => [{ values => ["2012-01", "2012-02"] }, { values => ["3070", "4195"] }], data => 4 });
+# $self->get_unique_array(\@hashrows, ["month","product","store"]);
+# $self->get_unique_array(\@hashrows, ["month","product","store"], { keydata => { month => { values => ["2012-01", "2012-02"] } }, data => "sales" });
+sub get_unique_array {
+ &App::sub_entry if ($App::trace);
+ my ($self, $rows, $key_columns, $options) = @_;
+
+ my ($subarray, $c, $column, $v, $value, $keydata, $array_column, $key_value_idx, $key_values);
+ my $array = [];
+ my $is_array_of_arrays = ($#$rows > -1 && ref($rows->[0]) eq "ARRAY") ? 1 : 0;
+
+ if ($is_array_of_arrays) {
+
+ $keydata = $options->{keydata} || [];
+ $array_column = $options->{data};
+
+ for (my $k = 0; $k <= $#$key_columns; $k++) {
+ $keydata->[$k]{key_value_idx} = {} if (! defined $keydata->[$k]{key_value_idx});
+ $keydata->[$k]{key_values} = [] if (! defined $keydata->[$k]{key_values});
+ $key_value_idx = $keydata->[$k]{key_value_idx};
+ $key_values = $keydata->[$k]{key_values};
+
+ for (my $v = 0; $v <= $#$key_values; $v++) {
+ $value = $key_values->[$v];
+ if (! defined $key_value_idx->{$value}) {
+ $key_value_idx->{$value} = $v;
+ }
+ elsif ($key_value_idx->{$value} != $v) {
+ die "get_array(): keydata is inconsistent for key $k. value [$value] is index [$v] in the list but [$key_value_idx->{$value}] in the lookup";
+ }
+ }
+
+ foreach $value (keys %$key_value_idx) {
+ $v = $key_value_idx->{$value};
+ if (! defined $key_values->[$v]) {
+ $key_values->[$v] = $value;
+ }
+ elsif ($key_values->[$v] ne $value) {
+ die "get_array(): keydata is inconsistent for key $k. value [$value] is index [$v] in the lookup but that index has value [$key_values->[$v]] in the list";
+ }
+ }
+ }
+
+ foreach my $row (@$rows) {
+ $subarray = $array;
+ for (my $c = 0; $c <= $#$key_columns; $c++) {
+ $column = $key_columns->[$c];
+ $key_value_idx = $keydata->[$c]{key_value_idx};
+ $value = $row->[$column];
+ $v = $key_value_idx->{$value};
+ if (!defined $v) {
+ $key_values = $keydata->[$c]{key_values};
+ push(@$key_values, $value);
+ $v = $#$key_values;
+ $key_value_idx->{$value} = $v;
+ }
+ if ($c < $#$key_columns) {
+ $subarray->[$v] = [] if (! defined $subarray->[$v]);
+ $subarray = $subarray->[$v];
+ }
+ else {
+ $subarray->[$v] = (defined $array_column) ? $row->[$array_column] : $row;
+ }
+ }
+ }
+ }
+ else {
+
+ $keydata = $options->{keydata} || {};
+ $array_column = $options->{data};
+
+ for (my $k = 0; $k <= $#$key_columns; $k++) {
+ $column = $key_columns->[$k];
+ $keydata->{$column}{key_value_idx} = {} if (! defined $keydata->{$column}{key_value_idx});
+ $keydata->{$column}{key_values} = [] if (! defined $keydata->{$column}{key_values});
+ $key_value_idx = $keydata->{$column}{key_value_idx};
+ $key_values = $keydata->{$column}{key_values};
+
+ for (my $v = 0; $v <= $#$key_values; $v++) {
+ $value = $key_values->[$v];
+ if (! defined $key_value_idx->{$value}) {
+ $key_value_idx->{$value} = $v;
+ }
+ elsif ($key_value_idx->{$value} != $v) {
+ die "get_array(): keydata is inconsistent for key $k. value [$value] is index [$v] in the list but [$key_value_idx->{$value}] in the lookup";
+ }
+ }
+
+ foreach $value (keys %$key_value_idx) {
+ $v = $key_value_idx->{$value};
+ if (! defined $key_values->[$v]) {
+ $key_values->[$v] = $value;
+ }
+ elsif ($key_values->[$v] ne $value) {
+ die "get_array(): keydata is inconsistent for key $k. value [$value] is index [$v] in the lookup but that index has value [$key_values->[$v]] in the list";
+ }
+ }
+ }
+
+ foreach my $row (@$rows) {
+ $subarray = $array;
+ for (my $c = 0; $c <= $#$key_columns; $c++) {
+ $column = $key_columns->[$c];
+ $key_value_idx = $keydata->{$column}{key_value_idx};
+ $value = $row->{$column};
+ $v = $key_value_idx->{$value};
+ if (!defined $v) {
+ $key_values = $keydata->{$column}{key_values};
+ push(@$key_values, $value);
+ $v = $#$key_values;
+ $key_value_idx->{$value} = $v;
+ }
+ if ($c < $#$key_columns) {
+ $subarray->[$v] = [] if (! defined $subarray->[$v]);
+ $subarray = $subarray->[$v];
+ }
+ else {
+ $subarray->[$v] = (defined $array_column) ? $row->{$array_column} : $row;
+ }
+ }
+ }
+ }
+
+ # Extend the final element to the full dimensions of the array
+ $subarray = $array;
+ for (my $c = 0; $c <= $#$key_columns; $c++) {
+ $column = $key_columns->[$c];
+ $key_values = $keydata->{$column}{key_values};
+ $v = $#$key_values;
+ if ($c < $#$key_columns) {
+ $subarray->[$v] = [] if (! defined $subarray->[$v]);
+ $subarray = $subarray->[$v];
+ }
+ else {
+ $subarray->[$v] = undef if (! defined $subarray->[$v]);
+ }
+ }
+ &App::sub_exit($array) if ($App::trace);
+ return($array);
+}
+
# $self->get_column_values(\@rows, $key_column, \%options);
sub get_column_values {
&App::sub_entry if ($App::trace);
-
[svn:p5ee] r15609 - p5ee/trunk/App-Repository/lib/App
by spadkins