[Bast-commits] r6548 - in DBIx-Class/0.08/branches: .
run_file_against_storage
run_file_against_storage/lib/DBIx/Class/Storage
run_file_against_storage/t/lib/DBICTest
jnapiorkowski at dev.catalyst.perl.org
jnapiorkowski at dev.catalyst.perl.org
Mon Jun 8 21:08:42 GMT 2009
Author: jnapiorkowski
Date: 2009-06-08 21:08:42 +0000 (Mon, 08 Jun 2009)
New Revision: 6548
Added:
DBIx-Class/0.08/branches/run_file_against_storage/
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/t/lib/DBICTest/AuthorCheck.pm
Log:
more details in the AuthorCheck.pm to help newcomers understand why they are being threatened
Copied: DBIx-Class/0.08/branches/run_file_against_storage (from rev 6547, DBIx-Class/0.08/trunk)
Property changes on: DBIx-Class/0.08/branches/run_file_against_storage
___________________________________________________________________
Name: svn:ignore
+ _build
blib
pm_to_blib
Build
Build.bat
Makefile
Makefile.old
inc
README
META.yml
MANIFEST
MANIFEST.bak
Name: svn:mergeinfo
+
Name: svk:merge
+ 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/resultsetcolumn_custom_columns:5160
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/sqla_1.50_compat:5414
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/trunk:5969
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:54993
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_column_attr:10946
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_trunk:11142
bd5ac9a7-f185-4d95-9186-dbb8b392a572:/local/os/bast/DBIx-Class/0.08/trunk:2798
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/belongs_to_null_col_fix:5244
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/cdbicompat_integration:4160
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/column_attr:5074
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/complex_join_rels:4589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/count_distinct:6218
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/diamond_relationships:6310
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/file_column:3920
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/fix-update-and-delete-as_query:6162
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/joined_count:6323
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multi_stuff:5565
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle-tweaks:6222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/order_by_refactor:6475
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch:5699
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/replication_dedux:4600
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rt_bug_41083:5437
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/savepoints:4223
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sqla_1.50_compat:5321
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-ms-access:4142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-tweaks:6262
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subclassed_rsset:5930
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subquery:5617
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase:5651
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_mssql:6125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/top_limit_altfix:6429
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioned_enhancements:4125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioning:4578
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/views:5585
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
fe160bb6-dc1c-0410-9f2b-d64a711b54a5:/local/DBIC-trunk-0.08:10510
Modified: DBIx-Class/0.08/branches/run_file_against_storage/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2009-06-08 19:46:24 UTC (rev 6547)
+++ DBIx-Class/0.08/branches/run_file_against_storage/lib/DBIx/Class/Storage/DBI.pm 2009-06-08 21:08:42 UTC (rev 6548)
@@ -9,6 +9,7 @@
use DBI;
use DBIx::Class::Storage::DBI::Cursor;
use DBIx::Class::Storage::Statistics;
+use Path::Class::File ();
use Scalar::Util qw/blessed weaken/;
use List::Util();
@@ -1826,6 +1827,147 @@
return;
}
+=head2 run_file_against_storage (Path::Class::File|String|@Strings)
+
+Given a path to file, will try to execute it line by line against the connected
+database engine. Throws an exception and tries to rollback if an error occurs.
+
+Will normalize the contents of the file to strip comments and properly deal
+with command scattered across several lines.
+
+Will accept either a L<Path::Class::File> object or a string or array that we
+can use to create one.
+
+Returns an array of whatever comes back from executing each statement. Should
+be true if the script executes anything at all.
+
+=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;
+ });
+}
+
+=head2 _execute_single_statement ($String|@Strings)
+
+Given a SQL statement, do our best to safely execute it.
+
+=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;
+ }
+}
+
+=head2 _normalize_fh_from_args (Path::Class::File|String|@Strings)
+
+Given some args, return a $filehandle that is an open read filehandle object
+based on the args. Accepts a L<Path::Class::File> object or arguments suitable
+for constructing one.
+
+Returns a filehandle whose end of line characters have been normalized to the
+running platform.
+
+=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;
+}
+
+=head2 _normalize_lines_from_fh ($filehandle)
+
+Given a $filehandle, will return an array of normalized lines statement that we
+can group into statements. We do our best to strip out comment lines, blank
+lines and anything else that might cause an error. We also split lines based
+on the ';' deliminator, since that's pretty standard.
+
+=cut
+
+sub _normalize_lines_from_fh {
+ my ($self, $fh) = @_;
+
+ 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;
+}
+
+=head2 _normalize_statements_from_lines (@lines)
+
+Give an array of lines, group them into whole statements. This is to handle
+how a given statement might have been broken across multiple lines
+
+Returns an array of arrayrefs.
+
+=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;
+}
+
sub DESTROY {
my $self = shift;
return if !$self->_dbh;
Modified: DBIx-Class/0.08/branches/run_file_against_storage/t/lib/DBICTest/AuthorCheck.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/DBICTest/AuthorCheck.pm 2009-06-08 19:46:24 UTC (rev 6547)
+++ DBIx-Class/0.08/branches/run_file_against_storage/t/lib/DBICTest/AuthorCheck.pm 2009-06-08 21:08:42 UTC (rev 6548)
@@ -34,14 +34,22 @@
);
return unless $mf_pl_mtime; # something went wrong during co_root detection ?
+
+ my @reasons;
+
+ if(not -d $root->subdir ('inc')) {
+ push @reasons, "Missing inc directory";
+ }
+
+ if(not $mf_mtime) {
+ push @reasons, "Missing Makefile";
+ }
- if (
- not -d $root->subdir ('inc')
- or
- not $mf_mtime
- or
- $mf_mtime < $mf_pl_mtime
- ) {
+ if($mf_mtime < $mf_pl_mtime) {
+ push @reasons, "Makefile.PL is newer than Makefile";
+ }
+
+ if (@reasons) {
print STDERR <<'EOE';
@@ -71,10 +79,14 @@
The DBIC team
+EOE
+ print STDERR "Reasons you received this message:\n\n";
+ foreach my $reason (@reasons) {
+ print STDERR "\t* $reason\n";
+ }
+ print STDERR "\n\n";
-EOE
-
exit 1;
}
}
More information about the Bast-commits
mailing list