cvsuser 05/08/09 11:50:17
Modified: App-Repository/lib/App Repository.pm
Log:
new_object(), _last_insertid(), export_rows(), import_rows()
Revision Changes Path
1.21 +228 -9 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.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- Repository.pm 25 Apr 2005 16:18:31 -0000 1.20
+++ Repository.pm 9 Aug 2005 18:50:17 -0000 1.21
@@ -100,6 +100,8 @@
$rep->commit();
$rep->rollback();
+ $rep->import_rows($table, $file, $options);
+ $rep->export_rows($table, $file, $options);
=cut
@@ -493,14 +495,24 @@
sub get {
&App::sub_entry if ($App::trace);
my ($self, $table, $params, $cols, $options) = @_;
- my ($row);
+ my ($row, $wantarray);
if (ref($cols) eq "ARRAY") {
- $row = $self->get_row($table, $params, $cols, $options);
+ $wantarray = 1;
+ }
+ else {
+ $cols = [ $cols ];
+ $wantarray = 0;
+ }
+ $row = $self->get_row($table, $params, $cols, $options);
+ if (!$row) {
+ &App::sub_exit(undef) if ($App::trace);
+ return(undef);
+ }
+ elsif ($wantarray) {
&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);
return($row->[0]);
}
@@ -1492,11 +1504,16 @@
&App::sub_entry if ($App::trace);
my ($self, $table, $cols, $row, $options) = @_;
my ($retval, $hash, $columns);
- if (ref($cols) eq "HASH") {
+ my $ref = ref($cols);
+ if ($ref && $ref ne "ARRAY") {
$hash = $cols; # a hashref was passed in instead of cols/row
my $tabledef = $self->get_table_def($table);
- $columns = $tabledef->{columns};
- $columns = [ keys %$hash ] if (!$columns);
+ $columns = [];
+ foreach my $col (@{$tabledef->{columns}}) {
+ if (exists $hash->{$col}) {
+ push(@$columns, $col);
+ }
+ }
}
elsif (ref($row) eq "HASH") {
$hash = $row;
@@ -1505,8 +1522,12 @@
}
else {
my $tabledef = $self->get_table_def($table);
- $columns = $tabledef->{columns};
- $columns = [ keys %$hash ] if (!$columns);
+ $columns = [];
+ foreach my $col (@{$tabledef->{columns}}) {
+ if (exists $hash->{$col}) {
+ push(@$columns, $col);
+ }
+ }
}
}
if ($hash) {
@@ -1535,6 +1556,54 @@
$retval;
}
+# NOTE: This might be optimized somehow in the future so that I don't
+# need to do a select after insert. However, there might be defaults
+# set in the database that I don't know about, and I want them to be
+# reflected in the returned object.
+# NOTE 2: Tables which have
+sub new_object {
+ &App::sub_entry if ($App::trace);
+ my ($self, $table, $cols, $row, $options) = @_;
+ my $ref = ref($cols);
+ if ($ref && $ref ne "ARRAY") {
+ $self->_set_defaults($table, $cols);
+ $self->_check_required_fields($table, $cols);
+ }
+ my $retval = $self->insert_row($table, $cols, $row, $options);
+ die "new($table) unable to create a new row" if (!$retval);
+ my $params = $self->_last_inserted_id();
+ if (!$params) {
+ $params = {};
+ for (my $i = 0; $i <= $#$cols; $i++) {
+ if (!$row->[$i] || $row->[$i] !~ /^@/) {
+ $params->{$cols->[$i] . ".eq"} = $row->[$i];
+ }
+ }
+ }
+ my $object = $self->get_object($table, $params, undef, $options);
+ &App::sub_exit($object) if ($App::trace);
+ $object;
+}
+
+sub _set_defaults {
+ &App::sub_entry if ($App::trace);
+ my ($self, $table, $hash) = @_;
+ # TODO: flesh this out
+ &App::sub_exit() if ($App::trace);
+}
+
+sub _check_required_fields {
+ &App::sub_entry if ($App::trace);
+ my ($self, $table, $hash) = @_;
+ # TODO: flesh this out
+ &App::sub_exit() if ($App::trace);
+}
+
+sub _last_inserted_id {
+ my ($self) = @_;
+ return(undef); # sorry. maybe some subclass will know how to do this.
+}
+
# $ok = $rep->insert_rows ($table, [EMAIL PROTECTED], [EMAIL PROTECTED]);
sub insert_rows {
&App::sub_entry if ($App::trace);
@@ -2122,6 +2191,156 @@
# METHODS
#############################################################################
+=head1 Methods: Import/Export Data From File
+
+=cut
+
+#############################################################################
+# import_rows()
+#############################################################################
+
+=head2 import_rows()
+
+ * Signature: $rep->import_rows($table, $file);
+ * Signature: $rep->import_rows($table, $file, $options);
+ * Param: $table string
+ * Param: $file string
+ * Param: $options named
+ * Param: columns ARRAY names of columns of the fields in
the file
+ * Param: replace boolean rows should replace existing rows
based on unique indexes
+ * Param: field_sep char character which separates the
fields in the file (can by "\t")
+ * Param: field_quote char character which optionally encloses
the fields in the file (i.e. '"')
+ * Param: field_escape char character which escapes the quote
chars within quotes (i.e. "\")
+ * Return: void
+ * Throws: App::Exception::Repository
+ * Since: 0.01
+
+ Sample Usage:
+
+ $rep->import_rows("usr","usr.dat");
+
+ # root:x:0:0:root:/root:/bin/bash
+ $rep->import_rows("usr", "/etc/passwd" ,{
+ field_sep => ":",
+ columns => [ "username", "password", "uid", "gid", "comment",
"home_directory", "shell" ],
+ });
+
+=cut
+
+sub import_rows {
+ &App::sub_entry if ($App::trace);
+ my ($self, $table, $file, $options) = @_;
+ my $columns = $options->{columns} || $self->{table}{$table}{columns};
+ my $field_sep = $options->{field_sep} || ",";
+ my $field_quote = $options->{field_quote};
+ my $field_escape = $options->{field_escape};
+
+ open(App::Repository::DBI::FILE, "< $file") || die "Unable to open $file
for reading: $!";
+ my (@row, $quoted_field_regexp, $field_regexp);
+ while (<App::Repository::DBI::FILE>) {
+ chomp;
+ if ($field_quote) {
+ @row = ();
+ # TODO: incorporate escaping
+ $field_regexp =
"$field_sep?$field_quote([^$field_quote]*)$field_quote";
+ $quoted_field_regexp = "$field_sep?([^$field_sep]*)";
+ while ($_) {
+ if ($_ =~ s/^$quoted_field_regexp//) {
+ push(@row, $1);
+ }
+ elsif ($_ =~ s/^$field_regexp//) {
+ push(@row, $1);
+ }
+ else {
+ die "Imported data doesn't match quoted or unquoted
field [$_]";
+ }
+ }
+ }
+ else {
+ @row = split(/$field_sep/);
+ }
+ # TODO: use insert_rows() instead of insert_row()
+ $self->insert_row($table, $columns, [EMAIL PROTECTED]);
+ }
+ close(App::Repository::DBI::FILE);
+
+ &App::sub_exit() if ($App::trace);
+}
+
+#############################################################################
+# export_rows()
+#############################################################################
+
+=head2 export_rows()
+
+ * Signature: $rep->export_rows($table, $file);
+ * Signature: $rep->export_rows($table, $file, $options);
+ * Param: $table string
+ * Param: $file string
+ * Param: $options named
+ * Param: columns ARRAY names of columns of the fields in
the file
+ * Param: replace boolean rows should replace existing rows
based on unique indexes
+ * Param: field_sep char character which separates the
fields in the file (can by "\t")
+ * Param: field_quote char character which optionally encloses
the fields in the file (i.e. '"')
+ * Param: field_escape char character which escapes the quote
chars within quotes (i.e. "\")
+ * Return: void
+ * Throws: App::Exception::Repository
+ * Since: 0.01
+
+ Sample Usage:
+
+ $rep->export_rows("usr","usr.dat");
+
+ # root:x:0:0:root:/root:/bin/bash
+ $rep->export_rows("usr", "passwd.dat" ,{
+ field_sep => ":",
+ columns => [ "username", "password", "uid", "gid", "comment",
"home_directory", "shell" ],
+ });
+
+=cut
+
+sub export_rows {
+ &App::sub_entry if ($App::trace);
+ my ($self, $table, $file, $options) = @_;
+
+ my $columns = $options->{columns} || $self->{table}{$table}{columns};
+ my $rows = $self->get_rows($table, {}, $columns);
+ my $field_sep = $options->{field_sep} || ",";
+ my $field_quote = $options->{field_quote};
+ my $field_escape = $options->{field_escape};
+
+ open(App::Repository::DBI::FILE, "> $file") || die "Unable to open $file
for writing: $!";
+ my ($i, $value);
+ foreach my $row (@$rows) {
+ if ($field_quote) {
+ for ($i = 0; $i <= $#$row; $i++) {
+ print App::Repository::DBI::FILE $field_sep if ($i > 0);
+ $value = $row->[$i];
+ if ($value =~ /$field_sep/) {
+ if ($field_escape) {
+ $value =~
s/$field_escape/$field_escape$field_escape/g;
+ $value =~ s/$field_quote/$field_escape$field_quote/g;
+ }
+ print App::Repository::DBI::FILE $field_quote, $value,
$field_quote;
+ }
+ else {
+ print App::Repository::DBI::FILE $value;
+ }
+ }
+ }
+ else {
+ print App::Repository::DBI::FILE join($field_sep, @$row), "\n";
+ }
+ }
+ close(App::Repository::DBI::FILE);
+
+ &App::sub_exit() if ($App::trace);
+}
+
+#############################################################################
+# METHODS
+#############################################################################
+
=head1 Methods: Locking (Concurrency Management)
=cut
