###################################################
## YAWM.pm
## Andrew N. Hicox <andrew@hicox.com>
## http://www.hicox.com
##
## Yet Annother Wrapper Module
## Handy tools for talking to databases
###################################################


## Global Stuff ###################################
  package DBIx::YAWM;
  use 5.6.0;
  use warnings;

  require Exporter;
  use AutoLoader qw(AUTOLOAD);
  
## Class Global Values ############################ 
  our @ISA = qw(Exporter);
  our $VERSION = 2.32;
  our $errstr = ();
  our @EXPORT_OK = ($VERSION, $errstr);


## new ############################################
 sub new {
    #local vars
     my %p = @_;
     my $obj = bless ({});
    #you must at least, include Server, User, Pass, and DBType
     unless (
         (exists ($p{Server})) &&
         (exists ($p{User}))   &&
         (exists ($p{DBType})) 
     ){
         $errstr = "Server, User, and DBType are required options to New";
         return (undef);
     }
    #if it's Oracle, we'll be needing a SID too
     if (($p{DBType} eq "Oracle") && (! exists ($p{SID}))){
         $errstr = "SID is a required option for DBType Oracle";
         return (undef);
     }
    #add in anything which might have been sent in
     foreach (keys %p){ $obj->{$_} = $p{$_}; }
    #default values
     $obj->{'LongReadLen'} = 15000 unless (exists($obj->{'LongReadLen'}));
     $obj->{'LongTruncOk'} = 0 unless (exists($obj->{'LongTruncOk'}));
    #login to database
     unless ($obj->Login()){
         $errstr = $obj->{errstr};
         return (undef);
     }
    #return object
     return ($obj);
 }


## Login ##########################################
 sub Login {
    #local vars
     my $self = shift();
     my %p = @_;
     my ($connect_str, @connect_args) = ();
    #are we already logged in?
     if (exists ($self->{dbh})){ return (1); }
    #require appropriate dbi module
     my $mod = "DBD\::$self->{DBType}";
     eval "require $mod";
     if ($@){
         $self->{'errstr'} = "Login: failed to load DBD module $mod: $@";
         return (undef);
     }
    #wow, a "connection string" ... 
     if ($self->{DBType} eq "Sybase"){
         $connect_str = "dbi:Sybase:server=$self->{Server}";
     }elsif ($self->{DBType} eq "Oracle"){
        #if we have a port number we could give that too
         if (exists($self->{Port})){
             $connect_str = "dbi:Oracle:host=$self->{Server};sid=$self->{SID};port=$self->{Port}";
         }else{
             $connect_str = "dbi:Oracle:host=$self->{Server};sid=$self->{SID}";
         }
     }elsif ($self->{DBType} eq "mysql"){
         $connect_str = "dbi:mysql";
         if ($self->{'Database'}){ $connect_str .= ":database=$self->{'Database'}"; }
         $connect_str .= ";host=$self->{Server};";
         if ($self->{'Port'}){ $connect_str .= "port=$self->{'Port'};"; }
     }else{
        #wow this is really ghetto
         $self->{errstr} = "Sorry Dude, ";
         $self->{errstr}.= "I don't know how to make connection strings for this DBType ";
         $self->{errstr}.= "someone needs to edit YAWM.pm";
         return (undef);
     }
     push (@connect_args, $connect_str);
     push (@connect_args, $self->{User});
     push (@connect_args, $self->{Pass}) if (exists($self->{Pass}));
    #make the connection
     unless ($self->{dbh} = DBI->connect(@connect_args)){
         $self->{errstr} = "Login failed: $DBI::errstr";
         return (undef);
     }
    #go ahead and set LongReadLen and LongTruncOk
     $self->{dbh}->{'LongReadLen'} = $self->{'LongReadLen'};
     $self->{dbh}->{'LongTruncOk'} = $self->{'LongTruncOk'};
    #it's all good baby bay bay ...
     return (1);
 }


## Destroy ########################################
 sub Destroy {
    my $self = shift;
    $self->{dbh}->disconnect;
    $self = undef;
 }
 

## True for perl include ##########################
 1;
__END__
## AutoLoaded Methods


