cvsuser 03/06/27 11:39:37
Modified: App-Repository MANIFEST
App-Repository/lib/App Repository.pm
App-Repository/lib/App/Repository DBI.pm
Added: App-Repository/lib/App/Repository File.pm
Log:
Moved many methods out of App::Repository::DBI into App::Repository in preparation
for App::Repository::File
Revision Changes Path
1.7 +1 -2 p5ee/App-Repository/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/p5ee/App-Repository/MANIFEST,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- MANIFEST 18 Jun 2003 14:56:29 -0000 1.6
+++ MANIFEST 27 Jun 2003 18:39:36 -0000 1.7
@@ -4,10 +4,9 @@
CHANGES
MANIFEST
lib/App/Repository.pm
-lib/App/Repository/SOAP.pm
lib/App/Repository/DBI.pm
lib/App/Repository/MySQL.pm
-lib/App/Repository/Sample.pm
+lib/App/Repository/File.pm
lib/App/RepositoryObject.pm
lib/App/ValueDomain/Repository.pm
t/DBI-connect.t
1.6 +760 -129 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.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- Repository.pm 19 Jun 2003 17:18:04 -0000 1.5
+++ Repository.pm 27 Jun 2003 18:39:36 -0000 1.6
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: Repository.pm,v 1.5 2003/06/19 17:18:04 spadkins Exp $
+## $Id: Repository.pm,v 1.6 2003/06/27 18:39:36 spadkins Exp $
#############################################################################
package App::Repository;
@@ -48,13 +48,9 @@
# The following methods are needed for SQL support
###################################################################
- $ok = $rep->_connect(); # initialize repository (will happen
automatically in constructor)
- $ok = $rep->_disconnect(); # cleanup repository (will happen automatically
in destructor)
- $rep->_is_connected(); # returns 1 if connected (ready for use), 0 if
not
$errmsg = $rep->error(); # returns the error string for prev op ("" if no
error)
$numrows = $rep->numrows(); # returns the number of rows affected by prev op
- print $rep->error(), "\n" if (!$rep->_connect());
- print $rep->error(), "\n" if ($rep->_connect() != $rep->OK);
+ print $rep->error(), "\n";
# DATA TYPE HELPER METHODS
$repdate = $rep->format_repdate($date_string); # free-form date string as
entered by a person
@@ -76,113 +72,7 @@
# RELATIONAL
#################################################
- # DBI METHODS
- # @row_ary = $dbh->selectrow_array($statement, \%attr, @bind_values);
- # $ary_ref = $dbh->selectall_arrayref($statement, \%attr, @bind_values);
- # $ary_ref = $dbh->selectall_hashref($statement, \%attr, @bind_values);
- # $ary_ref = $dbh->selectcol_arrayref($statement, \%attr, @bind_values);
-
- # PRIVATE (INTERNALLY USED)
-
- %options = ([EMAIL PROTECTED], [EMAIL PROTECTED], $startrow, $endrow,
$forupdate,
- $readonly, [EMAIL PROTECTED], \%colidx, \%writeable)
-
- $row = $rep->_read_row ($table, [EMAIL PROTECTED],
\%paramvalues, \%options);
- $col $key
- $rows = $rep->_read_rows ($table, [EMAIL PROTECTED],
\%paramvalues, \%options);
- $col $key
- $rowhash = $rep->_read_hash ($table, [EMAIL PROTECTED],
\%paramvalues, \%options);
- $col $key
- $rowhashes = $rep->_read_hashes ($table, [EMAIL PROTECTED],
\%paramvalues, \%options);
- $col $key
- $value = $rep->_read_value ($table, $col, \%paramvalues,
\%options);
- $key
- @rowvalues = $rep->_read_rowvalues ($table, [EMAIL PROTECTED],
\%paramvalues, \%options);
- $col $key
- @colvalues = $rep->_read_colvalues ($table, $col, \%paramvalues,
\%options);
- $key
-
- $nrows = $rep->_create_row ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- \%rowhash
- $nrows = $rep->_create_rows ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- [EMAIL PROTECTED]
-
- $nrows = $rep->_update_row ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- $col, $value, $key
- \%rowhash
- $nrows = $rep->_update_rows ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- \%rowhashes
- $nrows = $rep->_update_rowvalues($table, [EMAIL PROTECTED],[EMAIL
PROTECTED],\%paramvalues);
- $col, $value, $key
- \%valuehash
-
- $nrows = $rep->_delete_row ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- $col, $value
- \%rowhash
- $key
- $nrows = $rep->_delete_rows ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- [EMAIL PROTECTED]
- $nrows = $rep->_delete_rows ($table, \%paramvalues);
-
- $nrows = $rep->_write_row ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- $col, $value, $key
- \%rowhash
- $nrows = $rep->_write_rows ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- \%rowhashes
- $nrows = $rep->_write_rowvalues ($table, [EMAIL PROTECTED],[EMAIL
PROTECTED],\%paramvalues);
- $col, $value, $key
- \%valuehash
-
- # PUBLIC
-
- %options = ([EMAIL PROTECTED], [EMAIL PROTECTED], $startrow, $endrow,
$forupdate,
- $readonly, [EMAIL PROTECTED], \%colidx, \%writeable)
-
- $row = $rep->read_row ($table, [EMAIL PROTECTED],
\%paramvalues, \%options);
- $col $key
- $rows = $rep->read_rows ($table, [EMAIL PROTECTED],
\%paramvalues, \%options);
- $col $key
- $rowhash = $rep->read_hash ($table, [EMAIL PROTECTED],
\%paramvalues, \%options);
- $col $key
- $rowhashes = $rep->read_hashes ($table, [EMAIL PROTECTED],
\%paramvalues, \%options);
- $col $key
- $value = $rep->read_value ($table, $col, \%paramvalues,
\%options);
- $key
- @rowvalues = $rep->read_rowvalues ($table, [EMAIL PROTECTED],
\%paramvalues, \%options);
- $col $key
- @colvalues = $rep->read_colvalues ($table, $col, \%paramvalues,
\%options);
- $key
-
- $nrows = $rep->create_row ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- \%rowhash
- $nrows = $rep->create_rows ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- [EMAIL PROTECTED]
-
- $nrows = $rep->update_row ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- $col, $value, $key
- \%rowhash
- $nrows = $rep->update_rows ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- \%rowhashes
- $nrows = $rep->update_rowvalues($table, [EMAIL PROTECTED],[EMAIL
PROTECTED],\%paramvalues);
- $col, $value, $key
- \%valuehash
-
- $nrows = $rep->delete_row ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- $col, $value
- \%rowhash
- $key
- $nrows = $rep->delete_rows ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- [EMAIL PROTECTED]
- $nrows = $rep->delete_rows ($table, \%paramvalues);
-
- $nrows = $rep->write_row ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- $col, $value, $key
- \%rowhash
- $nrows = $rep->write_rows ($table, [EMAIL PROTECTED], [EMAIL
PROTECTED]);
- \%rowhashes
- $nrows = $rep->write_rowvalues ($table, [EMAIL PROTECTED],[EMAIL
PROTECTED],\%paramvalues);
- $col, $value, $key
- \%valuehash
+ ... (see App::Repository::DBI) ...
$relation_names = $rep->get_relation_names($table);
$relation_labels = $rep->get_relation_labels($table);
@@ -207,15 +97,6 @@
# TECHNICAL
#################################################
- $rep->add_columns_fetched ($table, [EMAIL PROTECTED]);
- $rep->add_columns_fetched ($table, [EMAIL PROTECTED], [EMAIL PROTECTED]);
- $rep->set_row_hint ($table, \%paramvalues);
- $rep->clear_columns_fetched ($table);
- $rep->clear_row_hint ($table);
- @columns = $rep->get_required_columns($table);
-
- $rep->load_cache();
- $rep->clear_cache();
$rep->commit();
$rep->rollback();
@@ -223,7 +104,8 @@
=head1 DESCRIPTION
-A Repository is a means by which data may be stored somewhere without
+A Repository is a means by which data may be stored somewhere or
+retrieved from somewhere without
knowing what underlying technology is storing the data.
A Repository is the central persistence concept within the App.
@@ -250,7 +132,7 @@
abstraction, persistent objects (i.e. RepositoryObjects) can be built to
save and restore their state from a Repository. Furthermore, the
built-in support for non-scalar fields (references to arbitrarily
-complex perl data structures) and the ability for Entity Widgets
+complex perl data structures) and the ability for RepositoryObjects
to encapsulate more than one row of data, makes the technology quite
fit for object-oriented development.
@@ -503,6 +385,14 @@
sub _is_connected { 1; }
#############################################################################
+# PUBLIC METHODS
+#############################################################################
+
+=head1 Public Methods
+
+=cut
+
+#############################################################################
# error()
#############################################################################
@@ -530,7 +420,11 @@
=cut
sub error {
- return( $_[0]->{error} || "");
+ &App::sub_entry if ($App::trace_subs);
+ my ($self) = @_;
+ my $error = $self->{error} || "";
+ &App::sub_exit($error) if ($App::trace_subs);
+ return $error;
}
#############################################################################
@@ -564,6 +458,747 @@
}
#############################################################################
+# get()
+#############################################################################
+
+=head2 get()
+
+ * Signature: $value = $rep->get ($table, $key, $col, $options); [tbd]
+ * Signature: $value = $rep->get ($table, $params, $col, $options); [tbd]
+ * Signature: @row = $rep->get ($table, $key, $cols, $options); [tbd]
+ * Signature: @row = $rep->get ($table, $params, $cols, $options); [tbd]
+ * Param: $table string
+ * Param: $key string
+ * Param: $params undef,HASH
+ * Param: $col string
+ * Param: $cols ARRAY
+ * Param: $options undef,HASH
+ * Return: $value any
+ * Return: @row any
+ * Throws: App::Exception::Repository
+ * Since: 0.50
+
+ Sample Usage:
+
+ $value = $rep->get($table, $key, $col, \%options);
+ $value = $rep->get($table, \%params, $col, \%options);
+ @row = $rep->get($table, $key, [EMAIL PROTECTED], \%options);
+ @row = $rep->get($table, \%params, [EMAIL PROTECTED], \%options);
+
+tbd.
+
+=cut
+
+sub get {
+ &App::sub_entry if ($App::trace_subs);
+ 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);
+ return(@$row);
+ }
+ else {
+ $row = $self->get_row($table, $params, [$cols], $options);
+ &App::sub_exit($row->[0]) if ($App::trace_subs);
+ return($row->[0]);
+ }
+}
+
+#############################################################################
+# set()
+#############################################################################
+
+=head2 set()
+
+ * Signature: $nrows = $rep->set($table, $key, $col, $value, $options); [tbd]
+ * Signature: $nrows = $rep->set($table, $params, $col, $value, $options); [tbd]
+ * Param: $table string
+ * Param: $key string
+ * Param: $params undef,HASH
+ * Param: $col string
+ * Param: $value any
+ * Param: $options undef,HASH
+ * Return: $nrows integer
+ * Throws: App::Exception::Repository
+ * Since: 0.50
+
+ Sample Usage:
+
+ $nrows = $rep->set($table, $key, $col, $value, \%options);
+ $nrows = $rep->set($table, \%params, $col, $value, \%options);
+
+tbd.
+
+=cut
+
+sub set {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $table, $params, $col, $value, $options) = @_;
+ $self->_load_table_metadata($table) if (! defined
$self->{table}{$table}{loaded});
+ my ($nrows);
+ if (ref($col) eq "") {
+ $nrows = $self->set_row($table, $params, [$col], [$value], $options);
+ }
+ else {
+ $nrows = $self->set_row($table, $params, $col, $value, $options);
+ }
+ &App::sub_exit($nrows) if ($App::trace_subs);
+ return($nrows);
+}
+
+#############################################################################
+# get_row()
+#############################################################################
+
+=head2 get_row()
+
+ * Signature: $row = $rep->get_row ($table, $key, $cols, $options);
+ * Signature: $row = $rep->get_row ($table, $params, $cols, $options);
+ * Param: $table string
+ * Param: $key string
+ * Param: $params undef,HASH
+ * Param: $cols ARRAY
+ * Param: $options undef,HASH
+ * Return: $row ARRAY
+ * Throws: App::Exception::Repository
+ * Since: 0.50
+
+ Sample Usage:
+
+ $row = $rep->get_row($table, $key, [EMAIL PROTECTED], \%options);
+ $row = $rep->get_row($table, \%params, [EMAIL PROTECTED], \%options);
+
+tbd.
+
+=cut
+
+sub get_row {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $table, $params, $cols, $options) = @_;
+ $self->_load_table_metadata($table) if (! defined
$self->{table}{$table}{loaded});
+ my $row = $self->_get_row($table, $params, $cols, $options);
+ &App::sub_exit($row) if ($App::trace_subs);
+ return($row);
+}
+
+#############################################################################
+# set_row()
+#############################################################################
+
+=head2 set_row()
+
+ * Signature: $nrows = $rep->set_row($table, $key, $cols, $row, $options);
+ * Signature: $nrows = $rep->set_row($table, $params, $cols, $row, $options);
+ * Param: $table string
+ * Param: $cols ARRAY
+ * Param: $row ARRAY
+ * Param: $key string
+ * Param: $params undef,HASH
+ * Param: $options undef,HASH
+ * Return: $nrows integer
+ * Throws: App::Exception::Repository
+ * Since: 0.50
+
+ Sample Usage:
+
+ $nrows = $rep->set_row($table, $key, [EMAIL PROTECTED], $row, \%options);
+ $nrows = $rep->set_row($table, \%params, [EMAIL PROTECTED], $row, \%options);
+ $nrows = $rep->set_row($table, undef, [EMAIL PROTECTED], $row, \%options);
+
+tbd.
+
+=cut
+
+sub set_row {
+ &App::sub_entry if ($App::trace_subs);
+ 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);
+ return($nrows);
+}
+
+#############################################################################
+# get_column()
+#############################################################################
+
+=head2 get_column()
+
+ * Signature: $colvalues = $rep->get_column ($table, $params, $col, $options);
+ * Param: $table string
+ * Param: $params undef,HASH
+ * Param: $col string
+ * Param: $options undef,HASH
+ * Return: $colvalues ARRAY
+ * Throws: App::Exception::Repository
+ * Since: 0.50
+
+ Sample Usage:
+
+ $colvalues = $rep->get_column ($table, \%params, $col, \%options);
+
+tbd.
+
+=cut
+
+sub get_column {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $table, $params, $col, $options) = @_;
+ my (@colvalues, $rows, $row);
+ @colvalues = ();
+ $rows = $self->get_rows($table, $params, $col, $options);
+ foreach $row (@$rows) {
+ push(@colvalues, $row->[0]) if ($row && $#$row >= 0);
+ }
+ &App::sub_exit([EMAIL PROTECTED]) if ($App::trace_subs);
+ return([EMAIL PROTECTED]);
+}
+
+#############################################################################
+# get_rows()
+#############################################################################
+
+=head2 get_rows()
+
+ * Signature: $rows = $rep->get_rows($table, $params, $cols, $options);
+ * Signature: $rows = $rep->get_rows($table, $keys, $cols, $options);
+ * Param: $table string
+ * Param: $params undef,HASH
+ * Param: $keys ARRAY
+ * Param: $cols ARRAY
+ * Param: $options undef,HASH
+ * Return: $rows ARRAY
+ * Throws: App::Exception::Repository
+ * Since: 0.50
+
+ Sample Usage:
+
+ $rows = $rep->get_rows ($table, \%params, [EMAIL PROTECTED], \%options);
+ $rows = $rep->get_rows ($table, \%params, $col, \%options);
+ $rows = $rep->get_rows ($table, [EMAIL PROTECTED], [EMAIL PROTECTED],
\%options);
+
+tbd.
+
+=cut
+
+sub get_rows {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $table, $params, $cols, $options) = @_;
+ $self->_load_table_metadata($table) if (! defined
$self->{table}{$table}{loaded});
+ my $rows = $self->_get_rows($table, $params, $cols, $options);
+ &App::sub_exit($rows) if ($App::trace_subs);
+ return($rows);
+}
+
+#############################################################################
+# set_rows()
+#############################################################################
+
+=head2 set_rows()
+
+ * Signature: $nrows = $rep->set_rows($table, $keys, $cols, $rows, $options);
+ * Param: $table string
+ * Param: $keys undef,ARRAY
+ * Param: $cols ARRAY
+ * Param: $rows ARRAY
+ * Param: $options undef,HASH
+ * Return: $nrows integer
+ * Throws: App::Exception::Repository
+ * Since: 0.50
+
+ Sample Usage:
+
+ $nrows = $rep->set_rows($table, \%params, [EMAIL PROTECTED], $rows, \%options);
+ $nrows = $rep->set_rows($table, undef, [EMAIL PROTECTED], $rows, \%options);
+ $nrows = $rep->set_rows($table, [EMAIL PROTECTED], [EMAIL PROTECTED], $rows,
\%options);
+
+tbd.
+
+=cut
+
+sub set_rows {
+ &App::sub_entry if ($App::trace_subs);
+ 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);
+ return($nrows);
+}
+
+#############################################################################
+# get_values()
+#############################################################################
+
+=head2 get_values()
+
+ * Signature: $values = $rep->get_values ($table, $key, $cols, $options);
+ * Signature: $values = $rep->get_values ($table, $params, $cols, $options);
+ * Param: $table string
+ * Param: $cols ARRAY,undef
+ * Param: $key string
+ * Param: $params undef,HASH
+ * Param: $options undef,HASH
+ * Return: $values HASH
+ * Throws: App::Exception::Repository
+ * Since: 0.50
+
+ Sample Usage:
+
+ $values = $rep->get_values ($table, $key, [EMAIL PROTECTED], \%options);
+ $values = $rep->get_values ($table, \%params, [EMAIL PROTECTED], \%options);
+ $values = $rep->get_values ($table, $key, undef, \%options);
+ $values = $rep->get_values ($table, \%params, undef, \%options);
+
+tbd.
+
+=cut
+
+sub get_values {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $table, $params, $cols, $options) = @_;
+ &App::sub_exit() if ($App::trace_subs);
+}
+
+#############################################################################
+# get_values_list()
+#############################################################################
+
+=head2 get_values_list()
+
+ * Signature: $values_list = $rep->get_values_list ($table, $key, $cols,
$options);
+ * Signature: $values_list = $rep->get_values_list ($table, $params, $cols,
$options);
+ * Param: $table string
+ * Param: $cols ARRAY,undef
+ * Param: $key string
+ * Param: $params undef,HASH
+ * Param: $options undef,HASH
+ * Return: $values_list ARRAY
+ * Throws: App::Exception::Repository
+ * Since: 0.50
+
+ Sample Usage:
+
+ $values_list = $rep->get_values_list ($table, $key, [EMAIL PROTECTED],
\%options);
+ $values_list = $rep->get_values_list ($table, \%params, [EMAIL PROTECTED],
\%options);
+ $values_list = $rep->get_values_list ($table, $key, undef, \%options);
+ $values_list = $rep->get_values_list ($table, \%params, undef, \%options);
+
+tbd.
+
+=cut
+
+sub get_values_list {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $table, $params, $cols, $options) = @_;
+ my (@cols, $rows, $row, $colidx, $values, @values_list);
+ $cols = [EMAIL PROTECTED] if (!defined $cols);
+ $rows = $self->_get_rows($table, $params, $cols, $options);
+ foreach $row (@$rows) {
+ $values = {};
+ for ($colidx = 0; $colidx <= $#$cols; $colidx++) {
+ $values->{$cols->[$colidx]} = $row->[$colidx];
+ }
+ push(@values_list, $values);
+ }
+ &App::sub_exit($rows) if ($App::trace_subs);
+ return([EMAIL PROTECTED]);
+}
+
+#############################################################################
+# set_values()
+#############################################################################
+
+=head2 set_values()
+
+ * Signature: $nrows = $rep->set_values ($table, $key, $cols, $values,
$options);
+ * Signature: $nrows = $rep->set_values ($table, $params, $cols, $values,
$options);
+ * Param: $table string
+ * Param: $key string
+ * Param: $params undef,HASH
+ * Param: $cols ARRAY,undef
+ * Param: $options undef,HASH
+ * Return: $nrows integer
+ * Throws: App::Exception::Repository
+ * Since: 0.50
+
+ Sample Usage:
+
+ $nrows = $rep->set_values ($table, $key, [EMAIL PROTECTED], $values,
\%options);
+ $nrows = $rep->set_values ($table, $key, undef, $values, \%options);
+ $nrows = $rep->set_values ($table, undef, [EMAIL PROTECTED], $values,
\%options);
+ $nrows = $rep->set_values ($table, undef, undef, $values, \%options);
+ $nrows = $rep->set_values ($table, \%params, [EMAIL PROTECTED], $values,
\%options);
+ $nrows = $rep->set_values ($table, \%params, undef, $values, \%options);
+
+tbd.
+
+=cut
+
+sub set_values {
+ &App::sub_entry if ($App::trace_subs);
+ 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);
+}
+
+sub _params_to_hashref {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $table, $params) = @_;
+
+ if (!defined $params || $params eq "") {
+ $params = {};
+ }
+ elsif (!ref($params)) {
+ $params = $self->_key_to_params($table,$params); # $params is undef/scalar
=> $key
+ }
+
+ &App::sub_exit($params) if ($App::trace_subs);
+ return($params);
+}
+
+sub _row_matches {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $row, $table, $params, $cols, $options) = @_;
+
+ $options = {} if (!$options);
+
+ my ($tabledef, $param, $column, $repop, $colidxs, $colidx, $colvalue,
$paramvalue);
+
+ $colidxs = $options->{cache}{colidx};
+ if (!defined $colidxs || ! %$colidxs) {
+ $colidxs = {} if (!defined $colidxs);
+ for ($colidx = 0; $colidx < $#$cols; $colidx++) {
+ $column = $cols->[$colidx];
+ $colidxs->{$column} = $colidx;
+ }
+ }
+
+ my ($all_params_match, $param_match);
+ $all_params_match = 1; # assume it matches
+
+ $tabledef = $self->{table}{$table};
+ foreach $param (keys %$params) {
+ $param_match = undef;
+ $column = $param;
+ $colidx = $colidxs->{$column};
+ $colvalue = (defined $colidx) ? $row->[$colidx] : undef;
+ $repop = "";
+ # check if $column contains an embedded operation, i.e. "name.eq",
"name.contains"
+ if ($param =~ /^(.*)\.([^.]+)$/) {
+ $column = $1;
+ $repop = $2;
+ }
+
+ if (!defined $tabledef->{column}{$column}) {
+ if ($param =~ /^begin_(.*)/) {
+ $column = $1;
+ $repop = "ge";
+ }
+ elsif ($param =~ /^end_(.*)/) {
+ $column = $1;
+ $repop = "le";
+ }
+ }
+ next if (!defined $tabledef->{column}{$column}); # skip if the column is
unknown
+
+ $paramvalue = $params->{$param};
+ if (defined $paramvalue) {
+
+ if ($repop eq "contains") {
+ $param_match = ($colvalue !~ /$paramvalue/);
+ }
+ elsif ($repop eq "matches") {
+ $paramvalue =~ s/\*/\.\*/g;
+ $paramvalue =~ s/\?/\./g;
+ $param_match = ($colvalue !~ /^$paramvalue$/);
+ }
+ elsif ($repop eq "in" || $repop eq "eq") {
+ if ($paramvalue =~ /,/ && !
$tabledef->{param}{$param}{no_auto_in_param}) {
+ $param_match = (",$paramvalue," =~ /,$colvalue,/);
+ }
+ elsif ($paramvalue =~ /^-?[0-9]*\.?[0-9]*$/) {
+ $param_match = ($colvalue == $paramvalue);
+ }
+ else {
+ $param_match = ($colvalue eq $paramvalue);
+ }
+ }
+ elsif ($repop eq "gt") {
+ if ($paramvalue =~ /^-?[0-9]*\.?[0-9]*$/) {
+ $param_match = ($colvalue > $paramvalue);
+ }
+ else {
+ $param_match = ($colvalue gt $paramvalue);
+ }
+ }
+ elsif ($repop eq "ge") {
+ if ($paramvalue =~ /^-?[0-9]*\.?[0-9]*$/) {
+ $param_match = ($colvalue >= $paramvalue);
+ }
+ else {
+ $param_match = ($colvalue ge $paramvalue);
+ }
+ }
+ elsif ($repop eq "lt") {
+ if ($paramvalue =~ /^-?[0-9]*\.?[0-9]*$/) {
+ $param_match = ($colvalue < $paramvalue);
+ }
+ else {
+ $param_match = ($colvalue lt $paramvalue);
+ }
+ }
+ elsif ($repop eq "le") {
+ if ($paramvalue =~ /^-?[0-9]*\.?[0-9]*$/) {
+ $param_match = ($colvalue <= $paramvalue);
+ }
+ else {
+ $param_match = ($colvalue le $paramvalue);
+ }
+ }
+ elsif ($repop eq "ne") {
+ if ($paramvalue =~ /^-?[0-9]*\.?[0-9]*$/) {
+ $param_match = ($colvalue != $paramvalue);
+ }
+ else {
+ $param_match = ($colvalue ne $paramvalue);
+ }
+ }
+ else {
+ next;
+ }
+ }
+ if (!$param_match) {
+ $all_params_match = 0;
+ last;
+ }
+ }
+
+ &App::sub_exit($all_params_match) if ($App::trace_subs);
+ return($all_params_match);
+}
+
+sub _row_columns {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $table, $row, $cols) = @_;
+
+ my ($idx, $native_idx, $column, @newrow);
+ $#newrow = $#$cols; # preallocate
+ my $tabledef = $self->{table}{$table};
+ for ($idx = 0; $idx <= $#$cols; $idx++) {
+ $column = $cols->[$idx];
+ $native_idx = $tabledef->{column}{$column}{idx};
+ $newrow[$idx] = (defined $native_idx) ? $row->[$native_idx] : undef;
+ }
+
+ &App::sub_exit([EMAIL PROTECTED]) if ($App::trace_subs);
+ return([EMAIL PROTECTED]);
+}
+
+sub _get_row {
+ &App::sub_entry if ($App::trace_subs);
+ 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
+ $options = {} if (!$options);
+ if (! $options->{endrow}) {
+ $options->{endrow} = $options->{startrow} || 1;
+ }
+
+ my ($rows, $row, $matched_row);
+ $rows = $self->{table}{$table}{data};
+ 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);
+}
+
+sub _get_rows {
+ &App::sub_entry if ($App::trace_subs);
+ 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");
+ $options = {} if (!$options);
+ my $startrow = $options->{startrow} || 0;
+ my $endrow = $options->{endrow} || 0;
+
+ my ($rows, $row, $matched_rows);
+ $rows = $self->{table}{$table}{data};
+ $matched_rows = [];
+ if ($rows && ref($rows) eq "ARRAY") {
+ foreach $row (@$rows) {
+ 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);
+ return($matched_rows);
+}
+
+sub _set_rows {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $table, $params, $cols, $rows, $options) = @_;
+ $params = $self->_params_to_hashref($table, $params) if (ref($params) ne
"HASH");
+
+ my $tabledef = $self->{table}{$table};
+
+ my ($primary_key, @keycolidx, $keypos, %keypos, $keys_supplied);
+ my ($row, $colidx, $nrows);
+ $nrows = 0;
+ if (! defined $params) {
+ $primary_key = $tabledef->{primary_key};
+ $primary_key = [$primary_key] if (ref($primary_key) eq "");
+ for ($keypos = 0; $keypos <= $#$primary_key; $keypos++) {
+ $keypos{$primary_key->[$keypos]} = $keypos;
+ }
+ $keys_supplied = 0;
+ for ($colidx = 0; $colidx <= $#$cols; $colidx++) {
+ $keypos = $keypos{$cols->[$colidx]};
+ if (defined $keypos) {
+ $keycolidx[$keypos] = $colidx;
+ $keys_supplied++;
+ }
+ }
+ die "Tried to set_rows() and the primary key is not among the columns" if
($keys_supplied != $#$primary_key+1);
+ foreach $row (@$rows) {
+ $nrows += $self->update_row($table, $cols, $row, [EMAIL PROTECTED]);
+ }
+ }
+ elsif (ref($params) eq "ARRAY") {
+ # $curr_rows = $self->_get_rows($table, $params, $cols, $options);
+ }
+ else { # i.e. "HASH"
+ # $curr_rows = $self->_get_rows($table, $params, $cols, $options);
+ }
+ &App::sub_exit($nrows) if ($App::trace_subs);
+ return($nrows);
+}
+
+sub _set_row {
+ &App::sub_entry if ($App::trace_subs);
+ 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);
+ return($nrows);
+}
+
+sub _key_to_values {
+ &App::sub_entry if ($App::trace_subs);
+ 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);
+ return(@values);
+}
+
+sub _values_to_key {
+ &App::sub_entry if ($App::trace_subs);
+ 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);
+ return($retval);
+}
+
+sub _key_to_params {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $table, $key) = @_;
+ my %params = ();
+ my $primary_key = $self->{table}{$table}{primary_key};
+ die "ERROR: primary key is not defined for table [$table]\n (configure
attribute {Repository}{$self->{name}}{table}{$table}{primary_key})\n"
+ if (!defined $primary_key);
+ $primary_key = $primary_key->[0] if (ref($primary_key) eq "ARRAY" &&
$#$primary_key == 0);
+ if (ref($primary_key)) {
+ my ($colnum, @values);
+ if (!defined $key || $key eq "") {
+ for ($colnum = 0; $colnum <= $#$primary_key; $colnum++) {
+ $params{$primary_key->[$colnum]} = undef;
+ }
+ }
+ else {
+ @values = $self->_key_to_values($key);
+ die "ERROR: values [$key] do not match columns [" .
join(",",@$primary_key) . "] in primary key"
+ if ($#$primary_key != $#values);
+ for ($colnum = 0; $colnum <= $#$primary_key; $colnum++) {
+ $params{$primary_key->[$colnum]} = $values[$colnum];
+ }
+ }
+ $params{"_order"} = $primary_key;
+ }
+ else {
+ $params{$primary_key} = $key;
+ }
+ &App::sub_exit(\%params) if ($App::trace_subs);
+ return(\%params);
+}
+
+sub delete {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $table, $params, $cols, $row, $options) = @_;
+ my $retval = $self->_delete($table,$params,$cols,$row,$options);
+ &App::sub_exit($retval) if ($App::trace_subs);
+ return($retval);
+}
+
+sub _delete {
+ &App::sub_entry if ($App::trace_subs);
+ 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);
+ return($retval);
+}
+
+# $nrows = $rep->_update($table, \%params, [EMAIL PROTECTED], [EMAIL PROTECTED],
\%options);
+# $nrows = $rep->_update($table, [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL
PROTECTED], \%options);
+# $nrows = $rep->_update($table, [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL
PROTECTED], \%options);
+# $nrows = $rep->_update($table, $key, [EMAIL PROTECTED], [EMAIL PROTECTED],
\%options);
+# $nrows = $rep->_update($table, undef, [EMAIL PROTECTED], [EMAIL PROTECTED],
\%options);
+sub _update {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $table, $params, $cols, $row, $options) = @_;
+
+ $self->{error} = "";
+ my $retval = 0;
+
+ my $get_options = { cache => {}, };
+ my $rows = $self->_get_rows($table, $params, undef, $get_options);
+ my $colidxs = $get_options->{cache}{colidx};
+ my ($idx, $colidx, $column, $tablerow);
+ foreach $tablerow (@$rows) {
+ for ($idx = 0; $idx <= $#$cols; $idx++) {
+ $column = $cols->[$idx];
+ $colidx = $colidxs->{$column};
+ if (defined $colidx) {
+ $tablerow->[$colidx] = $row->[$idx];
+ }
+ }
+ }
+ $retval = $#$rows + 1;
+
+ &App::sub_exit($retval) if ($App::trace_subs);
+ return($retval);
+}
+
+#############################################################################
# format_repdate()
#############################################################################
@@ -1563,10 +2198,6 @@
$table_def->{column_labels}{$column} = $column_def->{label};
}
-
- # predefine that certain required columns will be in the result set
- # $self->set_required_columns_fetched($table);
- # $self->clear_cache();
}
#############################################################################
1.11 +2 -494 p5ee/App-Repository/lib/App/Repository/DBI.pm
Index: DBI.pm
===================================================================
RCS file: /cvs/public/p5ee/App-Repository/lib/App/Repository/DBI.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -w -r1.10 -r1.11
--- DBI.pm 18 Jun 2003 20:43:26 -0000 1.10
+++ DBI.pm 27 Jun 2003 18:39:37 -0000 1.11
@@ -1,13 +1,13 @@
######################################################################
-## File: $Id: DBI.pm,v 1.10 2003/06/18 20:43:26 spadkins Exp $
+## File: $Id: DBI.pm,v 1.11 2003/06/27 18:39:37 spadkins Exp $
######################################################################
use App;
use App::Repository;
package App::Repository::DBI;
-$VERSION = do { my @r=(q$Revision: 1.10 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
+$VERSION = do { my @r=(q$Revision: 1.11 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
@ISA = ( "App::Repository" );
@@ -284,392 +284,6 @@
return ($retval);
}
-sub error {
- &App::sub_entry if ($App::trace_subs);
- my ($self) = @_;
- &App::sub_exit($self->{error}) if ($App::trace_subs);
- return $self->{error};
-}
-
-#############################################################################
-# get()
-#############################################################################
-
-=head2 get()
-
- * Signature: $value = $rep->get ($table, $key, $col, $options); [tbd]
- * Signature: $value = $rep->get ($table, $params, $col, $options); [tbd]
- * Signature: @row = $rep->get ($table, $key, $cols, $options); [tbd]
- * Signature: @row = $rep->get ($table, $params, $cols, $options); [tbd]
- * Param: $table string
- * Param: $key string
- * Param: $params undef,HASH
- * Param: $col string
- * Param: $cols ARRAY
- * Param: $options undef,HASH
- * Return: $value any
- * Return: @row any
- * Throws: App::Exception::Repository
- * Since: 0.50
-
- Sample Usage:
-
- $value = $rep->get($table, $key, $col, \%options);
- $value = $rep->get($table, \%params, $col, \%options);
- @row = $rep->get($table, $key, [EMAIL PROTECTED], \%options);
- @row = $rep->get($table, \%params, [EMAIL PROTECTED], \%options);
-
-tbd.
-
-=cut
-
-sub get {
- &App::sub_entry if ($App::trace_subs);
- 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);
- return(@$row);
- }
- else {
- $row = $self->get_row($table, $params, [$cols], $options);
- &App::sub_exit($row->[0]) if ($App::trace_subs);
- return($row->[0]);
- }
-}
-
-#############################################################################
-# set()
-#############################################################################
-
-=head2 set()
-
- * Signature: $nrows = $rep->set($table, $key, $col, $value, $options); [tbd]
- * Signature: $nrows = $rep->set($table, $params, $col, $value, $options); [tbd]
- * Param: $table string
- * Param: $key string
- * Param: $params undef,HASH
- * Param: $col string
- * Param: $value any
- * Param: $options undef,HASH
- * Return: $nrows integer
- * Throws: App::Exception::Repository
- * Since: 0.50
-
- Sample Usage:
-
- $nrows = $rep->set($table, $key, $col, $value, \%options);
- $nrows = $rep->set($table, \%params, $col, $value, \%options);
-
-tbd.
-
-=cut
-
-sub set {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $params, $col, $value, $options) = @_;
- my ($nrows);
- if (ref($col) eq "") {
- $nrows = $self->set_row($table, $params, [$col], [$value], $options);
- }
- else {
- $nrows = $self->set_row($table, $params, $col, $value, $options);
- }
- &App::sub_exit($nrows) if ($App::trace_subs);
- return($nrows);
-}
-
-#############################################################################
-# get_row()
-#############################################################################
-
-=head2 get_row()
-
- * Signature: $row = $rep->get_row ($table, $key, $cols, $options);
- * Signature: $row = $rep->get_row ($table, $params, $cols, $options);
- * Param: $table string
- * Param: $key string
- * Param: $params undef,HASH
- * Param: $cols ARRAY
- * Param: $options undef,HASH
- * Return: $row ARRAY
- * Throws: App::Exception::Repository
- * Since: 0.50
-
- Sample Usage:
-
- $row = $rep->get_row($table, $key, [EMAIL PROTECTED], \%options);
- $row = $rep->get_row($table, \%params, [EMAIL PROTECTED], \%options);
-
-tbd.
-
-=cut
-
-sub get_row {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $params, $cols, $options) = @_;
- my $row = $self->_get_row($table, $params, $cols, $options);
- &App::sub_exit($row) if ($App::trace_subs);
- return($row);
-}
-
-#############################################################################
-# set_row()
-#############################################################################
-
-=head2 set_row()
-
- * Signature: $nrows = $rep->set_row($table, $key, $cols, $row, $options);
- * Signature: $nrows = $rep->set_row($table, $params, $cols, $row, $options);
- * Param: $table string
- * Param: $cols ARRAY
- * Param: $row ARRAY
- * Param: $key string
- * Param: $params undef,HASH
- * Param: $options undef,HASH
- * Return: $nrows integer
- * Throws: App::Exception::Repository
- * Since: 0.50
-
- Sample Usage:
-
- $nrows = $rep->set_row($table, $key, [EMAIL PROTECTED], $row, \%options);
- $nrows = $rep->set_row($table, \%params, [EMAIL PROTECTED], $row, \%options);
- $nrows = $rep->set_row($table, undef, [EMAIL PROTECTED], $row, \%options);
-
-tbd.
-
-=cut
-
-sub set_row {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $params, $cols, $row, $options) = @_;
- my $nrows = $self->_set_row($table, $params, $cols, $row, $options);
- &App::sub_exit($nrows) if ($App::trace_subs);
- return($nrows);
-}
-
-#############################################################################
-# get_column()
-#############################################################################
-
-=head2 get_column()
-
- * Signature: $colvalues = $rep->get_column ($table, $params, $col, $options);
- * Param: $table string
- * Param: $params undef,HASH
- * Param: $col string
- * Param: $options undef,HASH
- * Return: $colvalues ARRAY
- * Throws: App::Exception::Repository
- * Since: 0.50
-
- Sample Usage:
-
- $colvalues = $rep->get_column ($table, \%params, $col, \%options);
-
-tbd.
-
-=cut
-
-sub get_column {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $params, $col, $options) = @_;
- my (@colvalues, $rows, $row);
- @colvalues = ();
- $rows = $self->get_rows($table, $params, $col, $options);
- foreach $row (@$rows) {
- push(@colvalues, $row->[0]) if ($row && $#$row >= 0);
- }
- &App::sub_exit([EMAIL PROTECTED]) if ($App::trace_subs);
- return([EMAIL PROTECTED]);
-}
-
-#############################################################################
-# get_rows()
-#############################################################################
-
-=head2 get_rows()
-
- * Signature: $rows = $rep->get_rows($table, $params, $cols, $options);
- * Signature: $rows = $rep->get_rows($table, $keys, $cols, $options);
- * Param: $table string
- * Param: $params undef,HASH
- * Param: $keys ARRAY
- * Param: $cols ARRAY
- * Param: $options undef,HASH
- * Return: $rows ARRAY
- * Throws: App::Exception::Repository
- * Since: 0.50
-
- Sample Usage:
-
- $rows = $rep->get_rows ($table, \%params, [EMAIL PROTECTED], \%options);
- $rows = $rep->get_rows ($table, \%params, $col, \%options);
- $rows = $rep->get_rows ($table, [EMAIL PROTECTED], [EMAIL PROTECTED],
\%options);
-
-tbd.
-
-=cut
-
-sub get_rows {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $params, $cols, $options) = @_;
- my $rows = $self->_get_rows($table, $params, $cols, $options);
- &App::sub_exit($rows) if ($App::trace_subs);
- return($rows);
-}
-
-#############################################################################
-# set_rows()
-#############################################################################
-
-=head2 set_rows()
-
- * Signature: $nrows = $rep->set_rows($table, $keys, $cols, $rows, $options);
- * Param: $table string
- * Param: $keys undef,ARRAY
- * Param: $cols ARRAY
- * Param: $rows ARRAY
- * Param: $options undef,HASH
- * Return: $nrows integer
- * Throws: App::Exception::Repository
- * Since: 0.50
-
- Sample Usage:
-
- $nrows = $rep->set_rows($table, \%params, [EMAIL PROTECTED], $rows, \%options);
- $nrows = $rep->set_rows($table, undef, [EMAIL PROTECTED], $rows, \%options);
- $nrows = $rep->set_rows($table, [EMAIL PROTECTED], [EMAIL PROTECTED], $rows,
\%options);
-
-tbd.
-
-=cut
-
-sub set_rows {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $params, $cols, $rows, $options) = @_;
- my $nrows = $self->_set_rows($table, $params, $cols, $rows, $options);
- &App::sub_exit($nrows) if ($App::trace_subs);
- return($nrows);
-}
-
-#############################################################################
-# get_values()
-#############################################################################
-
-=head2 get_values()
-
- * Signature: $values = $rep->get_values ($table, $key, $cols, $options);
- * Signature: $values = $rep->get_values ($table, $params, $cols, $options);
- * Param: $table string
- * Param: $cols ARRAY,undef
- * Param: $key string
- * Param: $params undef,HASH
- * Param: $options undef,HASH
- * Return: $values HASH
- * Throws: App::Exception::Repository
- * Since: 0.50
-
- Sample Usage:
-
- $values = $rep->get_values ($table, $key, [EMAIL PROTECTED], \%options);
- $values = $rep->get_values ($table, \%params, [EMAIL PROTECTED], \%options);
- $values = $rep->get_values ($table, $key, undef, \%options);
- $values = $rep->get_values ($table, \%params, undef, \%options);
-
-tbd.
-
-=cut
-
-sub get_values {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $params, $cols, $options) = @_;
- &App::sub_exit() if ($App::trace_subs);
-}
-
-#############################################################################
-# get_values_list()
-#############################################################################
-
-=head2 get_values_list()
-
- * Signature: $values_list = $rep->get_values_list ($table, $key, $cols,
$options);
- * Signature: $values_list = $rep->get_values_list ($table, $params, $cols,
$options);
- * Param: $table string
- * Param: $cols ARRAY,undef
- * Param: $key string
- * Param: $params undef,HASH
- * Param: $options undef,HASH
- * Return: $values_list ARRAY
- * Throws: App::Exception::Repository
- * Since: 0.50
-
- Sample Usage:
-
- $values_list = $rep->get_values_list ($table, $key, [EMAIL PROTECTED],
\%options);
- $values_list = $rep->get_values_list ($table, \%params, [EMAIL PROTECTED],
\%options);
- $values_list = $rep->get_values_list ($table, $key, undef, \%options);
- $values_list = $rep->get_values_list ($table, \%params, undef, \%options);
-
-tbd.
-
-=cut
-
-sub get_values_list {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $params, $cols, $options) = @_;
- my (@cols, $rows, $row, $colidx, $values, @values_list);
- $cols = [EMAIL PROTECTED] if (!defined $cols);
- $rows = $self->_get_rows($table, $params, $cols, $options);
- foreach $row (@$rows) {
- $values = {};
- for ($colidx = 0; $colidx <= $#$cols; $colidx++) {
- $values->{$cols->[$colidx]} = $row->[$colidx];
- }
- push(@values_list, $values);
- }
- &App::sub_exit($rows) if ($App::trace_subs);
- return([EMAIL PROTECTED]);
-}
-
-#############################################################################
-# set_values()
-#############################################################################
-
-=head2 set_values()
-
- * Signature: $nrows = $rep->set_values ($table, $key, $cols, $values,
$options);
- * Signature: $nrows = $rep->set_values ($table, $params, $cols, $values,
$options);
- * Param: $table string
- * Param: $key string
- * Param: $params undef,HASH
- * Param: $cols ARRAY,undef
- * Param: $options undef,HASH
- * Return: $nrows integer
- * Throws: App::Exception::Repository
- * Since: 0.50
-
- Sample Usage:
-
- $nrows = $rep->set_values ($table, $key, [EMAIL PROTECTED], $values,
\%options);
- $nrows = $rep->set_values ($table, $key, undef, $values, \%options);
- $nrows = $rep->set_values ($table, undef, [EMAIL PROTECTED], $values,
\%options);
- $nrows = $rep->set_values ($table, undef, undef, $values, \%options);
- $nrows = $rep->set_values ($table, \%params, [EMAIL PROTECTED], $values,
\%options);
- $nrows = $rep->set_values ($table, \%params, undef, $values, \%options);
-
-tbd.
-
-=cut
-
-sub set_values {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $params, $cols, $values, $options) = @_;
- &App::sub_exit() if ($App::trace_subs);
-}
-
#############################################################################
# PRIVATE METHODS
#############################################################################
@@ -767,54 +381,6 @@
return($rows);
}
-sub _set_rows {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $params, $cols, $rows, $options) = @_;
-
- my $tabledef = $self->{table}{$table};
-
- my ($primary_key, @keycolidx, $keypos, %keypos, $keys_supplied);
- my ($row, $colidx, $nrows);
- $nrows = 0;
- if (! defined $params) {
- $primary_key = $tabledef->{primary_key};
- $primary_key = [$primary_key] if (ref($primary_key) eq "");
- for ($keypos = 0; $keypos <= $#$primary_key; $keypos++) {
- $keypos{$primary_key->[$keypos]} = $keypos;
- }
- $keys_supplied = 0;
- for ($colidx = 0; $colidx <= $#$cols; $colidx++) {
- $keypos = $keypos{$cols->[$colidx]};
- if (defined $keypos) {
- $keycolidx[$keypos] = $colidx;
- $keys_supplied++;
- }
- }
- die "Tried to set_rows() and the primary key is not among the columns" if
($keys_supplied != $#$primary_key+1);
- foreach $row (@$rows) {
- $nrows += $self->update_row($table, $cols, $row, [EMAIL PROTECTED]);
- }
- }
- elsif (ref($params) eq "ARRAY") {
- # $curr_rows = $self->_get_rows($table, $params, $cols, $options);
- }
- else { # i.e. "HASH"
- # $curr_rows = $self->_get_rows($table, $params, $cols, $options);
- }
- &App::sub_exit($nrows) if ($App::trace_subs);
- return($nrows);
-}
-
-sub _set_row {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $params, $cols, $row, $options) = @_;
-
- my $nrows = $self->_update($table, $params, $cols, $row, $options);
-
- &App::sub_exit($nrows) if ($App::trace_subs);
- return($nrows);
-}
-
# modified from the DBD::_::db::selectall_arrayref in DBI.pm
sub _selectrange_arrayref {
&App::sub_entry if ($App::trace_subs);
@@ -1029,56 +595,6 @@
$where;
}
-sub _key_to_values {
- &App::sub_entry if ($App::trace_subs);
- 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);
- return(@values);
-}
-
-sub _values_to_key {
- &App::sub_entry if ($App::trace_subs);
- 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);
- return($retval);
-}
-
-sub _key_to_params {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $key) = @_;
- my %params = ();
- my $primary_key = $self->{table}{$table}{primary_key};
- die "ERROR: primary key is not defined for table [$table]\n (configure
attribute {Repository}{$self->{name}}{table}{$table}{primary_key})\n"
- if (!defined $primary_key);
- $primary_key = $primary_key->[0] if (ref($primary_key) eq "ARRAY" &&
$#$primary_key == 0);
- if (ref($primary_key)) {
- my ($colnum, @values);
- if (!defined $key || $key eq "") {
- for ($colnum = 0; $colnum <= $#$primary_key; $colnum++) {
- $params{$primary_key->[$colnum]} = undef;
- }
- }
- else {
- @values = $self->_key_to_values($key);
- die "ERROR: values [$key] do not match columns [" .
join(",",@$primary_key) . "] in primary key"
- if ($#$primary_key != $#values);
- for ($colnum = 0; $colnum <= $#$primary_key; $colnum++) {
- $params{$primary_key->[$colnum]} = $values[$colnum];
- }
- }
- $params{"_order"} = $primary_key;
- }
- else {
- $params{$primary_key} = $key;
- }
- &App::sub_exit(\%params) if ($App::trace_subs);
- return(\%params);
-}
-
sub _mk_select_sql {
&App::sub_entry if ($App::trace_subs);
my ($self, $table, $params, $cols, $options) = @_;
@@ -2190,14 +1706,6 @@
$self->{numrows} = $nrows;
&App::sub_exit($ok) if ($App::trace_subs);
return($ok);
-}
-
-sub delete {
- &App::sub_entry if ($App::trace_subs);
- my ($self, $table, $params, $cols, $row, $options) = @_;
- my $retval = $self->_delete($table,$params,$cols,$row,$options);
- &App::sub_exit($retval) if ($App::trace_subs);
- return($retval);
}
sub _delete {
1.1 p5ee/App-Repository/lib/App/Repository/File.pm
Index: File.pm
===================================================================
######################################################################
## File: $Id: File.pm,v 1.1 2003/06/27 18:39:37 spadkins Exp $
######################################################################
use App;
use App::Repository;
package App::Repository::File;
$VERSION = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
@ISA = ( "App::Repository" );
use Data::Dumper;
use strict;
=head1 NAME
App::Repository::File - a repository which stores its data in flat files
=head1 SYNOPSIS
use App::Repository::File;
(see man page for App::Repository for additional methods)
$rep = App::Repository::File->new(); # looks for %ENV, then config file
$errmsg = $rep->error(); # returns the error string for prev op ("" if no
error)
$numrows = $rep->numrows(); # returns the number of rows affected by prev op
print $rep->error(), "\n" if (!$rep->_connect());
$value = $rep->get ($table, $key, $col, \%options);
$value = $rep->get ($table, \%params, $col, \%options);
@row = $rep->get ($table, $key, [EMAIL PROTECTED], \%options);
@row = $rep->get ($table, \%params, [EMAIL PROTECTED], \%options);
$nrows = $rep->set($table, $key, $col, $value, \%options);
$nrows = $rep->set($table, \%params, $col, $value, \%options);
$row = $rep->get_row ($table, $key, [EMAIL PROTECTED], \%options);
$row = $rep->get_row ($table, \%params, [EMAIL PROTECTED], \%options);
$nrows = $rep->set_row($table, $key, [EMAIL PROTECTED], $row, \%options);
$nrows = $rep->set_row($table, \%params, [EMAIL PROTECTED], $row, \%options);
$nrows = $rep->set_row($table, undef, [EMAIL PROTECTED], $row, \%options);
$colvalues = $rep->get_column ($table, \%params, $col, \%options);
$rows = $rep->get_rows ($table, \%params, [EMAIL PROTECTED], \%options);
$rows = $rep->get_rows ($table, \%params, $col, \%options);
$rows = $rep->get_rows ($table, [EMAIL PROTECTED], [EMAIL PROTECTED],
\%options);
$nrows = $rep->set_rows($table, \%params, [EMAIL PROTECTED], $rows, \%options);
$nrows = $rep->set_rows($table, undef, [EMAIL PROTECTED], $rows, \%options);
$nrows = $rep->set_rows($table, [EMAIL PROTECTED], [EMAIL PROTECTED], $rows,
\%options);
$values = $rep->get_values ($table, $key, [EMAIL PROTECTED], \%options);
$values = $rep->get_values ($table, \%params, [EMAIL PROTECTED], \%options);
$values = $rep->get_values ($table, $key, undef, \%options);
$values = $rep->get_values ($table, \%params, undef, \%options);
$values_list = $rep->get_values_list ($table, $key, [EMAIL PROTECTED],
\%options);
$values_list = $rep->get_values_list ($table, \%params, [EMAIL PROTECTED],
\%options);
$values_list = $rep->get_values_list ($table, $key, undef, \%options);
$values_list = $rep->get_values_list ($table, \%params, undef, \%options);
$nrows = $rep->set_values ($table, $key, [EMAIL PROTECTED], $values,
\%options);
$nrows = $rep->set_values ($table, $key, undef, $values, \%options);
$nrows = $rep->set_values ($table, undef, [EMAIL PROTECTED], $values,
\%options);
$nrows = $rep->set_values ($table, undef, undef, $values, \%options);
$nrows = $rep->set_values ($table, \%params, [EMAIL PROTECTED], $values,
\%options);
$nrows = $rep->set_values ($table, \%params, undef, $values, \%options);
=cut
######################################################################
# ATTRIBUTES
######################################################################
# CONNECTION ATTRIBUTES
# $self->{dir} # directory files are stored in
######################################################################
# INHERITED ATTRIBUTES
######################################################################
# BASIC
# $self->{name} # name of this repository (often "db")
# CURRENT STATE
# $self->{error} # most recent error generated from this module
# $self->{numrows}
# METADATA - Database Types
# $self->{types}
# $self->{type}{$type}{name}
# $self->{type}{$type}{num}
# $self->{type}{$type}{type}
# $self->{type}{$type}{column_size}
# $self->{type}{$type}{literal_prefix}
# $self->{type}{$type}{literal_suffix}
# $self->{type}{$type}{unsigned_attribute}
# $self->{type}{$type}{auto_unique_value}
# $self->{type}{$type}{quoted}
# METADATA - Tables and Columns
# $self->{table_names}
# $self->{table}{$table}{readonly}
# $self->{table}{$table}{columns}
# $self->{table}{$table}{column}{$column}
# $self->{table}{$table}{column}{$column}{name}
# $self->{table}{$table}{column}{$column}{type_name}
# $self->{table}{$table}{column}{$column}{type}
# $self->{table}{$table}{column}{$column}{notnull}
# $self->{table}{$table}{column}{$column}{quoted}
=head1 DESCRIPTION
The App::Repository::File class encapsulates all access to data stored
in flat files. It provides an alternate data store to a database
for use with small datasets or in demonstration programs.
=cut
1;
