view release on metacpan or  search on metacpan

lib/DBD/Log/Sth.pm  view on Meta::CPAN

}

sub logCall {
  my ( $function, $self, @rest ) = @_;

  # are we logging this?
  return undef if !$self->dbiLogging;

  my ($command) = lc($self->statement) =~ /^(\w+)/;
  if ( $self->logThis->[0] ne "all"
       && !grep { $_ eq $command } @{$self->logThis}
     ) {
    return undef;
  }

  $self->printLog("[$function]", $self->statement, @rest);
}

sub logAction {
  my ( $function, $self, @rest ) = @_;

  # define logging
  @rest = () if !$self->fullLogging;

  my ($command) = lc($self->statement) =~ /^(\w+)/;
  if ( $self->logThis->[0] ne "all"
       && !grep { $_ eq $command } @{$self->logThis}
     ) {
    return undef;
  }

  if ( $function eq "execute" ) {
    $self->printLog( $self->composeStatement(@{$self->bound}), @rest );

  } elsif ( $function eq "execute_array" ) {
    if ( ref($self->bound->[0]) ) {
      foreach my $bound ( @{$self->bound} ) {
	my @print = $self->composeStatement(@$bound);
	$self->printLog( @print, @rest );
      }

    } else {
      $self->printLog( $self->composeStatement(@{$self->bound}), @rest );
    }
  }

}

sub composeStatement {
  my ( $self, @bound ) = @_;

  my $statement = $self->statement;

  if ( $statement =~ /\?/ ) {
    my @parts = split(/\?/, $statement);

    for ( 0..$#parts ) {
      # skip the parts that are not bound.
      next if !defined $bound[$_];

      # if the bound value is NaN, wrap it in quotes.
      my $val = $bound[$_];
      $val =~ /\D+/ && ( $val = "'$val'" );

      $parts[$_] .= $val;
    }

    $statement = join("", @parts);
    if ( ($#parts+1) < $#bound ) {
      @bound = splice(@bound, $#parts+1, $#bound);
    } else {
      @bound = ();
    }

  } elsif ( $statement =~ /\:\w+/ ) {
    # oracle style replacement

    $statement =~ s/(\:\w+)/&oracleSubstitute($1, \@bound)/eg;
    @bound = ();
  }

  return $statement, @bound
}

sub oracleSubstitute{
  my ( $subst, $bound ) = @_;
  my $var = "";

  my @list = grep { $_->[0] eq $subst } @$bound;
  @list && ( $var = $list[0]->[1] );

  ref($var) =~ /scalar/i && ( $var = $$var );
  $var =~ /\D+/ && ( $var = "'$var'" );
  $var ||= "''";

  return $var;
}

## make multiple routines

# logging actions
foreach my $sub ( qw( execute bind_param execute_array bind_param_array bind_param_inout ) ) {

  *{"DBD::Log::Sth::$sub"} = sub {
    my ( $self, @rest ) = @_;

    my @bound = @{$self->bound};

    if ( $#rest >= 0 ) {

      if ( $sub eq "execute" ) {
	# bind litteral
	@bound = @rest;
      } elsif ( $sub eq "execute_array" ) {
	if ( $#rest >= 1 ) {
	  # bind the array
	  @bound = @rest[1..$#rest];
	}

      } elsif ( $#rest >= 1 && $rest[0] =~ /\D+/ ) {
	# oracle style binding