## Query ##########################################
sub Query {
    #local vars
     my $self = shift();
     my %params = @_;
     my ($QUERY,$sth,@data,$rec_count,@OUT) = ();
    #check input for required data
     if (
         (! exists ($params{'Select'})) ||
         (! exists ($params{'From'}))
     ){
         $self->{errstr} = "Query missing required data.";
         return (undef);
     }
    #check that -Select is an array ref
     if (ref($params{'Select'}) ne "ARRAY"){
         $self->{errstr} = "Query: Select must be an array reference";
         return (undef);
     }
    #if not logged into db, do it now
     unless ($self->Login()){
         $self->{errstr} = "Login failed $self->{errstr}";
         return (undef);
     }
    #make a query string
     my $select_str = join (", ", @{$params{'Select'}});
     if (exists($params{'Where'})){
         $QUERY = "select " . $params{'Options'} . " $select_str from $params{'From'} where $params{'Where'}";
     }else{
         $QUERY = "select " . $params{'Options'} . " $select_str from $params{'From'}";
     }
    #prepare the query
     if ($self->{'Debug'} > 1){ print "[Query]: preparing query ...\n"; }
     if ($self->{'Debug'} > 1){ print "[Query]:\t $QUERY\n"; }
     unless ($sth = $self->{dbh}->prepare($QUERY)){
         $self->{errstr} = "Query: failed prepare: $QUERY / $DBI::errstr";
         return (undef);
     }
    #execute the query
     if ($self->{'Debug'} > 1){ print "[Query]: executing query ...\n"; }
     unless ($sth->execute()){
         $self->{errstr} = "[Query]: FATAL ERROR / can't execute query $QUERY / $DBI::errstr";
         return (undef);
     }
    #fetch the records
     if ($self->{'Debug'} > 1){ print "[Query]: fetching records ...\n"; }
     while (@data = $sth->fetchrow_array()){
         $rec_count ++;
         my $count = -1;
         my %hash = ();
         foreach (@data){
             $count ++;
             $hash{$params{'Select'}->[$count]} = $_;
         }
         push (@OUT,\%hash);
     }
     $sth->finish();
    #make sure we got something
     if (! $rec_count){
         if ($self->{'Debug'}){ print "[Query]: no records returned\n"; }
         $self->{errstr} = "no records returned";
         return (undef);
     }else{
         if ($self->{'Debug'}){ print "[Query]: recieved $rec_count records\n"; }
         return (\@OUT);
     }
}


## Insert #########################################
 ##insert a record into the given table of the 
 ##database. 
sub Insert {
    #local vars
     my ($self, %p) = @_;
     my (@vals,$sth) = ();
    #requried options
     unless (
         (exists($p{Insert})) &&
         (exists($p{Into}))
     ){
         $self->{errstr} = "Insert and Into are required options to Insert";
         return(undef);
     }
    #proctecting against disaster
     unless ($self->{CanInsert}){
         $self->{errstr} = "The CanInsert option was not set in this object at creation ";
         $self->{errstr}.= "you may not use the Insert method on this object.";
         return (undef);
     }
    #filters
     foreach (keys %{$p{Insert}}){
        #don't insert null values
         unless (length($p{Insert}->{$_})  > 0){
             delete($p{Insert}->{$_});
             next;
         }
     }
     
     #Ints has been replaced by 'NoQuote', but we maintain
     #backward compatibility
     foreach (keys %{$p{'Ints'}}){ $p{'NoQuote'}->{$_} = 1; }
    
    #formulate the sql
     my $field_names = join (', ', sort (keys %{$p{Insert}}));
     foreach (sort (keys %{$p{Insert}})){
     	if (exists($p{'NoQuote'}->{$_})){
     		push (@vals, $p{Insert}->{$_});
     	}else{
     		push (@vals, $self->{dbh}->quote($p{Insert}->{$_}));
     	}
     }
     
     my $field_values = join (', ',@vals);
     my $sql = "INSERT " . $p{'Options'} . " INTO $p{Into} ($field_names) VALUES ($field_values)";
    #prepare the statement
     if ($self->{'Debug'} > 1){ print "[Insert]: preparing query ...\n"; }
     if ($self->{'Debug'} > 1){ print "[Insert]:\t $sql"; }
     unless ($sth = $self->{dbh}->prepare($sql)){
         $self->{errstr} = "Insert: failed prepare: $sql / $DBI::errstr";
         return (undef);
     }
    #execute insert
     if ($self->{'Debug'} > 1){ print "[Insert]: executing insert ...\n"; }
     unless ($sth->execute()){
         $self->{errstr} = "[Insert]: FATAL ERROR / can't execute insert $sql / $DBI::errstr";
         return (undef);
     }
     $sth->finish();
    #well it must be all-good
     return (1);
}


## Do #############################################
## prepare and execute an SQL statement of no
## particular type. If errors are encountered undef is
## returned and errors go on $obj->{errstr} as usual
## if successfull, whatever is returned from dbi->execute
## is returned here
sub Do {
    #local vars
     my ($self, %p) = @_;
    #required options
     unless (exists($p{SQL})){
         $self->{'errstr'} = "[Do]: SQL is a required option to Do";
         return (undef);
     }
    #prepare statement
     warn ("[Do]: (prepare): $p{SQL}") if $self->{'Debug'};
     my $sth = $self->{dbh}->prepare($p{SQL}) || do {
         $self->{'errstr'} = "[Do]: failed to prepare SQL ($p{SQL}): $DBI::errstr";
         warn ($self->{'errstr'}) if $self->{'Debug'};
         return (undef);
     };
     warn ("[Do]: (executing)") if $self->{'Debug'};
     my $res = $sth->execute() || do {
         $self->{'errstr'} = "[Do]: failed to execute SQL ($p{SQL}): $DBI::errstr";
         warn ($self->{'errstr'}) if $self->{'Debug'};
         return (undef);
     };
     $sth->finish();
     return ($res);
}


