Class-DBI-Lite

 view release on metacpan or  search on metacpan

lib/Class/DBI/Lite.pm  view on Meta::CPAN

    )

  if( $s->_meta->trace )
  {
    my $class = ref($s) || $s;
    cluck "$class: create($sql, values[" . join( ",", map {qq('$_')} @vals) . "])";
  }# end if()
  
  my $sth = $s->db_Main->prepare_cached( $sql );
  $sth->execute( @vals );
  my $id = $s->get_last_insert_id
    or confess "ERROR - CANNOT get last insert id";
  $sth->finish();
  
  my $new_obj = $s->construct( {
    %$pre_obj,
    $PK => $id,
  }, defined wantarray );
  $pre_obj->discard_changes;

  $new_obj->_call_triggers( after_create => $new_obj );
  $new_obj->update if $new_obj->{__Changed};
  $new_obj;
}# end create()


#==============================================================================
sub do_transaction
{
  my ($s, $code) = @_;
  
  local $s->db_Main->{AutoCommit};
  my ($res, @res);
  wantarray ? @res = eval { $code->( ) } : $res = eval { $code->( ) };
  
  if( my $trans_error = $@ )
  {
    eval { $s->dbi_rollback };
    if( my $rollback_error = $@ )
    {
      confess join "\n\t",  "Both transaction and rollback failed:",
                            "Transaction error: $trans_error",
                            "Rollback Error: $rollback_error";
    }
    else
    {
      confess join "\n\t",  "Transaction failed but rollback succeeded:",
                            "Transaction error: $trans_error";
    }# end if()
  }
  else
  {
    # Success:
    $s->dbi_commit;
    wantarray ? return @res : return $res;
  }# end if()
}# end do_transaction()


#==============================================================================
sub update
{
  my $s = shift;
  confess "$s\->update cannot be called without an object" unless ref($s);
  
  return 1 unless eval { keys(%{ $s->{__Changed} }) };
  
  $s->_call_triggers( before_update => $s );
  
  my $changed = $s->{__Changed};
  foreach my $field ( grep { $changed->{$_} } sort keys(%$s) )
  {
    $s->_call_triggers( "before_update_$field", $changed->{$field}->{oldval}, $s->{$field} );
  }# end foreach()
  
  
  # Make our SQL:
  my @fields  = map { "$_ = ?" } grep { $changed->{$_} } sort keys(%$s);
  my @vals    = map { $s->{$_} } grep { $changed->{$_} } sort keys(%$s);
  my $sql = <<"";
    UPDATE @{[ $s->table ]} SET
      @{[ join ', ', @fields ]}
    WHERE @{[ $s->primary_column ]} = ?

  if( $s->_meta->trace )
  {
    my $class = ref($s) || $s;
    cluck "$class: update($sql, values[" . join( ",", map {qq('$_')} @vals) . "])";
  }# end if()
  my $sth = $s->db_Main->prepare_cached( $sql );
  $sth->execute( @vals, $s->id );
  $sth->finish();
  
  foreach my $field ( grep { $changed->{$_} } sort keys(%$s) )
  {
    my $old_val = $changed->{$field}->{oldval};
    $s->_call_triggers( "after_update_$field", $old_val, $s->{$field} );
  }# end foreach()
  
  $s->{__Changed} = undef;
  $s->_call_triggers( after_update => $s );
  return 1;
}# end update()


#==============================================================================
sub delete
{
  my $s = shift;
  
  confess "$s\->delete cannot be called without an object" unless ref($s);
  
  $s->_call_triggers( before_delete => $s );
  
  my $sql = <<"";
    DELETE FROM @{[ $s->table ]}
    WHERE @{[ $s->primary_column ]} = ?

  if( $s->_meta->trace )
  {
    my $class = ref($s) || $s;



( run in 1.132 second using v1.01-cache-2.11-cpan-d7f47b0818f )