Merge 'trunk' into 'rt_bug_41083'
Jason M. Mills [Tue, 10 Feb 2009 05:30:07 +0000 (05:30 +0000)]
Merged trunk in to rt_bug_t41083 branch via svk merge.

1  2 
lib/DBIx/Class/InflateColumn/DateTime.pm
lib/DBIx/Class/Row.pm
lib/DBIx/Class/Schema.pm
t/66relationship.t

@@@ -19,15 -19,18 +19,15 @@@ columns to be of the datetime, timestam
      starts_when => { data_type => 'datetime' }
    );
  
 -NOTE: You B<must> load C<InflateColumn::DateTime> B<before> C<Core>. See
 -L<DBIx::Class::Manual::Component> for details.
 -
  Then you can treat the specified column as a L<DateTime> object.
  
    print "This event starts the month of ".
      $event->starts_when->month_name();
  
- If you want to set a specific timezone for that field, use:
+ If you want to set a specific timezone and locale for that field, use:
  
    __PACKAGE__->add_columns(
-     starts_when => { data_type => 'datetime', extra => { timezone => "America/Chicago" } }
+     starts_when => { data_type => 'datetime', extra => { timezone => "America/Chicago", locale => "de_DE" } }
    );
  
  If you want to inflate no matter what data_type your column is,
@@@ -107,10 -110,15 +107,15 @@@ sub register_column 
    }
  
    my $timezone;
-   if ( exists $info->{extra} and exists $info->{extra}{timezone} and defined $info->{extra}{timezone} ) {
+   if ( defined $info->{extra}{timezone} ) {
      $timezone = $info->{extra}{timezone};
    }
  
+   my $locale;
+   if ( defined $info->{extra}{locale} ) {
+     $locale = $info->{extra}{locale};
+   }
    my $undef_if_invalid = $info->{datetime_undef_if_invalid};
  
    if ($type eq 'datetime' || $type eq 'date') {
              die "Error while inflating ${value} for ${column} on ${self}: $@"
                if $@ and not $undef_if_invalid;
              $dt->set_time_zone($timezone) if $timezone;
+             $dt->set_locale($locale) if $locale;
              return $dt;
            },
            deflate => sub {
                        and not $floating_tz_ok
                        and not $ENV{DBIC_FLOATING_TZ_OK};
                  $value->set_time_zone($timezone);
+                 $value->set_locale($locale) if $locale;
              }
              $obj->_datetime_parser->$format($value);
            },
diff --combined lib/DBIx/Class/Row.pm
@@@ -263,7 -263,9 +263,9 @@@ sub insert 
    }
  
    my $updated_cols = $source->storage->insert($source, { $self->get_columns });
-   $self->set_columns($updated_cols);
+   foreach my $col (keys %$updated_cols) {
+     $self->store_column($col, $updated_cols->{$col});
+   }
  
    ## PK::Auto
    my @auto_pri = grep {
@@@ -450,6 -452,14 +452,14 @@@ hashref of the relationship, see L<DBIx
  database-level cascade or restrict will take precedence over a
  DBIx-Class-based cascading delete. 
  
+ If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
+ and the transaction subsequently fails, the row object will remain marked as
+ not being in storage. If you know for a fact that the object is still in
+ storage (i.e. by inspecting the cause of the transaction's failure), you can
+ use C<< $obj->in_storage(1) >> to restore consistency between the object and
+ the database. This would allow a subsequent C<< $obj->delete >> to work
+ as expected.
  See also L<DBIx::Class::ResultSet/delete>.
  
  =cut
@@@ -761,24 -771,17 +771,24 @@@ sub set_inflated_columns 
        {
          my $rel = delete $upd->{$key};
          $self->set_from_related($key => $rel);
 -        $self->{_relationship_data}{$key} = $rel;
 +        $self->{_relationship_data}{$key} = $rel;          
        } elsif ($info && $info->{attrs}{accessor}
 -        && $info->{attrs}{accessor} eq 'multi') {
 -          $self->throw_exception(
 -            "Recursive update is not supported over relationships of type multi ($key)"
 -          );
 +        && $info->{attrs}{accessor} eq 'multi'
 +        && ref $upd->{$key} eq 'ARRAY') {
 +        my $others = delete $upd->{$key};
 +        foreach my $rel_obj (@$others) {
 +          if(!Scalar::Util::blessed($rel_obj)) {
 +            $rel_obj = $self->create_related($key, $rel_obj);
 +          }
 +        }
 +        $self->{_relationship_data}{$key} = $others; 
 +#            $related->{$key} = $others;
 +        next;
        }
        elsif ($self->has_column($key)
          && exists $self->column_info($key)->{_inflate_info})
        {
 -        $self->set_inflated_column($key, delete $upd->{$key});
 +        $self->set_inflated_column($key, delete $upd->{$key});          
        }
      }
    }
diff --combined lib/DBIx/Class/Schema.pm
@@@ -89,7 -89,7 +89,7 @@@ loads them into the appropriate Result 
  matching is done by assuming the package name of the ResultSet class
  is the same as that of the Result class.
  
- You will be warned if ResulSet classes are discovered for which there
+ You will be warned if ResultSet classes are discovered for which there
  are no matching Result classes like this:
  
    load_namespaces found ResultSet class $classname with no corresponding Result class
