package sql_helper;
# $Id: sql_helper.pm,v 1.8 2003/08/06 12:45:10 ivan Exp $

use DBI;
# ? just for early detection of DBD::mysql absence
use DBD::mysql; # unportable (sql-wise)


$VERSION = "0.2";

use Exporter;

@ISA = ('Exporter');
@EXPORT_OK = qw( &sql_connect &quote &sql_query &sql_do 
		 &sql_do_direct
		 &get_table_info 
		 &list_tables );



use strict;

use vars qw( 
 $DB_H $CONNECTED $ERROR $LOG
 %STATEMENTS 
 $QUERY $PARAMS
);

my $driver = "mysql";
$CONNECTED = 0;

my @DB_HANDLES;

=pod 

=head1 NAME

sql_helper - simple Object oriented interface to SQL (MySQL)

=head1 SYNOPSIS

    ###  set the log filename
    sql_helper -> set_log_filename ( 'sql_helper.log' );

    ###  create the object
    my $sql = sql_helper -> new ( $database, $db_user, $db_pass ); 

    ###  check the object
    if( $sql ) { 
	# connected succesfully

    } else {
	# failed to connect, look to the log file
	die;
    }

    ###  run a simple statement
    $sql -> do ( 'DROP TABLE unnecessary' )
       || warn "failed to drop unnecessary table";

    ###  run a query 
    $sql -> prepare( "SELECT * FROM resources WHERE handle LIKE 'RePEc:per:%' " );
    my $r = $sql -> execute();

    ###  check the result
    while ( $r->{row} ) {  
	###   ->{row} contains a reference to the field => value hash
	my $record = $r -> {row};

	my ( $title, $handle, $abstract );

	###   -> get( 'field' ) retrieves the value:
	$title = $r -> get( 'title' );
	
	###  ... and that is equivalent to:
	$title = $record -> {'title'};

	###  ...and equivalent to (as you may guess):
	$title = $r -> {row} {title};

	###  get other fields
	$abstract = $record -> {abstract};
	$handle   = $record -> {handle};

	###  iterates to the next record in the query's return set
	$r-> next();
    }


    ###  a query with a parameter
    $sql -> prepare( 'select * from author_map where handle = ? ' );
    $r = $sql -> execute( $handle );   

    ###  another one:
    $sql -> prepare( 'select * from person where lname = ? ' );
    ###  the param value is automatically quoted (!):
    $r = $sql -> execute( "O'Brien" );   

=cut

###################################################################
##    Object oriented interface for simple SQL mediation
###################################################################

use sql_result;


###  log file name
sub set_log_filename {  
    my $class = shift;
    my $name = shift;
    $LOG = $name;
}


###  constructor

sub new {
    my $class = shift;
    my @par = @_;
 
    my $self = {};
    
    bless $self, $class;
    
    my $id = scalar @DB_HANDLES;

    $self->{id} = $id;

    $self->connect( @par );

    return( $self )
	if $self->{dbh};

    return ( 0 );
}


sub log {
    my $self = shift;
    my $id = $self->{id};

    put_to_log( "[$id] " , @_ );
}


sub query_log {
  my $self = shift;

  $self->log ( "query: '$self->{query}'" );
  if( $self->{qparams} ) {
    $self->log ( "values: '$self->{qparams}'" );
  }
  $self->log ( @_ );
  return 0;  
}


sub connect {
    my $self = shift;

    my $database = shift;
    my $user = shift;
    my $pass = shift;
    my $host = shift;
    my $port = shift;

    my $connect_string = "DBI:$driver:$database";

    if( defined $host ) {
	$connect_string .= ":$host";
	if( defined $port ) {
	    $connect_string .= ":$port";
	}
    }

    my $dbh;

    eval {
      $dbh = DBI -> connect( $connect_string, $user, $pass,
			     {
#			      'RaiseError'=>1,
#			      'PrintError'=>1 
			     } );
    };
    

    if( not $@ and $dbh ) {
	$self->{dbh} = $dbh;
	$self->log ( "Connected to a server" );

	push @DB_HANDLES, $dbh;

    } else {
	$self->log ( "Failed attempt to connect to a server ($connect_string, $user, $pass) ($@)" );
	warn $@;
	return undef;
    }

    return $dbh;
}



sub query { }


