Merge 'trunk' into 'DBIx-Class-current'
Matt S Trout [Thu, 18 May 2006 13:19:02 +0000 (13:19 +0000)]
r8675@cain (orig r1649):  castaway | 2006-05-17 09:28:27 +0000
Documentation updates

r8676@cain (orig r1650):  zarquon | 2006-05-17 09:49:18 +0000
optimised last_insert_id example for searching
r8691@cain (orig r1659):  castaway | 2006-05-18 09:48:30 +0000
Add pod for params of inflate/deflate coderefs

1  2 
lib/DBIx/Class/Manual/Cookbook.pod
lib/DBIx/Class/Relationship.pm
lib/DBIx/Class/ResultSet.pm

@@@ -786,64 -786,17 +786,77 @@@ It is possible to get a Schema object f
  This can be useful when you don't want to pass around a Schema object to every
  method.
  
 +=head2 Profiling
 +
 +When you enable L<DBIx::Class::Storage::DBI>'s debugging it prints the SQL
 +executed as well as notifications of query completion and transaction
 +begin/commit.  If you'd like to profile the SQL you can subclass the
 +L<DBIx::Class::Storage::Statistics> class and write your own profiling
 +mechanism:
 +
 +  package My::Profiler;
 +  use strict;
 +
 +  use base 'DBIx::Class::Storage::Statistics';
 +
 +  use Time::HiRes qw(time);
 +
 +  my $start;
 +
 +  sub query_start {
 +    my $self = shift();
 +    my $sql = shift();
 +    my $params = @_;
 +
 +    print "Executing $sql: ".join(', ', @params)."\n";
 +    $start = time();
 +  }
 +
 +  sub query_end {
 +    my $self = shift();
 +    my $sql = shift();
 +    my @params = @_;
 +
 +    printf("Execution took %0.4f seconds.\n", time() - $start);
 +    $start = undef;
 +  }
 +
 +  1;
 +
 +You can then install that class as the debugging object:
 +
 +  __PACKAGE__->storage()->debugobj(new My::Profiler());
 +  __PACKAGE__->storage()->debug(1);
 +
 +A more complicated example might involve storing each execution of SQL in an
 +array:
 +
 +  sub query_end {
 +    my $self = shift();
 +    my $sql = shift();
 +    my @params = @_;
 +
 +    my $elapsed = time() - $start;
 +    push(@{ $calls{$sql} }, {
 +        params => \@params,
 +        elapsed => $elapsed
 +    });
 +  }
 +
 +You could then create average, high and low execution times for an SQL
 +statement and dig down to see if certain parameters cause aberrant behavior.
 +
+ =head2 Getting the value of the primary key for the last database insert
+ AKA getting last_insert_id
+ If you are using PK::Auto, this is straightforward:
+   my $foo = $rs->create(\%blah);
+   # do more stuff
+   my $id = $foo->id; # foo->my_primary_key_field will also work.
+ If you are not using autoincrementing primary keys, this will probably
+ not work, but then you already know the value of the last primary key anyway.
  =cut
@@@ -118,6 -118,9 +118,9 @@@ instead of a join condition hash, that 
  holding the foreign key. If $cond is not given, the relname is used as
  the column name.
  
+ Cascading deletes are off per default on a C<belongs_to> relationship, to turn
+ them on, pass C<< cascade_delete => 1 >> in the $attr hashref.
  NOTE: If you are used to L<Class::DBI> relationships, this is the equivalent
  of C<has_a>.
  
      { prefetch => [qw/book/],
    });
    my @book_objs = $obj->books;
 +  my $books_rs = $obj->books;
 +  ( $books_rs ) = $obj->books_rs;
  
    $obj->add_to_books(\%col_data);
  
