X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FInterBase.pm;h=290851926ea015f9f5ff40185d9716548c161ad3;hb=9633951d0f542434fc4f50b23248094d2ac35836;hp=3abb5044e0d49c94a87468f47e6ab20fca251254;hpb=2680ffe5ad0f994a084b82f1a9b1b4e36615c24f;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/InterBase.pm b/lib/DBIx/Class/Storage/DBI/InterBase.pm index 3abb504..2908519 100644 --- a/lib/DBIx/Class/Storage/DBI/InterBase.pm +++ b/lib/DBIx/Class/Storage/DBI/InterBase.pm @@ -12,17 +12,41 @@ __PACKAGE__->mk_group_accessors(simple => qw/ _auto_incs /); +=head1 NAME + +DBIx::Class::Storage::DBI::InterBase - Driver for the Firebird RDBMS + +=head1 DESCRIPTION + +This class implements autoincrements for Firebird using C, sets the +limit dialect to C and provides preliminary +L support. + +For ODBC support, see L. + +To turn on L support, add: + + on_connect_call => 'datetime_setup' + +to your L. + +=cut + sub _prep_for_execute { my $self = shift; my ($op, $extra_bind, $ident, $args) = @_; - my ($sql, $bind) = $self->next::method (@_); - if ($op eq 'insert') { + my @pk = $ident->primary_columns; + my %pk; + @pk{@pk} = (); + my @auto_inc_cols = grep { my $inserting = $args->[0]{$_}; - $ident->column_info($_)->{is_auto_increment} && ( + ($ident->column_info($_)->{is_auto_increment} + || exists $pk{$_}) + && ( (not defined $inserting) || (ref $inserting eq 'SCALAR' && $$inserting =~ /^null\z/i) @@ -30,24 +54,14 @@ sub _prep_for_execute { } $ident->columns; if (@auto_inc_cols) { - my $auto_inc_cols = - join ', ', - map $self->_quote_column_for_returning($_), @auto_inc_cols; - - $sql .= " RETURNING ($auto_inc_cols)"; + $args->[1]{returning} = \@auto_inc_cols; $self->_auto_incs([]); $self->_auto_incs->[0] = \@auto_inc_cols; } } - return ($sql, $bind); -} - -sub _quote_column_for_returning { - my ($self, $col) = @_; - - return $self->sql_maker->_quote($col); + return $self->next::method(@_); } sub _execute { @@ -94,29 +108,124 @@ sub _sql_maker_opts { return { limit_dialect => 'FirstSkip', %{$self->{_sql_maker_opts}||{}} }; } -sub datetime_parser_type { __PACKAGE__ } +sub _svp_begin { + my ($self, $name) = @_; + + $self->_get_dbh->do("SAVEPOINT $name"); +} + +sub _svp_release { + my ($self, $name) = @_; + + $self->_get_dbh->do("RELEASE SAVEPOINT $name"); +} + +sub _svp_rollback { + my ($self, $name) = @_; + + $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name") +} + +sub _ping { + my $self = shift; + + my $dbh = $self->_dbh or return 0; + + local $dbh->{RaiseError} = 1; + + eval { + $dbh->do('select 1 from rdb$database'); + }; + + return $@ ? 0 : 1; +} + +# We want dialect 3 for new features and quoting to work, DBD::InterBase uses +# dialect 1 (interbase compat) by default. +sub _init { + my $self = shift; + $self->_set_sql_dialect(3); +} + +sub _set_sql_dialect { + my $self = shift; + my $val = shift || 3; + + my $dsn = $self->_dbi_connect_info->[0]; + + return if ref($dsn) eq 'CODE'; + + if ($dsn !~ /ib_dialect=/) { + $self->_dbi_connect_info->[0] = "$dsn;ib_dialect=$val"; + my $connected = defined $self->_dbh; + $self->disconnect; + $self->ensure_connected if $connected; + } +} + +=head2 connect_call_datetime_setup + +Used as: + + on_connect_call => 'datetime_setup' + +In L to set the date and timestamp +formats using: + + $dbh->{ib_time_all} = 'ISO'; + +See L for more details. + +The C data type supports up to 4 digits after the decimal point for +second precision. The full precision is used. + +You will need the L module for inflation to work. -my ($datetime_parser, $datetime_formatter); +For L, this is a noop and sub-second +precision is not currently available. -sub parse_datetime { - shift; - require DateTime::Format::Strptime; - $datetime_parser ||= DateTime::Format::Strptime->new( - pattern => '%a %d %b %Y %r', -# there should be a %Z (TZ) on the end, but it's ambiguous and not parsed - on_error => 'croak', - ); - $datetime_parser->parse_datetime(shift); +=cut + +sub connect_call_datetime_setup { + my $self = shift; + + $self->_get_dbh->{ib_time_all} = 'ISO'; } -sub format_datetime { - shift; - require DateTime::Format::Strptime; - $datetime_formatter ||= DateTime::Format::Strptime->new( - pattern => '%F %H:%M:%S.%4N', - on_error => 'croak', - ); - $datetime_formatter->format_datetime(shift); + +# from MSSQL + +sub build_datetime_parser { + my $self = shift; + my $type = "DateTime::Format::Strptime"; + eval "use ${type}"; + $self->throw_exception("Couldn't load ${type}: $@") if $@; + return $type->new( + pattern => '%Y-%m-%d %H:%M:%S.%4N', # %F %T + on_error => 'croak', + ); } 1; + +=head1 CAVEATS + +=over 4 + +=item * + +C support only works for Firebird versions 2 or greater. To +work with earlier versions, we'll need to figure out how to retrieve the bodies +of C triggers and parse them for the C name. + +=back + +=head1 AUTHOR + +See L and L. + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut