[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Table.pm

package DBIx::Class::Table;

use strict;
use warnings;

use DBIx::Class::ResultSet;

use base qw/Class::Data::Inheritable/;

__PACKAGE__->mk_classdata('_columns' => {});

__PACKAGE__->mk_classdata('_table_name');

__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!

__PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet');

sub iterator_class { shift->_resultset_class(@_) }

=head1 NAME 

DBIx::Class::Table - Basic table methods

=head1 SYNOPSIS

=head1 DESCRIPTION

This class is responsible for defining and doing basic operations on 
L<DBIx::Class> objects.

=head1 METHODS

=over 4

=item new

  my $obj = My::Class->new($attrs);

Creates a new object from column => value mappings passed as a hash ref

=cut

sub new {
  my ($class, $attrs) = @_;
  $class = ref $class if ref $class;
  my $new = bless({ _column_data => { } }, $class);
  if ($attrs) {
    $new->throw("attrs must be a hashref" ) unless ref($attrs) eq 'HASH';
    while (my ($k, $v) = each %{$attrs}) {
      $new->store_column($k => $v);
    }
  }
  return $new;
}

=item insert

  $obj->insert;

Inserts an object into the database if it isn't already in there. Returns
the object itself.

=cut

sub insert {
  my ($self) = @_;
  return $self if $self->in_database;
  #use Data::Dumper; warn Dumper($self);
  my %in;
  $in{$_} = $self->get_column($_)
    for grep { defined $self->get_column($_) } $self->columns;
  my %out = %{ $self->storage->insert($self->_table_name, \%in) };
  $self->store_column($_, $out{$_})
    for grep { $self->get_column($_) ne $out{$_} } keys %out;
  $self->in_database(1);
  $self->{_dirty_columns} = {};
  return $self;
}

=item in_database

  $obj->in_database; # Get value
  $obj->in_database(1); # Set value

Indicated whether the object exists as a row in the database or not

=cut

sub in_database {
  my ($self, $val) = @_;
  $self->{_in_database} = $val if @_ > 1;
  return $self->{_in_database};
}

=item create

  my $new = My::Class->create($attrs);

A shortcut for My::Class->new($attrs)->insert;

=cut

sub create {
  my ($class, $attrs) = @_;
  $class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH';
  return $class->new($attrs)->insert;
}

=item update

  $obj->update;

Must be run on an object that is already in the database; issues an SQL
UPDATE query to commit any changes to the object to the db if required.

=cut

sub update {
  my ($self, $upd) = @_;
  $self->throw( "Not in database" ) unless $self->in_database;
  my %to_update = %{$upd || {}};
  $to_update{$_} = $self->get_column($_) for $self->is_changed;
  return -1 unless keys %to_update;
  my $rows = $self->storage->update($self->_table_name, \%to_update,
                                      $self->ident_condition);
  if ($rows == 0) {
    $self->throw( "Can't update ${self}: row not found" );
  } elsif ($rows > 1) {
    $self->throw("Can't update ${self}: updated more than one row");
  }
  $self->{_dirty_columns} = {};
  return $self;
}

sub ident_condition {
  my ($self) = @_;
  my %cond;
  $cond{$_} = $self->get_column($_) for keys %{$self->_primaries};
  return \%cond;
}

=item delete

  $obj->delete

Deletes the object from the database. The object is still perfectly usable
accessor-wise etc. but ->in_database will now return 0 and the object must
be re ->insert'ed before it can be ->update'ed

=cut

sub delete {
  my $self = shift;
  if (ref $self) {
    $self->throw( "Not in database" ) unless $self->in_database;
    #warn $self->_ident_cond.' '.join(', ', $self->_ident_values);
    $self->storage->delete($self->_table_name, $self->ident_condition);
    $self->in_database(undef);
    #$self->store_column($_ => undef) for $self->primary_columns;
      # Should probably also arrange to trash PK if auto
      # but if we do, post-delete cascade triggers fail :/
  } else {
    my $attrs = { };
    if (@_ > 1 && ref $_[$#_] eq 'HASH') {
      $attrs = { %{ pop(@_) } };
    }
    my $query = (ref $_[0] eq 'HASH' ? $_[0] : {@_});
    $self->storage->delete($self->_table_name, $query);
  }
  return $self;
}

=item get_column

  my $val = $obj->get_column($col);

Fetches a column value

=cut

sub get_column {
  my ($self, $column) = @_;
  $self->throw( "Can't fetch data as class method" ) unless ref $self;
  $self->throw( "No such column '${column}'" ) unless $self->_columns->{$column};
  return $self->{_column_data}{$column}
    if exists $self->{_column_data}{$column};
  return undef;
}

=item set_column

  $obj->set_column($col => $val);

Sets a column value; if the new value is different to the old the column
is marked as dirty for when you next call $obj->update

=cut

sub set_column {
  my $self = shift;
  my ($column) = @_;
  my $old = $self->get_column($column);
  my $ret = $self->store_column(@_);
  $self->{_dirty_columns}{$column} = 1 unless defined $old && $old eq $ret;
  return $ret;
}

=item store_column

  $obj->store_column($col => $val);

Sets a column value without marking it as dirty

=cut

sub store_column {
  my ($self, $column, $value) = @_;
  $self->throw( "No such column '${column}'" ) 
    unless $self->_columns->{$column};
  $self->throw( "set_column called for ${column} without value" ) 
    if @_ < 3;
  return $self->{_column_data}{$column} = $value;
}

sub _register_columns {
  my ($class, @cols) = @_;
  my $names = { %{$class->_columns} };
  $names->{$_} ||= {} for @cols;
  $class->_columns($names); 
}

sub _mk_column_accessors {
  my ($class, @cols) = @_;
  $class->mk_group_accessors('column' => @cols);
}

=item add_columns

  __PACKAGE__->add_columns(qw/col1 col2 col3/);

Adds columns to the current package, and creates accessors for them

=cut

sub add_columns {
  my ($class, @cols) = @_;
  $class->_register_columns(@cols);
  $class->_mk_column_accessors(@cols);
}

=item retrieve_from_sql

  my @obj    = $class->retrieve_from_sql($sql_where_cond, @bind);
  my $cursor = $class->retrieve_from_sql($sql_where_cond, @bind);

=cut

sub retrieve_from_sql {
  my ($class, $cond, @vals) = @_;
  $cond =~ s/^\s*WHERE//i;
  my $attrs = (ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
  my @cols = $class->_select_columns($attrs);
  #warn "@cols $cond @vals";
  return $class->cursor_to_resultset(undef, \@vals, \@cols, { where => \$cond, %$attrs });
}

=item count_from_sql

  my $count = $class->count($sql_where_cond);

=cut

sub count_from_sql {
  my ($class, $cond, @vals) = @_;
  $cond =~ s/^\s*WHERE//i;
  my $attrs = (ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
  $attrs->{bind} = [ @vals ];
  return $class->count($cond, $attrs);
}

=item count

  my $count = $class->count({ foo => 3 });

=cut

sub count {
  my $class = shift;
  my $attrs = { };
  if (@_ > 1 && ref $_[$#_] eq 'HASH') {
    $attrs = { %{ pop(@_) } };
  }
  my $query  = ref $_[0] eq "HASH" || (@_ == 1) ? shift: {@_};
  my @cols = 'COUNT(*)';
  my $cursor = $class->storage->select($class->_table_name, \@cols,
                                         $query, $attrs);
  return ($cursor->next)[0];
}

sub cursor_to_resultset {
  my ($class, $sth, $args, $cols, $attrs) = @_;
  my $rs_class = $class->_resultset_class;
  eval "use $rs_class;";
  my $rs = $rs_class->new($class, $sth, $args, $cols, $attrs);
  return (wantarray ? $rs->all : $rs);
}

sub _row_to_object { # WARNING: Destructive to @$row
  my ($class, $cols, $row) = @_;
  my $new = $class->new;
  $new->store_column($_, shift @$row) for @$cols;
  $new->in_database(1);
  return $new;
}

=item search 

  my @obj    = $class->search({ foo => 3 });
  my $cursor = $class->search({ foo => 3 });

=cut

sub search {
  my $class = shift;
  #warn "@_";
  my $attrs = { };
  if (@_ > 1 && ref $_[$#_] eq 'HASH') {
    $attrs = { %{ pop(@_) } };
  }
  my $query    = ref $_[0] eq "HASH" ? shift: {@_};
  my @cols = $class->_select_columns;
  return $class->cursor_to_resultset(undef, $attrs->{bind}, \@cols,
                                    { where => $query, %$attrs });
}

=item search_like

Identical to search except defaults to 'LIKE' instead of '=' in condition

=cut

sub search_like {
  my $class    = shift;
  my $attrs = { };
  if (@_ > 1 && ref $_[$#_] eq 'HASH') {
    $attrs = pop(@_);
  }
  my $query    = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
  $query->{$_} = { 'like' => $query->{$_} } for keys %$query;
  return $class->search($query, { %$attrs });
}

sub _select_columns {
  return keys %{$_[0]->_columns};
}

=item copy

  my $copy = $orig->copy({ change => $to, ... });

=cut

sub copy {
  my ($self, $changes) = @_;
  my $new = bless({ _column_data => { %{$self->{_column_data}}} }, ref $self);
  $new->set_column($_ => $changes->{$_}) for keys %$changes;
  return $new->insert;
}

#sub _cond_resolve {
#  my ($self, $query, $attrs) = @_;
#  return '1 = 1' unless keys %$query;
#  my $op = $attrs->{'cmp'} || '=';
#  my $cond = join(' AND ',
#               map { (defined $query->{$_}
#                       ? "$_ $op ?"
#                       : (do { delete $query->{$_}; "$_ IS NULL"; }));
#                   } keys %$query);
#  return ($cond, values %$query);
#}

=item table

  __PACKAGE__->table('tbl_name');

=cut

sub table {
  shift->_table_name(@_);
}

=item find_or_create

  $class->find_or_create({ key => $val, ... });

Searches for a record matching the search condition; if it doesn't find one,
creates one and returns that instead

=cut

sub find_or_create {
  my $class    = shift;
  my $hash     = ref $_[0] eq "HASH" ? shift: {@_};
  my ($exists) = $class->search($hash);
  return defined($exists) ? $exists : $class->create($hash);
}

=item insert_or_update

  $obj->insert_or_update

Updates the object if it's already in the db, else inserts it

=cut

sub insert_or_update {
  my $self = shift;
  return ($self->in_database ? $self->update : $self->insert);
}

=item retrieve_all

  my @all = $class->retrieve_all;

=cut

sub retrieve_all {
  my ($class) = @_;
  return $class->retrieve_from_sql( '1' );
}

=item is_changed

  my @changed_col_names = $obj->is_changed

=cut

sub is_changed {
  return keys %{shift->{_dirty_columns} || {}};
}

sub columns { return keys %{shift->_columns}; }

1;

=back

=head1 AUTHORS

Matt S. Trout <perl-stuff@trout.me.uk>

=head1 LICENSE

You may distribute this code under the same terms as Perl itself.

=cut
Commit	Line	Data
ea2e61bf	1	package DBIx::Class::Table;
	2
	3	use strict;
	4	use warnings;
	5
223b8fe3	6	use DBIx::Class::ResultSet;
95a70f01	7
95a70f01	8	use base qw/Class::Data::Inheritable/;
ea2e61bf	9
	10	__PACKAGE__->mk_classdata('_columns' => {});
	11
ea2e61bf	12	__PACKAGE__->mk_classdata('_table_name');
ea2e61bf	13
34d52be2	14	__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do anything yet!
34d52be2	15
223b8fe3	16	__PACKAGE__->mk_classdata('_resultset_class' => 'DBIx::Class::ResultSet');
95a70f01	17
223b8fe3	18	sub iterator_class { shift->_resultset_class(@_) }
525035fb	19
34d52be2	20	=head1 NAME
	21
	22	DBIx::Class::Table - Basic table methods
	23
	24	=head1 SYNOPSIS
	25
	26	=head1 DESCRIPTION
	27
	28	This class is responsible for defining and doing basic operations on
	29	L<DBIx::Class> objects.
	30
	31	=head1 METHODS
	32
	33	=over 4
	34
39fe0e65	35	=item new
	36
	37	my $obj = My::Class->new($attrs);
	38
	39	Creates a new object from column => value mappings passed as a hash ref
	40
34d52be2	41	=cut
9bc6db13	42
ea2e61bf	43	sub new {
	44	my ($class, $attrs) = @_;
	45	$class = ref $class if ref $class;
	46	my $new = bless({ _column_data => { } }, $class);
	47	if ($attrs) {
78bab9ca	48	$new->throw("attrs must be a hashref" ) unless ref($attrs) eq 'HASH';
ea2e61bf	49	while (my ($k, $v) = each %{$attrs}) {
510ca912	50	$new->store_column($k => $v);
ea2e61bf	51	}
ea2e61bf	52	}
8fe001e1	53	return $new;
ea2e61bf	54	}
ea2e61bf	55
39fe0e65	56	=item insert
	57
	58	$obj->insert;
	59
	60	Inserts an object into the database if it isn't already in there. Returns
	61	the object itself.
	62
	63	=cut
	64
ea2e61bf	65	sub insert {
ea2e61bf	66	my ($self) = @_;
39fe0e65	67	return $self if $self->in_database;
c1d23573	68	#use Data::Dumper; warn Dumper($self);
8b445e33	69	my %in;
	70	$in{$_} = $self->get_column($_)
	71	for grep { defined $self->get_column($_) } $self->columns;
	72	my %out = %{ $self->storage->insert($self->_table_name, \%in) };
	73	$self->store_column($_, $out{$_})
	74	for grep { $self->get_column($_) ne $out{$_} } keys %out;
c687b87e	75	$self->in_database(1);
8fe001e1	76	$self->{_dirty_columns} = {};
ea2e61bf	77	return $self;
	78	}
	79
39fe0e65	80	=item in_database
	81
	82	$obj->in_database; # Get value
	83	$obj->in_database(1); # Set value
	84
	85	Indicated whether the object exists as a row in the database or not
	86
	87	=cut
	88
604d9f38	89	sub in_database {
c687b87e	90	my ($self, $val) = @_;
	91	$self->{_in_database} = $val if @_ > 1;
	92	return $self->{_in_database};
604d9f38	93	}
604d9f38	94
39fe0e65	95	=item create
	96
	97	my $new = My::Class->create($attrs);
	98
	99	A shortcut for My::Class->new($attrs)->insert;
	100
	101	=cut
	102
ea2e61bf	103	sub create {
ea2e61bf	104	my ($class, $attrs) = @_;
78bab9ca	105	$class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH';
ea2e61bf	106	return $class->new($attrs)->insert;
	107	}
	108
39fe0e65	109	=item update
	110
	111	$obj->update;
	112
	113	Must be run on an object that is already in the database; issues an SQL
	114	UPDATE query to commit any changes to the object to the db if required.
	115
	116	=cut
	117
ea2e61bf	118	sub update {
8b445e33	119	my ($self, $upd) = @_;
78bab9ca	120	$self->throw( "Not in database" ) unless $self->in_database;
8b445e33	121	my %to_update = %{$upd \|\| {}};
	122	$to_update{$_} = $self->get_column($_) for $self->is_changed;
	123	return -1 unless keys %to_update;
	124	my $rows = $self->storage->update($self->_table_name, \%to_update,
	125	$self->ident_condition);
a3018bd3	126	if ($rows == 0) {
8b445e33	127	$self->throw( "Can't update ${self}: row not found" );
a3018bd3	128	} elsif ($rows > 1) {
8b445e33	129	$self->throw("Can't update ${self}: updated more than one row");
a3018bd3	130	}
ea2e61bf	131	$self->{_dirty_columns} = {};
	132	return $self;
	133	}
	134
8b445e33	135	sub ident_condition {
	136	my ($self) = @_;
	137	my %cond;
	138	$cond{$_} = $self->get_column($_) for keys %{$self->_primaries};
	139	return \%cond;
	140	}
	141
39fe0e65	142	=item delete
	143
	144	$obj->delete
	145
	146	Deletes the object from the database. The object is still perfectly usable
	147	accessor-wise etc. but ->in_database will now return 0 and the object must
	148	be re ->insert'ed before it can be ->update'ed
	149
	150	=cut
	151
ea2e61bf	152	sub delete {
a3018bd3	153	my $self = shift;
a3018bd3	154	if (ref $self) {
78bab9ca	155	$self->throw( "Not in database" ) unless $self->in_database;
b8e1e21f	156	#warn $self->_ident_cond.' '.join(', ', $self->_ident_values);
8b445e33	157	$self->storage->delete($self->_table_name, $self->ident_condition);
c687b87e	158	$self->in_database(undef);
8b445e33	159	#$self->store_column($_ => undef) for $self->primary_columns;
39fe0e65	160	# Should probably also arrange to trash PK if auto
8b445e33	161	# but if we do, post-delete cascade triggers fail :/
a3018bd3	162	} else {
12bbb339	163	my $attrs = { };
	164	if (@_ > 1 && ref $_[$#_] eq 'HASH') {
	165	$attrs = { %{ pop(@_) } };
	166	}
a3018bd3	167	my $query = (ref $_[0] eq 'HASH' ? $_[0] : {@_});
8b445e33	168	$self->storage->delete($self->_table_name, $query);
a3018bd3	169	}
ea2e61bf	170	return $self;
	171	}
	172
39fe0e65	173	=item get_column
	174
	175	my $val = $obj->get_column($col);
	176
	177	Fetches a column value
	178
	179	=cut
	180
510ca912	181	sub get_column {
ea2e61bf	182	my ($self, $column) = @_;
78bab9ca	183	$self->throw( "Can't fetch data as class method" ) unless ref $self;
78bab9ca	184	$self->throw( "No such column '${column}'" ) unless $self->_columns->{$column};
c1d23573	185	return $self->{_column_data}{$column}
	186	if exists $self->{_column_data}{$column};
	187	return undef;
ea2e61bf	188	}
ea2e61bf	189
39fe0e65	190	=item set_column
	191
	192	$obj->set_column($col => $val);
	193
	194	Sets a column value; if the new value is different to the old the column
	195	is marked as dirty for when you next call $obj->update
	196
	197	=cut
	198
510ca912	199	sub set_column {
	200	my $self = shift;
	201	my ($column) = @_;
cc0f266f	202	my $old = $self->get_column($column);
510ca912	203	my $ret = $self->store_column(@_);
cc0f266f	204	$self->{_dirty_columns}{$column} = 1 unless defined $old && $old eq $ret;
510ca912	205	return $ret;
	206	}
	207
39fe0e65	208	=item store_column
	209
	210	$obj->store_column($col => $val);
	211
	212	Sets a column value without marking it as dirty
	213
	214	=cut
	215
510ca912	216	sub store_column {
ea2e61bf	217	my ($self, $column, $value) = @_;
78bab9ca	218	$self->throw( "No such column '${column}'" )
	219	unless $self->_columns->{$column};
	220	$self->throw( "set_column called for ${column} without value" )
	221	if @_ < 3;
510ca912	222	return $self->{_column_data}{$column} = $value;
ea2e61bf	223	}
ea2e61bf	224
ea2e61bf	225	sub _register_columns {
	226	my ($class, @cols) = @_;
	227	my $names = { %{$class->_columns} };
	228	$names->{$_} \|\|= {} for @cols;
	229	$class->_columns($names);
	230	}
	231
	232	sub _mk_column_accessors {
	233	my ($class, @cols) = @_;
510ca912	234	$class->mk_group_accessors('column' => @cols);
ea2e61bf	235	}
ea2e61bf	236
39fe0e65	237	=item add_columns
	238
	239	__PACKAGE__->add_columns(qw/col1 col2 col3/);
	240
	241	Adds columns to the current package, and creates accessors for them
	242
	243	=cut
	244
510ca912	245	sub add_columns {
8fe001e1	246	my ($class, @cols) = @_;
	247	$class->_register_columns(@cols);
	248	$class->_mk_column_accessors(@cols);
	249	}
	250
39fe0e65	251	=item retrieve_from_sql
	252
	253	my @obj = $class->retrieve_from_sql($sql_where_cond, @bind);
	254	my $cursor = $class->retrieve_from_sql($sql_where_cond, @bind);
	255
	256	=cut
	257
8fe001e1	258	sub retrieve_from_sql {
8fe001e1	259	my ($class, $cond, @vals) = @_;
a3018bd3	260	$cond =~ s/^\s*WHERE//i;
604d9f38	261	my $attrs = (ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
604d9f38	262	my @cols = $class->_select_columns($attrs);
8b445e33	263	#warn "@cols $cond @vals";
223b8fe3	264	return $class->cursor_to_resultset(undef, \@vals, \@cols, { where => \$cond, %$attrs });
510ca912	265	}
510ca912	266
39fe0e65	267	=item count_from_sql
	268
	269	my $count = $class->count($sql_where_cond);
	270
	271	=cut
	272
fcbc5f29	273	sub count_from_sql {
223b8fe3	274	my ($class, $cond, @vals) = @_;
fcbc5f29	275	$cond =~ s/^\s*WHERE//i;
fcbc5f29	276	my $attrs = (ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
8b445e33	277	$attrs->{bind} = [ @vals ];
223b8fe3	278	return $class->count($cond, $attrs);
fcbc5f29	279	}
fcbc5f29	280
39fe0e65	281	=item count
	282
	283	my $count = $class->count({ foo => 3 });
	284
	285	=cut
	286
06d90c6b	287	sub count {
	288	my $class = shift;
	289	my $attrs = { };
	290	if (@_ > 1 && ref $_[$#_] eq 'HASH') {
	291	$attrs = { %{ pop(@_) } };
	292	}
223b8fe3	293	my $query = ref $_[0] eq "HASH" \|\| (@_ == 1) ? shift: {@_};
	294	my @cols = 'COUNT(*)';
	295	my $cursor = $class->storage->select($class->_table_name, \@cols,
	296	$query, $attrs);
	297	return ($cursor->next)[0];
06d90c6b	298	}
06d90c6b	299
223b8fe3	300	sub cursor_to_resultset {
54644855	301	my ($class, $sth, $args, $cols, $attrs) = @_;
223b8fe3	302	my $rs_class = $class->_resultset_class;
	303	eval "use $rs_class;";
	304	my $rs = $rs_class->new($class, $sth, $args, $cols, $attrs);
	305	return (wantarray ? $rs->all : $rs);
8fe001e1	306	}
8fe001e1	307
c1d23573	308	sub _row_to_object { # WARNING: Destructive to @$row
	309	my ($class, $cols, $row) = @_;
	310	my $new = $class->new;
	311	$new->store_column($_, shift @$row) for @$cols;
	312	$new->in_database(1);
	313	return $new;
	314	}
	315
39fe0e65	316	=item search
	317
	318	my @obj = $class->search({ foo => 3 });
	319	my $cursor = $class->search({ foo => 3 });
	320
	321	=cut
	322
8fe001e1	323	sub search {
12bbb339	324	my $class = shift;
8b445e33	325	#warn "@_";
12bbb339	326	my $attrs = { };
	327	if (@_ > 1 && ref $_[$#_] eq 'HASH') {
	328	$attrs = { %{ pop(@_) } };
	329	}
	330	my $query = ref $_[0] eq "HASH" ? shift: {@_};
223b8fe3	331	my @cols = $class->_select_columns;
	332	return $class->cursor_to_resultset(undef, $attrs->{bind}, \@cols,
	333	{ where => $query, %$attrs });
a3018bd3	334	}
a3018bd3	335
39fe0e65	336	=item search_like
	337
	338	Identical to search except defaults to 'LIKE' instead of '=' in condition
	339
	340	=cut
	341
a3018bd3	342	sub search_like {
a3018bd3	343	my $class = shift;
12bbb339	344	my $attrs = { };
	345	if (@_ > 1 && ref $_[$#_] eq 'HASH') {
	346	$attrs = pop(@_);
	347	}
223b8fe3	348	my $query = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
	349	$query->{$_} = { 'like' => $query->{$_} } for keys %$query;
	350	return $class->search($query, { %$attrs });
8fe001e1	351	}
	352
	353	sub _select_columns {
	354	return keys %{$_[0]->_columns};
	355	}
	356
39fe0e65	357	=item copy
	358
	359	my $copy = $orig->copy({ change => $to, ... });
	360
	361	=cut
	362
8fe001e1	363	sub copy {
	364	my ($self, $changes) = @_;
	365	my $new = bless({ _column_data => { %{$self->{_column_data}}} }, ref $self);
510ca912	366	$new->set_column($_ => $changes->{$_}) for keys %$changes;
a3018bd3	367	return $new->insert;
	368	}
	369
126042ee	370	#sub _cond_resolve {
	371	# my ($self, $query, $attrs) = @_;
	372	# return '1 = 1' unless keys %$query;
	373	# my $op = $attrs->{'cmp'} \|\| '=';
	374	# my $cond = join(' AND ',
	375	# map { (defined $query->{$_}
	376	# ? "$_ $op ?"
	377	# : (do { delete $query->{$_}; "$_ IS NULL"; }));
	378	# } keys %$query);
	379	# return ($cond, values %$query);
	380	#}
8fe001e1	381
39fe0e65	382	=item table
	383
	384	__PACKAGE__->table('tbl_name');
	385
	386	=cut
	387
510ca912	388	sub table {
	389	shift->_table_name(@_);
	390	}
	391
39fe0e65	392	=item find_or_create
	393
	394	$class->find_or_create({ key => $val, ... });
	395
	396	Searches for a record matching the search condition; if it doesn't find one,
	397	creates one and returns that instead
	398
	399	=cut
	400
95a70f01	401	sub find_or_create {
	402	my $class = shift;
	403	my $hash = ref $_[0] eq "HASH" ? shift: {@_};
	404	my ($exists) = $class->search($hash);
	405	return defined($exists) ? $exists : $class->create($hash);
	406	}
	407
39fe0e65	408	=item insert_or_update
	409
	410	$obj->insert_or_update
	411
	412	Updates the object if it's already in the db, else inserts it
	413
	414	=cut
	415
b28cc0ba	416	sub insert_or_update {
	417	my $self = shift;
	418	return ($self->in_database ? $self->update : $self->insert);
	419	}
	420
39fe0e65	421	=item retrieve_all
	422
	423	my @all = $class->retrieve_all;
	424
	425	=cut
	426
95a70f01	427	sub retrieve_all {
	428	my ($class) = @_;
	429	return $class->retrieve_from_sql( '1' );
	430	}
	431
39fe0e65	432	=item is_changed
	433
	434	my @changed_col_names = $obj->is_changed
	435
	436	=cut
	437
cc0f266f	438	sub is_changed {
	439	return keys %{shift->{_dirty_columns} \|\| {}};
	440	}
	441
8b445e33	442	sub columns { return keys %{shift->_columns}; }
8b445e33	443
ea2e61bf	444	1;
34d52be2	445
	446	=back
	447
	448	=head1 AUTHORS
	449
	450	Matt S. Trout <perl-stuff@trout.me.uk>
	451
	452	=head1 LICENSE
	453
	454	You may distribute this code under the same terms as Perl itself.
	455
	456	=cut
	457