@@@ -141,18 -142,14 +144,19 @@@ foreign class store the calling class'
  columns. You should pass the name of the column in the foreign class as the
  $cond argument, or specify a complete join condition.
  
 -As well as the accessor method, a method named C<< add_to_<relname> >>
 -will also be added to your Row items, this allows you to insert new
 -related items, using the same mechanism as in L<DBIx::Class::Relationship::Base/"create_related">.
 +Three methods are created when you create a has_many relationship.  The first
 +method is the expected accessor method.  The second is almost exactly the same
 +as the accessor method but "_rs" is added to the end of the method name.  This
 +method works just like the normal accessor, except that it returns a resultset
 +no matter what, even in list context. The third method, named
 +C<< add_to_<relname> >>, will also be added to your Row items, this allows
 +you to insert new related items, using the same mechanism as in
 +L<DBIx::Class::Relationship::Base/"create_related">.
  
  If you delete an object in a class with a C<has_many> relationship, all
- related objects will be deleted as well. However, any database-level
- cascade or restrict will take precedence.
+ the related objects will be deleted as well. However, any database-level
+ cascade or restrict will take precedence. To turn this behavior off, pass
+ C<< cascade_delete => 0 >> in the $attr hashref.
  
  =head2 might_have
  
@@@ -167,6 -164,7 +171,7 @@@ key of the foreign class unless $cond s
  If you update or delete an object in a class with a C<might_have>
  relationship, the related object will be updated or deleted as well.
  Any database-level update or delete constraints will override this behaviour.
+ To turn off this behavior, add C<< cascade_delete => 0 >> to the $attr hashref.
  
  =head2 has_one
  
@@@ -10,7 -10,6 +10,7 @@@ use Data::Page
  use Storable;
  use Scalar::Util qw/weaken/;
  
 +use DBIx::Class::ResultSetColumn;
  use base qw/DBIx::Class/;
  __PACKAGE__->load_components(qw/AccessorGroup/);
  __PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/);
@@@ -196,28 -195,7 +196,28 @@@ call it as C<search(undef, \%attrs)>
  
  sub search {
    my $self = shift;
 -    
 +  my $rs = $self->search_rs( @_ );
 +  return (wantarray ? $rs->all : $rs);
 +}
 +
 +=head2 search_rs
 +
 +=over 4
 +
 +=item Arguments: $cond, \%attrs?
 +
 +=item Return Value: $resultset
 +
 +=back
 +
 +This method does the same exact thing as search() except it will 
 +always return a resultset, even in list context.
 +
 +=cut
 +
 +sub search_rs {
 +  my $self = shift;
 +
    my $attrs = { %{$self->{attrs}} };
    my $having = delete $attrs->{having};
    $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH';
      }
    }
    
 -  return (wantarray ? $rs->all : $rs);
 +  return $rs;
  }
  
  =head2 search_literal
