Merge 'trunk' into 'on_connect_call'
Rafael Kitover [Fri, 12 Jun 2009 00:06:35 +0000 (00:06 +0000)]
r5467@hlagh (orig r6614):  ribasushi | 2009-06-11 05:29:48 -0700
Move around inflation tests
r5468@hlagh (orig r6615):  ribasushi | 2009-06-11 05:32:07 -0700
explicitly remove manifest on author mode make
r5469@hlagh (orig r6616):  ribasushi | 2009-06-11 06:02:41 -0700
IC::DT changes:
Switch SQLite storage to DT::F::SQLite
Fix exception when undef_if_invalid and timezone are both set on a column
Split t/89inflate_datetime into separate tests
Adjust makefile author dependencies
r5470@hlagh (orig r6617):  ribasushi | 2009-06-11 06:07:41 -0700
Move file_column test to inflate/ too
r5472@hlagh (orig r6620):  ribasushi | 2009-06-11 07:16:20 -0700
 r5713@Thesaurus (orig r5712):  ribasushi | 2009-03-08 23:53:28 +0100
 Branch for datatype-aware updates
 r6604@Thesaurus (orig r6603):  ribasushi | 2009-06-10 18:08:25 +0200
 Test for type-aware update
 r6607@Thesaurus (orig r6606):  ribasushi | 2009-06-10 19:57:04 +0200
 Datatype aware update works
 r6609@Thesaurus (orig r6608):  ribasushi | 2009-06-10 20:06:40 +0200
 Whoops
 r6614@Thesaurus (orig r6613):  ribasushi | 2009-06-11 09:23:54 +0200
 Add attribute doc
 r6620@Thesaurus (orig r6619):  ribasushi | 2009-06-11 16:15:53 +0200
 Use equality, not comparison

r5474@hlagh (orig r6622):  ribasushi | 2009-06-11 07:21:53 -0700
Changes
r5486@hlagh (orig r6635):  ribasushi | 2009-06-11 12:29:10 -0700
Release 0.08105
r5487@hlagh (orig r6636):  frew | 2009-06-11 13:02:11 -0700
Escape filename so that t\9... won't look like octal
r5488@hlagh (orig r6637):  ribasushi | 2009-06-11 13:09:55 -0700
Adjust tests for the DT::F::MySQL -> DT::F::SQLite change
r5489@hlagh (orig r6638):  arcanez | 2009-06-11 13:29:53 -0700
cookbook tweak for count distinct
r5490@hlagh (orig r6639):  ribasushi | 2009-06-11 14:39:12 -0700
Factor out as_query properly
r5491@hlagh (orig r6640):  ribasushi | 2009-06-11 14:50:41 -0700
Release 0.08106
r5493@hlagh (orig r6642):  caelum | 2009-06-11 16:48:28 -0700
add support for DBICTEST_MSSQL_PERL5LIB to 74mssql.t

1  2 
lib/DBIx/Class/Storage/DBI.pm

@@@ -14,14 -14,13 +14,14 @@@ use List::Util()
  
  __PACKAGE__->mk_group_accessors('simple' =>
      qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
 -       _conn_pid _conn_tid transaction_depth _dbh_autocommit savepoints/
 +       _conn_pid _conn_tid transaction_depth _dbh_autocommit _on_connect_do
 +       _on_disconnect_do savepoints/
  );
  
  # the values for these accessors are picked out (and deleted) from
  # the attribute hashref passed to connect_info
  my @storage_options = qw/
 -  on_connect_do on_disconnect_do disable_sth_caching unsafe auto_savepoint
 +  on_connect_call on_disconnect_call disable_sth_caching unsafe auto_savepoint
  /;
  __PACKAGE__->mk_group_accessors('simple' => @storage_options);
  