## Update #########################################
## update a record (or records) in the database with 
## new field settings
sub Update {
	my ($self, %p) = @_;
   #required options
   	exists($p{'Table'}) || do {
   		$self->{'errstr'} = "[Update]: 'Table' specifies the table of view to update the record(s) in, please specify";
		warn ($self->{'errstr'}) if $self->{'Debug'};
		return (undef);
   	};
   	exists($p{'Where'}) || do {
   		$self->{'errstr'} = "[Update]: 'Where' specified which record(s) in 'Table' to update. please specify";
   		warn ($self->{'errstr'}) if $self->{'Debug'};
		return (undef);
   	};
   	exists($p{'Fields'}) || do {
   		$self->{'errstr'} = "[Update]: 'Fields' is a hash reference indicating the field values to update, please specify";
   		warn ($self->{'errstr'}) if $self->{'Debug'};
		return (undef);
   	};
   #construct SQL String
    my $sql = "update " . $p{'Options'} . " " . $p{'Table'} . " set ";
    my @fields = ();
	foreach (keys %{$p{'Fields'}}){
		my $str = "$_ = ";
		$str   .= $self->{dbh}->quote($p{'Fields'}->{$_});
		push (@fields, $str); 
	}
	$sql .= join(", ", @fields);
	$sql .= " ";
	$sql .= "where $p{'Where'}";
    warn("[Update]: (prepare): $sql\n") if $self->{'Debug'};
   #prepare sql
    my $sth = $self->{dbh}->prepare($sql) || do {
    	$self->{'errstr'} = "[Update]: failed to prepare sql statement $DBI::errstr [SQL]: $sql";
    	warn ($self->{'errstr'}) if $self->{'Debug'};
        return (undef);
    };
   #execute sql
    $sth->execute() || do {
    	$self->{'errstr'} = "[Update]: failed to execute sql: $DBI::errstr";
    	warn ($self->{'errstr'}) if $self->{'Debug'};
        return (undef);
    };
    return (1);
}




## flatQuery ######################################
## use DBI's built in fetchrow_hashref(), which
## (I'm guessing) is implemented in xs and far 
## superior to what we've been doing here for all
## these years. As such, we don't (necessarily)
## have to take an array ref on Select ... 
## hence the name 'flatQuery' ... we can take either
## a string or an array ... otherwise pretty much
## the same old.

sub flatQuery {

	my ($self, %p) = @_;
	
	#verify required inputs
	foreach ('Select', 'From'){
		exists($p{$_}) || do {
			$self->{'errstr'} = $_ . " is a required option to Query";
			return (undef);
		};
	}
	
	#select has to be an array reference or a string
	if ($#{$p{'Select'}} >= 0){
		
		#flatten select
		$p{'Select'} = join (', ', @{$p{'Select'}});
	
	}
	
	#error out if it's a null string
	(length($p{'Select'}) > 0) || do {
		$self->{'errstr'} = "'Select' option contains no fields to select!";
		return (undef);
	};
	
	#log into the database
	$self->Login() || do {
		$self->{'errstr'} = "Login failed: " . $self->{'errstr'};
		return (undef);
	};
	
	#struct query string
	my $QUERY = "select " . $p{'Options'} . " " . $p{'Select'} . " from " . $p{'From'};
	$QUERY   .= " where " . $p{'Where'} if ($p{'Where'} !~/^\s*$/);
	
	#prepare the query
	warn ("[Query]: preparing query ...") if ($self->{'Debug'} > 1);
	warn ("[Query]:\t $QUERY\n") if ($self->{'Debug'} > 1);
	my $sth = $self->{'dbh'}->prepare($QUERY) || do {
		$self->{errstr} = "Query: failed prepare: $QUERY / $DBI::errstr";
		return (undef);
	};
	
	#execute query
	warn ("executing query ...") if $self->{'Debug'};
	$sth->execute() || do {
	
		$self->{'errstr'} = "can't execute query: " . $QUERY . " / " . $DBI::errstr;
		return (undef);
	
	};
	
	#well now dbi does hashref internal, and you know its got to be better than what we've been
	#up to ... so we're going to use this. with any luck, this'll handle the 'as' clause as well
	my (@out, $rec) = ();
	while ($rec = $sth->fetchrow_hashref()){ 
	
		#translate field names to lowercase if option supplied
		if ($p{'lc'} !~/^\s*$/){
			foreach my $k (keys %{$rec}){
				my $kl = lc($k);
				$rec->{$kl} = $rec->{$k};
				delete($rec->{$k}) if ($k ne $kl);
			}
		}
	
		push (@out, $rec); 
		
	}
	$sth->finish();
	warn ("retrieved: " . ($#out + 1) . " records") if $self->{'Debug'};
	
	#if no records returned
	($#out >= 0) || do {
		$self->{'errstr'} = "no records returned";
		return (undef);
	};
	
	#return what we got
	return (\@out);
}