[Bast-commits] r6555 - in
DBIx-Class/0.08/branches/run_file_against_storage:
lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI t/lib
jnapiorkowski at dev.catalyst.perl.org
jnapiorkowski at dev.catalyst.perl.org
Tue Jun 9 00:17:58 GMT 2009
Author: jnapiorkowski
Date: 2009-06-09 00:17:58 +0000 (Tue, 09 Jun 2009)
New Revision: 6555
Modified:
DBIx-Class/0.08/branches/run_file_against_storage/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/run_file_against_storage/lib/DBIx/Class/Storage/DBI/Replicated.pm
DBIx-Class/0.08/branches/run_file_against_storage/t/lib/DBICTest.pm
Log:
normalized spaces over tabs, fixed replication support, changed testing deploy to use the new method
Modified: DBIx-Class/0.08/branches/run_file_against_storage/lib/DBIx/Class/Storage/DBI/Replicated.pm
===================================================================
--- DBIx-Class/0.08/branches/run_file_against_storage/lib/DBIx/Class/Storage/DBI/Replicated.pm 2009-06-08 22:13:47 UTC (rev 6554)
+++ DBIx-Class/0.08/branches/run_file_against_storage/lib/DBIx/Class/Storage/DBI/Replicated.pm 2009-06-09 00:17:58 UTC (rev 6555)
@@ -303,6 +303,7 @@
sth
deploy
with_deferred_fk_checks
+ run_file_against_storage
reload_row
_prep_for_execute
Modified: DBIx-Class/0.08/branches/run_file_against_storage/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/run_file_against_storage/lib/DBIx/Class/Storage/DBI.pm 2009-06-08 22:13:47 UTC (rev 6554)
+++ DBIx-Class/0.08/branches/run_file_against_storage/lib/DBIx/Class/Storage/DBI.pm 2009-06-09 00:17:58 UTC (rev 6555)
@@ -1844,17 +1844,18 @@
=cut
sub run_file_against_storage {
- my ($self, @args) = @_;
- my $fh = $self->_normalize_fh_from_args(@args);
- my @lines = $self->_normalize_lines_from_fh($fh);
- my @statements = $self->_normalize_statements_from_lines(join(' ', @lines));
- return $self->txn_do(sub {
- my @return;
- foreach my $statement (@statements) {
- push @return, $self->_execute_single_statement(@$statement);
- }
- return @return;
- });
+ my ($self, @args) = @_;
+ my $fh = $self->_normalize_fh_from_args(@args);
+ my @lines = $self->_normalize_lines_from_fh($fh);
+ my @statements = $self->_normalize_statements_from_lines(@lines);
+ return $self->txn_do(sub {
+ my @return;
+ foreach my $statement (@statements) {
+ my $single_statement = join(' ',@$statement);
+ push @return, $self->_execute_single_statement($single_statement);
+ }
+ return @return;
+ });
}
=head2 _execute_single_statement ($String|@Strings)
@@ -1864,22 +1865,22 @@
=cut
sub _execute_single_statement {
- my ($self, $statement) = @_;
- if($statement) {
- return $self->dbh_do(sub {
- my ($storage, $dbh, $schema, $statement) = @_;
- $storage->debugobj->query_start("Doing: $statement")
- if $storage->debug;
- $dbh->do($statement)
- || $schema->throw_exception("Can't execute line: $statement, Error: ". $dbh->errstr);
- $storage->debugobj->query_end("Done: $statement")
- if $storage->debug;
- }, $self, $statement);
- } else {
- $self->debugobj("No commands to do!")
- if $self->debug;
- return;
- }
+ my ($self, $statement) = @_;
+ if($statement) {
+ return $self->dbh_do(sub {
+ my ($storage, $dbh, $schema, $statement) = @_;
+ $storage->debugobj->query_start("Doing: $statement")
+ if $storage->debug;
+ $dbh->do($statement)
+ || $schema->throw_exception("Can't execute line: $statement, Error: ". $dbh->errstr);
+ $storage->debugobj->query_end("Done: $statement")
+ if $storage->debug;
+ }, $self, $statement);
+ } else {
+ $self->debugobj("No commands to do!")
+ if $self->debug;
+ return;
+ }
}
=head2 _normalize_fh_from_args (Path::Class::File|String|@Strings)
@@ -1894,11 +1895,11 @@
=cut
sub _normalize_fh_from_args {
- my ($self, @args) = @_;
- my $file = Path::Class::File->new(@args);
- open(my $fh, "<:raw:eol(NATIVE)", $file) ||
- $self->throw_exception("Can't open file '$file'. Error: $!");
- return $fh;
+ my ($self, @args) = @_;
+ my $file = Path::Class::File->new(@args);
+ open(my $fh, "<", $file) ||
+ $self->throw_exception("Can't open file '$file'. Error: $!");
+ return $fh;
}
=head2 _normalize_lines_from_fh ($filehandle)
@@ -1911,38 +1912,38 @@
=cut
sub _normalize_lines_from_fh {
- my ($self, $fh) = @_;
+ my ($self, $fh) = @_;
- my $deliminator=qr{;|.$};
- my $quote=qr{'|"};
- my $quoted=qr{$quote.+?$quote};
- my $block=qr{$quoted|.};
- my $comment = qr{--};
+ my $deliminator=qr{;|.$};
+ my $quote=qr{'|"};
+ my $quoted=qr{$quote.+?$quote};
+ my $block=qr{$quoted|.};
+ my $comment = qr{--};
- my @lines;
- foreach my $line (<$fh>) {
- chomp $line;
- ## Skip if the line is blank, whitespace only or a comment line
- if(!$line || $line=~m/^\s* $comment/x || $line=~m/^\s*$/) {
- next;
- } else {
- ## a line may contain several commands
- my @parts = ($line=~m/$block*?$deliminator/xg);
- ## clean empty or comment only lines
- @parts = grep { $_ && $_ !~m/^\s* $comment/x } @parts;
- ## We are going to wrap it all in a transaction anyway
- @parts = grep { $_ !~ /^(BEGIN|BEGIN TRANSACTION|COMMIT)/m } @parts;
- ## Some cleanup
- @parts = map {
- $_=~s/$deliminator \s*?$comment.*?$//x; ## trim off ending comments
- $_=~s/^\s*//g; ## trim leading whitespace
- $_=~s/\s*$//g; ## trim ending whitespace
- $_
- } @parts;
- push @lines, @parts;
- }
- }
- return @lines;
+ my @lines;
+ foreach my $line (<$fh>) {
+ $line=~s/\n|\r|\r\n|\n\r$//g;
+ ## Skip if the line is blank, whitespace only or a comment line
+ if(!$line || $line=~m/^\s* $comment/x || $line=~m/^\s*$/) {
+ next;
+ } else {
+ ## a line may contain several commands
+ my @parts = ($line=~m/$block*?$deliminator/xg);
+ ## clean empty or comment only lines
+ @parts = grep { $_ && $_ !~m/^\s* $comment/x } @parts;
+ ## We are going to wrap it all in a transaction anyway
+ @parts = grep { $_ !~ /^(BEGIN|BEGIN TRANSACTION|COMMIT)/m } @parts;
+ ## Some cleanup
+ @parts = map {
+ $_=~s/$deliminator \s*?$comment.*?$//x; ## trim off ending comments
+ $_=~s/^\s*//g; ## trim leading whitespace
+ $_=~s/\s*$//g; ## trim ending whitespace
+ $_
+ } @parts;
+ push @lines, @parts;
+ }
+ }
+ return @lines;
}
=head2 _normalize_statements_from_lines (@lines)
@@ -1955,17 +1956,17 @@
=cut
sub _normalize_statements_from_lines {
- my ($self, @lines) = @_;
- my @statements;
- my $statement = [];
- foreach my $line (@lines) {
- push @{$statement}, $line;
- if($line=~m/;$/) {
- push @statements, $statement;
- $statement = [];
- }
- }
- return @statements;
+ my ($self, @lines) = @_;
+ my @statements;
+ my $statement = [];
+ foreach my $line (@lines) {
+ push @{$statement}, $line;
+ if($line=~m/;$/) {
+ push @statements, $statement;
+ $statement = [];
+ }
+ }
+ return @statements;
}
sub DESTROY {
Modified: DBIx-Class/0.08/branches/run_file_against_storage/t/lib/DBICTest.pm
===================================================================
--- DBIx-Class/0.08/branches/run_file_against_storage/t/lib/DBICTest.pm 2009-06-08 22:13:47 UTC (rev 6554)
+++ DBIx-Class/0.08/branches/run_file_against_storage/t/lib/DBICTest.pm 2009-06-09 00:17:58 UTC (rev 6555)
@@ -129,15 +129,7 @@
if ($ENV{"DBICTEST_SQLT_DEPLOY"}) {
$schema->deploy($args);
} else {
- open IN, "t/lib/sqlite.sql";
- my $sql;
- { local $/ = undef; $sql = <IN>; }
- close IN;
- for my $chunk ( split (/;\s*\n+/, $sql) ) {
- if ( $chunk =~ / ^ (?! --\s* ) \S /xm ) { # there is some real sql in the chunk - a non-space at the start of the string which is not a comment
- $schema->storage->dbh->do($chunk) or print "Error on SQL: $chunk\n";
- }
- }
+ $schema->storage->run_file_against_storage(qw/t lib sqlite.sql/);
}
return;
}
More information about the Bast-commits
mailing list