X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=71c14aa0cb2eff504a23976410928ac62629eec2;hb=2292193a0a06c16f24edebe15660e53119f9f15e;hp=931dd218d2a5104a3aea5fcbc94102e6d85e560d;hpb=099049b53886d1ca65db05e3dcfdd1ce0dd11679;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 931dd21..71c14aa 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -29,10 +29,36 @@ sub new { $self; } +sub _RowNumberOver { + my ($self, $sql, $order, $rows, $offset ) = @_; + + $offset += 1; + my $last = $rows + $offset; + my ( $order_by ) = $self->_order_by( $order ); + + $sql = <<""; +SELECT * FROM +( + SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM ( + $sql + $order_by + ) Q1 +) Q2 +WHERE ROW_NUM BETWEEN $offset AND $last + + return $sql; +} + + # While we're at it, this should make LIMIT queries more efficient, # without digging into things too deeply sub _find_syntax { my ($self, $syntax) = @_; + my $dbhname = ref $syntax eq 'HASH' ? $syntax->{Driver}{Name} : ''; + if(ref($self) && $dbhname && $dbhname eq 'DB2') { + return 'RowNumberOver'; + } + $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax); } @@ -275,7 +301,9 @@ This class represents the connection to the database =cut sub new { - my $new = bless({}, ref $_[0] || $_[0]); + my $new = {}; + bless $new, (ref $_[0] || $_[0]); + $new->cursor("DBIx::Class::Storage::DBI::Cursor"); $new->transaction_depth(0); @@ -800,6 +828,12 @@ sub _select { =head2 select +=over 4 + +=item Arguments: $ident, $select, $condition, $attrs + +=back + Handle a SQL select statement. =cut @@ -829,6 +863,12 @@ sub select_single { =head2 sth +=over 4 + +=item Arguments: $sql + +=back + Returns a L sth (statement handle) for the supplied SQL. =cut @@ -841,7 +881,7 @@ sub sth { =head2 columns_info_for -Returns database type info for a given table columns. +Returns database type info for a given table column. =cut @@ -852,20 +892,13 @@ sub columns_info_for { if ($dbh->can('column_info')) { my %result; - my $old_raise_err = $dbh->{RaiseError}; - my $old_print_err = $dbh->{PrintError}; - $dbh->{RaiseError} = 1; - $dbh->{PrintError} = 0; + local $dbh->{RaiseError} = 1; + local $dbh->{PrintError} = 0; eval { my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table); my $sth = $dbh->column_info( undef,$schema, $tab, '%' ); $sth->execute(); - # Some error occured or there is no information: - if($sth->rows <1) { - die "column_info returned no rows for $schema, $tab"; - } - while ( my $info = $sth->fetchrow_hashref() ){ my %column_info; $column_info{data_type} = $info->{TYPE_NAME}; @@ -878,9 +911,7 @@ sub columns_info_for { $result{$col_name} = \%column_info; } }; - $dbh->{RaiseError} = $old_raise_err; - $dbh->{PrintError} = $old_print_err; - return \%result if !$@; + return \%result if !$@ && scalar keys %result; } my %result; @@ -939,7 +970,7 @@ sub sqlt_type { shift->dbh->{Driver}->{Name} } =back -Creates an SQL file based on the Schema, for each of the specified +Creates a SQL file based on the Schema, for each of the specified database types, in the given directory. Note that this feature is currently EXPERIMENTAL and may not work correctly @@ -999,8 +1030,24 @@ sub create_ddl_dir =head2 deployment_statements -Create the statements for L and -L. +=over 4 + +=item Arguments: $schema, $type, $version, $directory, $sqlt_args + +=back + +Returns the statements used by L and L. +The database driver name is given by C<$type>, though the value from +L is used if it is not specified. + +C<$directory> is used to return statements from files in a previously created +L directory and is optional. The filenames are constructed +from L, the schema name and the C<$version>. + +If no C<$directory> is specified then the statements are constructed on the +fly using L and C<$version> is ignored. + +See L for a list of values for C<$sqlt_args>. =cut @@ -1049,8 +1096,8 @@ L. =cut sub deploy { - my ($self, $schema, $type, $sqltargs) = @_; - foreach my $statement ( $self->deployment_statements($schema, $type, undef, undef, { no_comments => 1, %{ $sqltargs || {} } } ) ) { + my ($self, $schema, $type, $sqltargs, $dir) = @_; + foreach my $statement ( $self->deployment_statements($schema, $type, undef, $dir, { no_comments => 1, %{ $sqltargs || {} } } ) ) { for ( split(";\n", $statement)) { next if($_ =~ /^--/); next if(!$_); @@ -1099,7 +1146,17 @@ sub build_datetime_parser { return $type; } -sub DESTROY { shift->disconnect } +sub DESTROY { + # NOTE: if there's a merge conflict here when -current is pushed + # back to trunk, take -current's version and ignore this trunk one :) + my $self = shift; + + if($self->_dbh && $self->_conn_pid != $$) { + $self->_dbh->{InactiveDestroy} = 1; + } + + $self->_dbh(undef); +} 1; @@ -1168,4 +1225,3 @@ Andy Grundman You may distribute this code under the same terms as Perl itself. =cut -