@@@ -208,17 -208,12 +208,16 @@@ sub load_namespaces 
      local *Class::C3::reinitialize = sub { };
      use warnings 'redefine';
  
 -    foreach my $result (keys %results) {
 +    # ensure classes are loaded and fetch properly sorted classes
 +    $class->ensure_class_loaded($_) foreach(values %results);
 +    my @subclass_last = sort { $results{$a}->isa($results{$b}) } keys(%results);
 +    
 +    foreach my $result (@subclass_last) {
        my $result_class = $results{$result};
  
        my $rs_class = delete $resultsets{$result};
        my $rs_set = $result_class->resultset_class;
 +      
        if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
          if($rs_class && $rs_class ne $rs_set) {
            warn "We found ResultSet class '$rs_class' for '$result', but it seems "
          $result_class->resultset_class($rs_class);
        }
  
-       push(@to_register, [ $result_class->source_name, $result_class ]);
+       my $source_name = $result_class->source_name || $result;
+       push(@to_register, [ $source_name, $result_class ]);
      }
    }
  
@@@ -443,6 -440,13 +444,13 @@@ L</create_ddl_dir> or L</deploy>
  For an example of what you can do with this, see 
  L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To Your SQL>.
  
+ Note that sqlt_deploy_hook is called by L</deployment_statements>, which in turn
+ is called before L</deploy>. Therefore the hook can be used only to manipulate
+ the L<SQL::Translator::Schema> object before it is turned into SQL fed to the
+ database. If you want to execute post-deploy statements which can not be generated
+ by L<SQL::Translator>, the currently suggested method is to overload L</deploy>
+ and use L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
  =head1 METHODS
  
  =head2 connect
@@@ -576,6 -580,14 +584,14 @@@ See L<DBIx::Class::Storage/"txn_do"> fo
  This interface is preferred over using the individual methods L</txn_begin>,
  L</txn_commit>, and L</txn_rollback> below.
  
+ WARNING: If you are connected with C<AutoCommit => 0> the transaction is
+ considered nested, and you will still need to call L</txn_commit> to write your
+ changes when appropriate. You will also want to connect with C<auto_savepoint =>
+ 1> to get partial rollback to work, if the storage driver for your database
+ supports it.
+ Connecting with C<AutoCommit => 1> is recommended.
  =cut
  
  sub txn_do {
@@@ -711,26 -723,15 +727,15 @@@ wantarray context if you want the PKs a
  
  sub populate {
    my ($self, $name, $data) = @_;
-   my $rs = $self->resultset($name);
-   my @names = @{shift(@$data)};
-   if(defined wantarray) {
-     my @created;
-     foreach my $item (@$data) {
-       my %create;
-       @create{@names} = @$item;
-       push(@created, $rs->create(\%create));
+   if(my $rs = $self->resultset($name)) {
+     if(defined wantarray) {
+         return $rs->populate($data);
+     } else {
+         $rs->populate($data);
      }
-     return @created;
-   }
-   my @results_to_create;
-   foreach my $datum (@$data) {
-     my %result_to_create;
-     foreach my $index (0..$#names) {
-       $result_to_create{$names[$index]} = $$datum[$index];
-     }
-     push @results_to_create, \%result_to_create;
+   } else {
+       $self->throw_exception("$name is not a resultset"); 
    }
-   $rs->populate(\@results_to_create);
  }
  
  =head2 connection
@@@ -1243,7 -1244,7 +1248,7 @@@ sub register_extra_source 
  sub _register_source {
    my ($self, $moniker, $source, $params) = @_;
  
-   %$source = %{ $source->new( { %$source, source_name => $moniker }) };
+   $source = $source->new({ %$source, source_name => $moniker });
  
    my %reg = %{$self->source_registrations};
    $reg{$moniker} = $source;
diff --combined t/66relationship.t
@@@ -8,7 -8,7 +8,7 @@@ use DBICTest
  
  my $schema = DBICTest->init_schema();
  
- plan tests => 72;
+ plan tests => 74;
  
  # has_a test
  my $cd = $schema->resultset("CD")->find(4);
@@@ -41,7 -41,20 +41,20 @@@ if ($INC{'DBICTest/HelperRels.pm'}) 
    } );
  }
  
- is( ($artist->search_related('cds'))[3]->title, 'Big Flop', 'create_related ok' );
+ my $big_flop_cd = ($artist->search_related('cds'))[3];
+ is( $big_flop_cd->title, 'Big Flop', 'create_related ok' );
+ { # make sure we are not making pointless select queries when a FK IS NULL
+   my $queries = 0;
+   $schema->storage->debugcb(sub { $queries++; });
+   $schema->storage->debug(1);
+   $big_flop_cd->genre; #should not trigger a select query
+   is($queries, 0, 'No SELECT made for belongs_to if key IS NULL');
+   $big_flop_cd->genre_inefficient; #should trigger a select query
+   is($queries, 1, 'SELECT made for belongs_to if key IS NULL when undef_on_null_fk disabled');
+   $schema->storage->debug(0);
+   $schema->storage->debugcb(undef);
+ }
  
  my( $rs_from_list ) = $artist->search_related_rs('cds');
  is( ref($rs_from_list), 'DBIx::Class::ResultSet', 'search_related_rs in list context returns rs' );
@@@ -262,6 -275,8 +275,6 @@@ is ($@, '', 'Staged insertion successfu
  ok($new_artist->in_storage, 'artist inserted');
  ok($new_related_cd->in_storage, 'new_related_cd inserted');
  
 -TODO: {
 -local $TODO = "TODOify for multicreate branch";
  my $new_cd = $schema->resultset("CD")->new_result({});
  my $new_related_artist = $new_cd->new_related('artist', { 'name' => 'Marillion',});
  lives_ok (
@@@ -285,3 -300,4 +298,3 @@@ cmp_ok($relinfo->{attrs}{is_foreign_key
  my $rs_overridden = $schema->source('ForceForeign');
  my $relinfo_with_attr = $rs_overridden->relationship_info ('cd_3');
  cmp_ok($relinfo_with_attr->{attrs}{is_foreign_key_constraint}, '==', 0, "is_foreign_key_constraint defined for belongs_to relationships with attr.");
 -}