sub do {
    my $self = shift;
    my $dbh = $self->{dbh};

    $self->{query}  = join ", ", @_;
    $self->{qparams} = '';

    my $r;
    eval { 
      $r = $dbh->do ( @_ );
    };

    if( not $r or $@ ) {
      $self->query_log ( "do: " , $dbh->errstr() );
      return undef;
    }

    $self->{last_sth} = undef;

    return $r;
}


sub prepare {
    my $self = shift;
    my $dbh = $self->{dbh};

    $self->{query}  = join ", ", @_;
    $self->{qparams} = '';

    my $r;
    
    eval {
      $r = $dbh->prepare ( @_ );
    };    
    if ( not $r or $@ ) {
      $self->query_log ( "prepare result: ", $dbh->errstr() );
      return undef;
    }

    $self->{last_sth} = $r;

    return $r;
}


sub prepare_cached {
    my $self = shift;
    my $dbh = $self->{dbh};

    $self->{query}  = join ", ", @_;
    $self->{qparams} = '';

    my $r;
    eval {
      $r = $dbh->prepare_cached ( @_ )
    };
    if( not $r or $@ ) {
      $self->query_log ( "cached prepare result: " , $dbh->errstr() );
      return undef;
    }

    $self->{last_sth} = $r;

    return $r;
}



sub execute {
    my $self = shift;
    my $dbh = $self->{dbh};

    my $sth = $self->{last_sth};

    if( $sth ) {

      $self -> {qparams} = join "', '", @_;

      my $r;
      eval {
	$r = $sth -> execute( @_ );
      };

      if( $r and not $@ ) {
	return sql_result -> new( $sth );

      } else {
	$self -> query_log ( "execute res: ", $dbh -> errstr() );
      }
      
    }
    return undef;
}



sub error
 {
  return shift -> {'dbh'} -> errstr;
 }



###############################################################################
###    OLD FUNCTIONAL INTERFACE
###############################################################################


###############################################################################
#            S Q L    C O N N E C T 
###############################################################################

sub sql_connect {   # obsolete

    my $database = shift;
    my $user = shift;
    my $pass = shift;
    my $host = shift;
    my $port = shift;

    my $connect_string = "DBI:$driver:$database";

    if( $CONNECTED ) {
	$DB_H -> disconnect();
	$CONNECTED = 0;
    }

    if( defined $host ) {
	$connect_string .= ":$host";
	if( defined $port ) {
	    $connect_string .= ":$port";
	}
    }

    $DB_H = DBI -> connect( $connect_string, $user, $pass,
			    {'RaiseError'=>0,
			     'PrintError'=>1} );

    if ( not $DB_H ) {
	$CONNECTED = 0;
	put_to_log ( "Failed attempt to connect to a server" );

    } else {
	$CONNECTED = 1;
	put_to_log ( "Connected to a server" );
    }

    return $CONNECTED;
}



END {
    foreach my $sth ( values %STATEMENTS ) {
	if( $sth->{Active} ) {
#	  warn "An active statement left unclosed.  I finish it, but you should do it yourself.";
	  $sth->finish;
	}
    }

    foreach my $dbh ( @DB_HANDLES ) {
	$dbh->disconnect();
    }

    if( $CONNECTED ) {
	$DB_H -> disconnect();
	put_to_log ( "Disconnected from a server" );
	$CONNECTED = 0;
    }
}


###############################################################################
#       Q U O T E 
###############################################################################

sub quote {     # obsolete
    return $DB_H -> quote ( shift );
}




###############################################################################
#             S Q L    S E T    L O G    F I L E N A M E 
###############################################################################

sub sql_set_log_filename {  
    my $name = shift;
    $LOG = $name;
}


###############################################################################
#             P U T    T O    L O G    
###############################################################################


sub put_to_log {   # used by log method, not for direct usage
    if( $LOG ) {
	open LOG, ">>$LOG" || die "Can't open SQL log: $LOG";
	print LOG scalar( localtime (time) ) , " ", @_, "\n";
	close LOG;
    } else {
	print STDERR scalar( localtime (time) ) , " ", @_, "\n";
    }
}