@@@ -178,68 -177,6 +178,68 @@@ immediately before disconnecting from t
  Note, this only runs if you explicitly call L</disconnect> on the
  storage object.
  
 +=item on_connect_call
 +
 +A more generalized form of L</on_connect_do> that calls the specified
 +C<connect_call_METHOD> methods in your storage driver.
 +
 +  on_connect_do => 'select 1'
 +
 +is equivalent to:
 +
 +  on_connect_call => [ [ do_sql => 'select 1' ] ]
 +
 +Its values may contain:
 +
 +=over
 +
 +=item a scalar
 +
 +Will call the C<connect_call_METHOD> method.
 +
 +=item a code reference
 +
 +Will execute C<< $code->($storage) >>
 +
 +=item an array reference
 +
 +Each value can be a method name or code reference.
 +
 +=item an array of arrays
 +
 +For each array, the first item is taken to be the C<connect_call_> method name
 +or code reference, and the rest are parameters to it.
 +
 +=back
 +
 +Some predefined storage methods you may use:
 +
 +=over
 +
 +=item do_sql
 +
 +Executes a SQL string or a code reference that returns a SQL string. This is
 +what L</on_connect_do> and L</on_disconnect_do> use.
 +
 +=item set_datetime_format
 +
 +Execute any statements necessary to initialize the database session to return
 +and accept datetime/timestamp values used with
 +L<DBIx::Class::InflateColumn::DateTime>.
 +
 +=back
 +
 +=item on_disconnect_call
 +
 +Takes arguments in the same form as L</on_connect_call> and executes them
 +immediately before disconnecting from the database.
 +
 +Calls the C<disconnect_call_METHOD> methods as opposed to the
 +C<connect_call_METHOD> methods called by L</on_connect_call>.
 +
 +Note, this only runs if you explicitly call L</disconnect> on the
 +storage object.
 +
  =item disable_sth_caching
  
  If set to a true value, this option will disable the caching of
@@@ -410,11 -347,6 +410,11 @@@ sub connect_info 
          $self->_sql_maker_opts->{$sql_maker_opt} = $opt_val;
        }
      }
 +    for my $connect_do_opt (qw/on_connect_do on_disconnect_do/) {
 +      if(my $opt_val = delete $attrs{$connect_do_opt}) {
 +        $self->$connect_do_opt($opt_val);
 +      }
 +    }
    }
  
    %attrs = () if (ref $args[0] eq 'CODE');  # _connect() never looks past $args[0] in this case
  
  This method is deprecated in favour of setting via L</connect_info>.
  
 +=cut
 +
 +sub on_connect_do {
 +  my $self = shift;
 +  $self->_setup_connect_do(on_connect_do => @_);
 +}
 +
 +=head2 on_disconnect_do
 +
 +This method is deprecated in favour of setting via L</connect_info>.
 +
 +=cut
 +
 +sub on_disconnect_do {
 +  my $self = shift;
 +  $self->_setup_connect_do(on_disconnect_do => @_);
 +}
 +
 +sub _setup_connect_do {
 +  my ($self, $opt) = (shift, shift);
 +
 +  my $accessor = "_$opt";
 +
 +  return $self->$accessor if not @_;
 +
 +  my $val = shift;
 +
 +  (my $call = $opt) =~ s/_do\z/_call/;
 +
 +  if (ref($self->$call) ne 'ARRAY') {
 +    $self->$call([
 +      defined $self->$call ?  $self->$call : ()
 +    ]);
 +  }
 +
 +  if (not ref($val)) {
 +    push @{ $self->$call }, [ 'do_sql', $val ];
 +  } elsif (ref($val) eq 'CODE') {
 +    push @{ $self->$call }, $val;
 +  } elsif (ref($val) eq 'ARRAY') {
 +    push @{ $self->$call },
 +    map [ 'do_sql', $_ ], @$val;
 +  } else {
 +    $self->throw_exception("Invalid type for $opt ".ref($val));
 +  }
 +
 +  $self->$accessor($val);
 +}
  
  =head2 dbh_do
  