@@@ -293,17 -271,12 +293,17 @@@ sub search_literal 
  
  =back
  
 -Finds a row based on its primary key or unique constraint. For example:
 +Finds a row based on its primary key or unique constraint. For example, to find
 +a row by its primary key:
  
    my $cd = $schema->resultset('CD')->find(5);
  
 -Also takes an optional C<key> attribute, to search by a specific key or unique
 -constraint. For example:
 +You can also find a row by a specific unique constraint using the C<key>
 +attribute. For example:
 +
 +  my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', { key => 'artist_title' });
 +
 +Additionally, you can specify the columns explicitly by name:
  
    my $cd = $schema->resultset('CD')->find(
      {
      { key => 'artist_title' }
    );
  
 -See also L</find_or_create> and L</update_or_create>.
 +If no C<key> is specified and you explicitly name columns, it searches on all
 +unique constraints defined on the source, including the primary key.
 +
 +If the C<key> is specified as C<primary>, it searches only on the primary key.
 +
 +See also L</find_or_create> and L</update_or_create>. For information on how to
 +declare unique constraints, see
 +L<DBIx::Class::ResultSource/add_unique_constraint>.
  
  =cut
  
  sub find {
 -  my ($self, @vals) = @_;
 -  my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
 +  my $self = shift;
 +  my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
  
 -  my @cols = $self->result_source->primary_columns;
 -  if (exists $attrs->{key}) {
 -    my %uniq = $self->result_source->unique_constraints;
 +  # Parse out a hash from input
 +  my @cols = exists $attrs->{key}
 +    ? $self->result_source->unique_constraint_columns($attrs->{key})
 +    : $self->result_source->primary_columns;
 +
 +  my $hash;
 +  if (ref $_[0] eq 'HASH') {
 +    $hash = { %{$_[0]} };
 +  }
 +  elsif (@_ == @cols) {
 +    $hash = {};
 +    @{$hash}{@cols} = @_;
 +  }
 +  elsif (@_) {
 +    # For backwards compatibility
 +    $hash = {@_};
 +  }
 +  else {
      $self->throw_exception(
 -      "Unknown key $attrs->{key} on '" . $self->result_source->name . "'"
 -    ) unless exists $uniq{$attrs->{key}};
 -    @cols = @{ $uniq{$attrs->{key}} };
 +      "Arguments to find must be a hashref or match the number of columns in the "
 +        . (exists $attrs->{key} ? "$attrs->{key} unique constraint" : "primary key")
 +    );
    }
 -  #use Data::Dumper; warn Dumper($attrs, @vals, @cols);
 +
 +  # Check the hash we just parsed against our source's unique constraints
 +  my @constraint_names = exists $attrs->{key}
 +    ? ($attrs->{key})
 +    : $self->result_source->unique_constraint_names;
    $self->throw_exception(
      "Can't find unless a primary key or unique constraint is defined"
 -  ) unless @cols;
 -
 -  my $query;
 -  if (ref $vals[0] eq 'HASH') {
 -    $query = { %{$vals[0]} };
 -  } elsif (@cols == @vals) {
 -    $query = {};
 -    @{$query}{@cols} = @vals;
 -  } else {
 -    $query = {@vals};
 -  }
 -  foreach my $key (grep { ! m/\./ } keys %$query) {
 -    $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key};
 +  ) unless @constraint_names;
 +
 +  my @unique_queries;
 +  foreach my $name (@constraint_names) {
 +    my @unique_cols = $self->result_source->unique_constraint_columns($name);
 +    my $unique_query = $self->_build_unique_query($hash, \@unique_cols);
 +
 +    # Add the ResultSet's alias
 +    foreach my $key (grep { ! m/\./ } keys %$unique_query) {
 +      $unique_query->{"$self->{attrs}{alias}.$key"} = delete $unique_query->{$key};
 +    }
 +
 +    push @unique_queries, $unique_query if %$unique_query;
    }
 -  #warn Dumper($query);
 -  
 +
 +  # Handle cases where the ResultSet already defines the query
 +  my $query = @unique_queries ? \@unique_queries : undef;
 +
 +  # Run the query
    if (keys %$attrs) {
 -      my $rs = $self->search($query,$attrs);
 -      return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
 -  } else {
 -      return keys %{$self->{collapse}} ?
 -        $self->search($query)->next :
 -        $self->single($query);
 +    my $rs = $self->search($query, $attrs);
 +    return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
 +  }
 +  else {
 +    return keys %{$self->{collapse}}
 +      ? $self->search($query)->next
 +      : $self->single($query);
    }
  }
  
 +# _build_unique_query
 +#
 +# Constrain the specified query hash based on the specified column names.
 +
 +sub _build_unique_query {
 +  my ($self, $query, $unique_cols) = @_;
 +
 +  my %unique_query =
 +    map  { $_ => $query->{$_} }
 +    grep { exists $query->{$_} }
 +    @$unique_cols;
 +
 +  return \%unique_query;
 +}
 +
  =head2 search_related
  
  =over 4
