view release on metacpan or  search on metacpan

lib/DbFramework/Persistent.pm  view on Meta::CPAN

  my $class = ref($proto) || $proto;

  my $code = qq{package $name;
use strict;
use base qw(DbFramework::Persistent);
};
}

##-----------------------------------------------------------------------------
## OBJECT METHODS
##-----------------------------------------------------------------------------

=head1 OBJECT METHODS

Attributes in a persistent object which relate to columns in the
associated table are made available through the attribute
I<ATTRIBUTES_H>.  See L<DbFramework::Util/AUTOLOAD()> for the accessor
methods for this attribute.

=head2 delete()

Delete this object from the associated table based on the values of
it's primary key attributes.  Returns the number of rows deleted if
supplied by the DBI driver.

=cut

sub delete {
  my $self = attr shift;
  return $TABLE->delete($self->_pk_conditions);
}

#------------------------------------------------------------------------------

=head2 insert()

Insert this object in the associated table.  Returns the primary key
of the inserted row if it is a Mysql 'AUTO_INCREMENT' column or -1.

=cut

sub insert {
  my $self = attr shift;
  return $TABLE->insert($self->attributes_h);
}

#------------------------------------------------------------------------------

=head2 update(\%attributes)

Update this object in the associated table.  I<%attributes> is a hash
whose keys contain primary key column names and whose values will be
concatenated with 'ANDs' to form a SQL 'WHERE' clause.  The default
values of I<%attributes> is the hash returned by attributes_h().  Pass
the B<current> primary key attributes as an argument in I<%attributes>
when you need to update one or more primary key columns.  Returns the
number of rows updated if supplied by the DBI driver.

=cut

sub update {
  my $self = attr shift;
  my %attributes = defined($_[0]) ? %{$_[0]} : %{$self->attributes_h};
  # get pk attributes
  my %pk_attributes;
  for ( $TABLE->is_identified_by->attribute_names ) {
    $pk_attributes{$_} = $attributes{$_};
  }
  return $TABLE->update($self->attributes_h,$self->where_and(\%pk_attributes));
}

#------------------------------------------------------------------------------

=head2 select($conditions,$order)

Returns a list of objects of the same class as the object which
invokes it.  Each object in the list has its attributes initialised
from the values returned by selecting all columns from the associated
table matching I<$conditions> ordered by the list of columns in
I<$order>.

=cut

sub select {
  my $self = attr shift;

  my @things;
  my @columns = $TABLE->attribute_names;
  for ( $TABLE->select(\@columns,shift,shift) ) {
    print STDERR "\@{\$_} = @{$_}\n" if $_DEBUG;
    # pass Table *object* to new to retain any fk relationships
    my $thing = $self->new($TABLE,$TABLE->dbh,$CATALOG);
    my %attributes;
    for ( my $i = 0; $i <= $#columns; $i++ ) {
      print STDERR "assigning $columns[$i] = $_->[$i]\n" if $_DEBUG;
      $attributes{$columns[$i]} = $_->[$i];
    }
    $thing->attributes_h([%attributes]);
    push(@things,$thing);
  }
  return @things;
}

##-----------------------------------------------------------------------------

#=head2 validate_required()

#Returns a list of attribute names which must B<not> be NULL but are
#undefined.  If I<@attributes> is undefined, validates all attributes.

#=cut

#sub validate_required {
#  my $self  = attr shift; my $table = $self->table;
#  my($attribute,@invalid);

#  my @attributes = @_ ? @_ : sort keys(%STATE);
#  foreach $attribute ( @attributes ) {
#    my $column = $table->get_column($attribute);
#    if ( ! $column->null && ! defined($self->get_attribute($attribute)) ) {
#      my $heading = $column->heading;