The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
###################################################
## 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.2.1';
  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{Pass}))   &&
         (exists ($p{DBType})) 
     ){
         $errstr = "Server, User, Pass, 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) = ();
    #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}";
         }
     }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);
     }
    #make the connection
     unless ($self->{dbh} = DBI->connect(
         $connect_str,
         $self->{User},
         $self->{Pass}
     )){
         $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 $select_str from $params{'From'} where $params{'Where'}";
     }else{
         $QUERY = "select $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;
         }
        #escape " 's
         $p{Insert}->{$_} =~s/\"/\"\"/g;
     }
    #formulate the sql
     my $field_names = join (', ', sort (keys %{$p{Insert}}));
     foreach (sort (keys %{$p{Insert}})){
         if (exists ($p{Ints}->{$_})){
             push (@vals, "$p{Insert}->{$_}");
         }else{
             push (@vals, "\"$p{Insert}->{$_}\"");
         }
     }
     my $field_values = join (', ',@vals);
     my $sql = "INSERT 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'};
     $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);
}