[svn:p5ee] r15609 - p5ee/trunk/App-Repository/lib/App

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