###############################################################################
#             S Q L    Q U E R Y    E X E C U T E 
###############################################################################
sub sql_query_execute {   # obsolete

    my $q = shift || die;
    my $descr = shift;

    my @params = @_;

    my $sth;

    if( exists $STATEMENTS{$q} ) {
	if( defined $STATEMENTS{$q} ) {
	    $sth = $STATEMENTS{$q};

	} else {
	    put_to_log( "Bad query ($descr) execution has been requested" );
	    return undef;
	}

    } else {
	if ( not $sth = $DB_H -> prepare( $q ) ) {
	    $ERROR = $DB_H -> errstr;
	    put_to_log( "Query: '$q' ($descr) is bad: '$ERROR'" );
	    $STATEMENTS{$q} = undef;
	    return undef;
	} 
	put_to_log( "Query: '$q' ($descr) has been successfully prepared" );
	$STATEMENTS{$q} = $sth;
    }

    my $res ;

    if ( not $res = $sth -> execute( @_ ) ) {
	$ERROR = $DB_H -> errstr;
	put_to_log( "Query: $descr failed: '$ERROR'" );
	return undef;
    }

    put_to_log( "Execute: $descr - OK ($res)" );
    return ( $sth, $res );
}

###############################################################################
#                S Q L    Q U E R Y 
###############################################################################

sub sql_query {   # obsolete
    my $q = shift || die "give query string";
    my $d = shift || die "give query description to the sql_query()";

    my ($sth, $res ) = sql_query_execute( $q, $d, @_ );

    my @result = ();

    if( not defined $sth ) {
	return undef;
    } 
    if( not $sth -> rows ) { 
#	$sth -> finish;
	return []; 
    }

    my $rows = $sth -> rows;
    
    my $i = 0;
    while ( $i < $rows ) {
	my @array = $sth -> fetchrow_array;
	push @result, \@array;

# debug:
#	print "ROW: [ " , join ( ', ' , @array ) , " ]\n" ;

	$i++;
    }

#    $sth->finish;
    return \@result;
}



###############################################################################
#                S Q L    Q U E R Y    --   S C A L A R    R E S U L T 
###############################################################################

sub sql_query_scalar_result {  # obsolete
    my $q = shift || die;
    my $d = shift || die;

    my ($sth, $res ) = sql_query_execute( $q, $d, @_ );

    my @result = ();

    if( not defined $sth ) {
	return undef;
    } 
    if( not $sth -> rows ) { 
#	$sth -> finish;
	return undef; 
    }

    my $rows = $sth -> rows;
    
    if ( $rows > 1 ) {
	### strange, because normally you would 
	die "scalar result query returned a table instead";
    }
    
    my @array = $sth -> fetchrow_array;
    if( scalar @array > 1 ) {
	### strange
	die "scalar result query returned a multiple-value row instead";
    }

#    $sth->finish;
    return $array[0];
}


###############################################################################
#                S Q L    D O    S T A T E M E N T  
###############################################################################
 
sub sql_do_direct {   # obsolete
    my $q = shift || die;
    my $d = shift || die ;

    my $r; 
    eval {
	$r = $DB_H -> do ( $q, undef, @_ ) ;
    } ;
    $ERROR = $DB_H -> errstr;
    if( $ERROR ) {
	put_to_log( "Statement: '$q' ($d) failed: '$ERROR'" );
	return undef;

    } else {
	put_to_log( "SQL: $d - OK" );
	return $r;
    }
}


sub sql_do {  # obsolete
    my $q = shift || die;
    my $d = shift || die ;

    my ($sth, $r) = sql_query_execute( $q, $d, @_ );

    return $r;
}



###############################################################################
#   L I S T    T A B L E S 
###############################################################################
sub list_tables {  # obsolete
    return $DB_H -> tables();
}

###############################################################################
#   G E T    T A B L E    I N F O  
############################################################################### 
sub get_table_info {  # obsolete

    my $tname = shift;
    my @tables = $DB_H -> tables();
    foreach my $t ( @tables )  {
#	print "table $t exists...";
	if( $t eq $tname ) {
#	    print "that's what we need!\n";
	    return sql_query( "DESCRIBE $tname", "getting details of table $tname" );
	}
#	print "\n";
    }
    return undef;
}


###############################################################################
#   MYSQL LAST INSERT ID
###############################################################################
sub mysql_last_insert_id {  # obsolete
    return $DB_H->{'mysql_insertid'};
}

###############################################################################
#
###############################################################################
###############################################################################
#
###############################################################################
###############################################################################
#
###############################################################################
###############################################################################
#
###############################################################################



###############################################################################
###############################################################################
###############################################################################
###############################################################################
###############################################################################
###############################################################################








1;