@@@ -462,7 -390,7 +462,7 @@@ sub cursor 
    my $cd = $schema->resultset('CD')->single({ year => 2001 });
  
  Inflates the first result without creating a cursor if the resultset has
 -any records in it; if not returns nothing. Used by find() as an optimisation.
 +any records in it; if not returns nothing. Used by L</find> as an optimisation.
  
  Can optionally take an additional condition *only* - this is a fast-code-path
  method; if you need to add extra joins or similar call ->search and then
@@@ -490,28 -418,6 +490,28 @@@ sub single 
    return (@data ? $self->_construct_object(@data) : ());
  }
  
 +=head2 get_column
 +
 +=over 4
 +
 +=item Arguments: $cond?
 +
 +=item Return Value: $resultsetcolumn
 +
 +=back
 +
 +  my $max_length = $rs->get_column('length')->max;
 +
 +Returns a ResultSetColumn instance for $column based on $self
 +
 +=cut
 +
 +sub get_column {
 +  my ($self, $column) = @_;
 +
 +  my $new = DBIx::Class::ResultSetColumn->new($self, $column);
 +  return $new;
 +}
  
  =head2 search_like
  
@@@ -1125,32 -1031,6 +1125,32 @@@ sub new_result 
    return $obj;
  }
  
 +=head2 find_or_new
 +
 +=over 4
 +
 +=item Arguments: \%vals, \%attrs?
 +
 +=item Return Value: $object
 +
 +=back
 +
 +Find an existing record from this resultset. If none exists, instantiate a new
 +result object and return it. The object will not be saved into your storage
 +until you call L<DBIx::Class::Row/insert> on it.
 +
 +If you want objects to be saved immediately, use L</find_or_create> instead.
 +
 +=cut
 +
 +sub find_or_new {
 +  my $self     = shift;
 +  my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
 +  my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
 +  my $exists   = $self->find($hash, $attrs);
 +  return defined $exists ? $exists : $self->new_result($hash);
 +}
 +
  =head2 create
  
  =over 4
@@@ -1207,8 -1087,7 +1207,8 @@@ constraint. For example
      { key => 'artist_title' }
    );
  
 -See also L</find> and L</update_or_create>.
 +See also L</find> and L</update_or_create>. For information on how to declare
 +unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
  
  =cut
  
@@@ -1255,8 -1134,7 +1255,8 @@@ source, including the primary key
  
  If the C<key> is specified as C<primary>, it searches only on the primary key.
  
 -See also L</find> and L</find_or_create>.
 +See also L</find> and L</find_or_create>. For information on how to declare
 +unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
  
  =cut
  
@@@ -1265,10 -1143,29 +1265,10 @@@ sub update_or_create 
    my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
    my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
  
 -  my %unique_constraints = $self->result_source->unique_constraints;
 -  my @constraint_names   = (exists $attrs->{key}
 -                            ? ($attrs->{key})
 -                            : keys %unique_constraints);
 -
 -  my @unique_hashes;
 -  foreach my $name (@constraint_names) {
 -    my @unique_cols = @{ $unique_constraints{$name} };
 -    my %unique_hash =
 -      map  { $_ => $hash->{$_} }
 -      grep { exists $hash->{$_} }
 -      @unique_cols;
 -
 -    push @unique_hashes, \%unique_hash
 -      if (scalar keys %unique_hash == scalar @unique_cols);
 -  }
 -
 -  if (@unique_hashes) {
 -    my $row = $self->single(\@unique_hashes);
 -    if (defined $row) {
 -      $row->update($hash);
 -      return $row;
 -    }
 +  my $row = $self->find($hash, $attrs);
 +  if (defined $row) {
 +    $row->update($hash);
 +    return $row;
    }
  
    return $self->create($hash);
@@@ -1498,6 -1395,10 +1498,10 @@@ use C<get_column> instead
  You can create your own accessors if required - see
  L<DBIx::Class::Manual::Cookbook> for details.
  
+ Please note: This will NOT insert an C<AS employee_count> into the SQL statement
+ produced, it is used for internal access only. Thus attempting to use the accessor
+ in an C<order_by> clause or similar will fail misrably.
  =head2 join
  
  =over 4