@@@ -622,9 -506,8 +622,9 @@@ sub disconnect 
    my ($self) = @_;
  
    if( $self->connected ) {
 -    my $connection_do = $self->on_disconnect_do;
 -    $self->_do_connection_actions($connection_do) if ref($connection_do);
 +    my $connection_call = $self->on_disconnect_call;
 +    $self->_do_connection_actions(disconnect_call_ => $connection_call)
 +      if $connection_call;
  
      $self->_dbh->rollback unless $self->_dbh_autocommit;
      $self->_dbh->disconnect;
@@@ -741,9 -624,8 +741,9 @@@ sub _populate_dbh 
    #  there is no transaction in progress by definition
    $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
  
 -  my $connection_do = $self->on_connect_do;
 -  $self->_do_connection_actions($connection_do) if $connection_do;
 +  my $connection_call = $self->on_connect_call;
 +  $self->_do_connection_actions(connect_call_ => $connection_call)
 +    if $connection_call;
  }
  
  sub _determine_driver {
  }
  
  sub _do_connection_actions {
 -  my $self = shift;
 -  my $connection_do = shift;
 -
 -  if (!ref $connection_do) {
 -    $self->_do_query($connection_do);
 -  }
 -  elsif (ref $connection_do eq 'ARRAY') {
 -    $self->_do_query($_) foreach @$connection_do;
 -  }
 -  elsif (ref $connection_do eq 'CODE') {
 -    $connection_do->($self);
 -  }
 -  else {
 -    $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref $connection_do) );
 +  my $self          = shift;
 +  my $method_prefix = shift;
 +  my $call          = shift;
 +
 +  if (not ref($call)) {
 +    my $method = $method_prefix . $call;
 +    $self->$method(@_);
 +  } elsif (ref($call) eq 'CODE') {
 +    $self->$call(@_);
 +  } elsif (ref($call) eq 'ARRAY') {
 +    if (ref($call->[0]) ne 'ARRAY') {
 +      $self->_do_connection_actions($method_prefix, $_) for @$call;
 +    } else {
 +      $self->_do_connection_actions($method_prefix, @$_) for @$call;
 +    }
 +  } else {
 +    $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) );
    }
  
    return $self;
  }
  
 +sub connect_call_do_sql {
 +  my $self = shift;
 +  $self->_do_query(@_);
 +}
 +
 +sub disconnect_call_do_sql {
 +  my $self = shift;
 +  $self->_do_query(@_);
 +}
 +
 +# override in db-specific backend when necessary
 +sub connect_call_set_datetime_format { 1 }
 +
  sub _do_query {
    my ($self, $action) = @_;
  
@@@ -1044,37 -910,6 +1044,6 @@@ sub _prep_for_execute 
    return ($sql, \@bind);
  }
  
- =head2 as_query
- =over 4
- =item Arguments: $rs_attrs
- =item Return Value: \[ $sql, @bind ]
- =back
- Returns the SQL statement and bind vars that would result from the given
- ResultSet attributes (does not actually run a query)
- =cut
- sub as_query {
-   my ($self, $rs_attr) = @_;
-   my $sql_maker = $self->sql_maker;
-   local $sql_maker->{for};
-   # my ($op, $bind, $ident, $bind_attrs, $select, $cond, $order, $rows, $offset) = $self->_select_args(...);
-   my @args = $self->_select_args($rs_attr->{from}, $rs_attr->{select}, $rs_attr->{where}, $rs_attr);
-   # my ($sql, $bind) = $self->_prep_for_execute($op, $bind, $ident, [ $select, $cond, $order, $rows, $offset ]);
-   my ($sql, $bind) = $self->_prep_for_execute(
-     @args[0 .. 2],
-     [ @args[4 .. $#args] ],
-   );
-   return \[ "($sql)", @{ $bind || [] }];
- }
  
  sub _fix_bind_params {
      my ($self, @bind) = @_;
@@@ -1361,6 -1196,23 +1330,23 @@@ sub _select 
    return $self->_execute($self->_select_args(@_));
  }
  
+ sub _select_args_to_query {
+   my $self = shift;
+   my $sql_maker = $self->sql_maker;
+   local $sql_maker->{for};
+   # my ($op, $bind, $ident, $bind_attrs, $select, $cond, $order, $rows, $offset) 
+   #  = $self->_select_args($ident, $select, $cond, $attrs);
+   my ($op, $bind, $ident, $bind_attrs, @args) =
+     $self->_select_args(@_);
+   # my ($sql, $bind) = $self->_prep_for_execute($op, $bind, $ident, [ $select, $cond, $order, $rows, $offset ]);
+   my ($sql, $prepared_bind) = $self->_prep_for_execute($op, $bind, $ident, \@args);
+   return \[ "($sql)", @{ $prepared_bind || [] }];
+ }
  sub _select_args {
    my ($self, $ident, $select, $condition, $attrs) = @_;
  
@@@ -1693,6 -1545,27 +1679,27 @@@ sub bind_attribute_by_data_type 
      return;
  }
  
+ =head2 is_datatype_numeric
+ Given a datatype from column_info, returns a boolean value indicating if
+ the current RDBMS considers it a numeric value. This controls how
+ L<DBIx::Class::Row/set_column> decides whether to mark the column as
+ dirty - when the datatype is deemed numeric a C<< != >> comparison will
+ be performed instead of the usual C<eq>.
+ =cut
+ sub is_datatype_numeric {
+   my ($self, $dt) = @_;
+   return 0 unless $dt;
+   return $dt =~ /^ (?:
+     numeric | int(?:eger)? | (?:tiny|small|medium|big)int | dec(?:imal)? | real | float | double (?: \s+ precision)? | (?:big)?serial
+   ) $/ix;
+ }
  =head2 create_ddl_dir (EXPERIMENTAL)
  
  =over 4