view release on metacpan or  search on metacpan

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

=cut

sub delete {
  my($self,$conditions) = (attr shift,shift);

  my $sql  = "DELETE FROM $NAME";
     $sql .= " WHERE $conditions" if $conditions;
  print STDERR "$sql\n" if $_DEBUG;
  return $DBH->do($sql) || die($DBH->errstr);
}
#------------------------------------------------------------------------------

=head2 insert(\%values)

INSERT INTO the table columns corresponding to the keys of I<%values>
the VALUES corresponding to the values of I<%values>.  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;
  my %values = %{$_[0]};

  my(@columns,$values);
  for ( keys(%values) ) {
    next unless defined($values{$_});
    push(@columns,$_);
    my $type = $self->get_attributes($_)->references->ansii_type;
    print STDERR "value = $values{$_}, type = $type\n" if $_DEBUG;
    $values .= $self->_quote($values{$_},$type) . ',';
  }
  chop $values;
  my $columns = '(' . join(',',@columns). ')';

  my $sql = "INSERT INTO $NAME $columns VALUES ($values)";
  print STDERR "$sql\n" if $_DEBUG;

  my $sth = $DBH->prepare($sql) || die $DBH->errstr;
  my $rv  = $sth->execute       || die "$sql\n" . $sth->errstr . "\n";
  my $rc  = $sth->finish;

  if ( $self->belongs_to->driver eq 'mysql' ) {
    # id of auto_increment field
    return $sth->{mysql_insertid};
  } else {
    return -1;
  }
}
#------------------------------------------------------------------------------

=head2 update(\%values,$conditions)

UPDATE the table SETting the columns matching the keys in %values to
the values in %values WHERE I<$conditions> are met.  Returns the
number of rows updated if supplied by the DBI driver.

=cut

sub update {
  my $self = attr shift;
  my %values     = %{$_[0]};
  my $conditions = $_[1];

  my $values;
  for ( keys %values ) {
    next unless $values{$_};
    my $dt   = $self->get_attributes($_)->references;
    my $type = $dt->ansii_type;
    print STDERR "\$type = ",$dt->name,"($type)\n" if $_DEBUG;
    $values .= "$_ = " . $self->_quote($values{$_},$type) . ',';
  }
  chop $values;
  
  my $sql  = "UPDATE $NAME SET $values";
     $sql .= " WHERE $conditions" if $conditions;
  print STDERR "$sql\n" if $_DEBUG;
  return $DBH->do($sql) || die($DBH->errstr);
}

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

=head2 select(\@columns,$conditions,$order)

Returns a list of lists of values by SELECTing values FROM I<@columns>
WHERE rows meet I<$conditions> ORDERed BY the list of columns in
I<$order>.  Strings in I<@columns> can refer to functions supported by
the database in a SELECT clause e.g.

C<@columns = q/sin(foo),cos(bar),tan(baz)/;>

=cut

sub select {
  my $self = attr shift;
  my $sth  = $self->_do_select(@_);
  my @things;
  # WARNING!
  # Can't use fetchrow_arrayref here as it returns the *same* ref (man DBI)
  while ( my @attributes = $sth->fetchrow_array ) {
    print "@attributes\n" if $_DEBUG;
    push(@things,\@attributes);
  }
  if ( $_DEBUG ) {
    print "@things\n";
    for ( @things ) { print "@{$_}\n" }
  }
  return @things;
}

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

=head2 select_loh(\@columns,$conditions,$order)

Returns a list of hashrefs containing B<(column_name,value)> pairs by
SELECTing values FROM I<@columns> WHERE rows meet I<$conditions>
ORDERed BY the list of columns in I<$order>.  Strings in I<@columns>
can refer to functions supported by the database in a SELECT clause
e.g.