lib/MyDB.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: MyDB.pm,v $
   4
   5 Object oriented, quick and easy interface to MySQL/MariaDB databases
   6
   7 =head1 VERSION
   8
   9 =over
  10
  11 =item Author
  12
  13 Andrew DeFaria <Andrew@DeFaria.com>
  14
  15 =item Revision
  16
  17 $Revision: 1.0 $
  18
  19 =item Created
  20
  21 Sat 19 Jun 2021 11:05:00 PDT
  22
  23 =item Modified
  24
  25 $Date: $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31 Provides lower level, basic database routines in an Perl object
  32
  33   # Instanciate MyDB object
  34   my $db = MyDB->new(<database>, <username>, <password>, %opts);
  35
  36   # Add record
  37   my $status = $db->add(<tablename>, <%record>);
  38
  39   # Delete record
  40   my $status = $db->delete(<tablename>, <condition>);
  41
  42   # Modify record
  43   my $status = $db->modify(<tablename>, <%record>, <condition>)
  44
  45   # Get records
  46   my @records = $db->get(<tablename>, <condition>, <fields>, <additional>)
  47
  48 =head1 DESCRIPTION
  49
  50 Low level but convienent database routines
  51
  52 =head1 ROUTINES
  53
  54 The following routines are exported:
  55
  56 =cut
  57
  58 package MyDB;
  59
  60 use strict;
  61 use warnings;
  62
  63 use Carp;
  64 use DBI;
  65 use Exporter;
  66
  67 use Utils;
  68
  69 # Globals
  70 our $VERSION  = '$Revision: 1.0 $';
  71    ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
  72
  73 my %opts = (
  74   MYDB_USERNAME => $ENV{MYDB_USERNAME},
  75   MYDB_PASSWORD => $ENV{MYDB_PASSWORD},
  76   MYDB_DATABASE => $ENV{MYDB_DATABASE},
  77   MYDB_SERVER   => $ENV{MYDB_SERVER} || 'localhost',
  78 );
  79
  80 # Internal methods
  81 sub _dberror($$) {
  82   my ($self, $msg, $statement) = @_;
  83
  84   my $dberr    = $self->{db}->err;
  85   my $dberrmsg = $self->{db}->errstr;
  86
  87   $dberr    ||= 0;
  88   $dberrmsg ||= 'Success';
  89
  90   my $message = '';
  91
  92   if ($dberr) {
  93     my $function = (caller(1)) [3];
  94
  95     $message = "$function: $msg\nError #$dberr: $dberrmsg\n"
  96              . "SQL Statement: $statement";
  97   } # if
  98
  99   return $dberr, $message;
 100 } # _dberror
 101
 102 sub _encode_decode ($$$) {
 103   my ($self, $type, $password, $userid) = @_;
 104
 105   my $statement = 'select ';
 106
 107   if ($type eq 'encode') {
 108     $statement .= "hex(aes_encrypt('$password','$userid'))";
 109   } elsif ($type eq 'decode') {
 110     $statement .= "aes_decrypt(unhex('$password'),'$userid')";
 111   } # if
 112
 113   my $sth = $self->{db}->prepare($statement)
 114     or return $self->_dberror('MyDB::$type: Unable to prepare statement', $statement);
 115
 116   $sth->execute
 117     or $self->_dberror('MyDB::$type: Unable to execute statement', $statement);
 118
 119   my @row = $sth->fetchrow_array;
 120
 121   return $row[0];
 122 } # _encode_decode
 123
 124 sub _formatValues(@) {
 125   my ($self, @values) = @_;
 126
 127   my @returnValues;
 128
 129   # Quote data values
 130   push @returnValues, ($_ and $_ ne '')
 131                     ? $self->{db}->quote($_)
 132                     : 'null'
 133     for (@values);
 134
 135   return @returnValues;
 136 } # _formatValues
 137
 138 sub _formatNameValues(%) {
 139   my ($self, %rec) = @_;
 140
 141   my @nameValueStrs;
 142
 143   for (keys %rec) {
 144     if ($rec{$_}) {
 145       push @nameValueStrs, "$_=" . $self->{db}->quote($rec{$_});
 146     } else {
 147       push @nameValueStrs, "$_=null";
 148     } # if
 149   } # for
 150
 151   return @nameValueStrs;
 152 } # _formatNameValues
 153
 154 sub add($%) {
 155   my ($self, $table, %rec) = @_;
 156
 157   my $statement  = "insert into $table (";
 158      $statement .= join ',', keys %rec;
 159      $statement .= ') values (';
 160      $statement .= join ',', $self->_formatValues(values %rec);
 161      $statement .= ')';
 162
 163   $self->{db}->do($statement);
 164
 165   return $self->_dberror("Unable to add record to $table", $statement);
 166 } # add
 167
 168 sub check($) {
 169   my ($self, $table) = @_;
 170
 171   my @tables;
 172
 173   if (ref $table eq 'ARRAY') {
 174     @tables = @$table;
 175   } else {
 176     push @tables, $table;
 177   } # if
 178
 179   my $statement  = 'check table ';
 180      $statement .= join ',', @tables;
 181
 182   $self->{db}->do($statement);
 183
 184   return $self->_dberror('MyDB::check: Unable to check tables', $statement);
 185 } # check
 186
 187 sub count($;$) {
 188   my ($self, $table, $condition) = @_;
 189
 190   my $statement  = "select count(*) from $table";
 191      $statement .= " where $condition" if $condition;
 192
 193   my $sth = $self->{db}->prepare($statement)
 194     or return $self->_dberror('MyDB::count: Unable to prepare statement', $statement);
 195
 196   $sth->execute
 197     or return $self->_dberror('MyDB::count: Unable to execute statement', $statement);
 198
 199   # Get return value, which should be how many entries there are
 200   my @row = $sth->fetchrow_array;
 201
 202   # Done with $sth
 203   $sth->finish;
 204
 205   my $count;
 206
 207   # Retrieve returned value
 208   unless ($row[0]) {
 209     wantarray ? return (0, 'No records found') : return 0;
 210   } else {
 211     wantarray ? return ($row[0], 'Records found') : return $row[0];
 212   } # unless
 213
 214   return;
 215 } # count
 216
 217 sub count_distinct($$;$) {
 218   my ($self, $table, $column, $condition) = @_;
 219
 220   my $statement  = "select count(distinct $column) from $table";
 221      $statement .= " where $condition" if $condition;
 222
 223   my $sth = $self->{db}->prepare($statement)
 224     or return $self->_dberror('MyDB::count: Unable to prepare statement', $statement);
 225
 226   $sth->execute
 227     or return $self->_dberror('MyDB::count: Unable to execute statement', $statement);
 228
 229   # Get return value, which should be how many entries there are
 230   my @row = $sth->fetchrow_array;
 231
 232   # Done with $sth
 233   $sth->finish;
 234
 235   my $count;
 236
 237   # Retrieve returned value
 238   unless ($row[0]) {
 239     wantarray ? return (0, 'No records found') : return 0;
 240   } else {
 241     wantarray ? return ($row[0], 'Records found') : return $row[0];
 242   } # unless
 243
 244   return;
 245 } # count_distinct
 246
 247 sub decode($$) {
 248   my ($self, $password, $userid) = @_;
 249
 250   return $self->_encode_decode('decode', $password, $userid);
 251 } # decode
 252
 253 sub delete($;$) {
 254   my ($self, $table, $condition) = @_;
 255
 256   my $count = $self->count($table, $condition);
 257
 258   return ($count, 'Records deleted') if $count == 0;
 259
 260   my $statement  = "delete from $table ";
 261   $statement    .= "where $condition" if $condition;
 262
 263   $self->{db}->do($statement);
 264
 265   if ($self->{db}->err) {
 266     my ($err, $msg) = $self->_dberror("MyDB::delete: Unable to delete record(s) from $table", $statement);
 267
 268     wantarray ? return (-$err, $msg) : return -$err;
 269   } else {
 270     wantarray ? return ($count, 'Records deleted') : return $count;
 271   } # if
 272
 273   return;
 274 } # delete
 275
 276 sub DESTROY {
 277   my ($self) = @_;
 278
 279   $self->{db}->disconnect if $self->{db};
 280
 281   return;
 282 } # DESTROY
 283
 284 sub encode($$) {
 285   my ($self, $password, $userid) = @_;
 286
 287   return $self->_encode_decode('encode', $password, $userid);
 288 } # encode
 289
 290 sub find($;$@) {
 291   my ($self, $table, $condition, $fields, $additional) = @_;
 292
 293   $fields //= '*';
 294
 295   $fields = join ',', @$fields if ref $fields eq 'ARRAY';
 296
 297   my $statement  = "select $fields from $table";
 298      $statement .= " where $condition" if $condition;
 299      $statement .= " $additional"      if $additional;
 300
 301   $self->{sth} = $self->{db}->prepare($statement)
 302     or return $self->_dberror('MyDB::find: Unable to prepare statement', $statement);
 303
 304   $self->{sth}->execute
 305     or return $self->_dberror('MyDB::find: Unable to execute statement', $statement);
 306
 307   return $self->_dberror("MyDB::find: Unable to find record ($table, $condition)", $statement);
 308 } # find
 309
 310 sub get($;$$$) {
 311   my ($self, $table, $condition, $fields, $additional) = @_;
 312
 313   $fields //= '*';
 314
 315   $fields = join ',', @$fields if ref $fields eq 'ARRAY';
 316
 317   my $statement  = "select $fields from $table";
 318      $statement .= " where $condition" if $condition;
 319      $statement .= " $additional"      if $additional;
 320
 321   my $rows = $self->{db}->selectall_arrayref($statement, { Slice => {} });
 322
 323   return $rows if $rows;
 324   return $self->_dberror('MyDB::get: Unable to prepare/execute statement', $statement);
 325 } # get
 326
 327 sub getone($;$$$) {
 328   my ($self, $table, $condition, $fields, $additional) = @_;
 329
 330   my $rows = $self->get($table, $condition, $fields, $additional);
 331
 332   return $rows->[0];
 333 } # getone
 334
 335 sub getnext() {
 336   my ($self) = @_;
 337
 338   return unless $self->{sth};
 339
 340   return $self->{sth}->fetchrow_hashref;
 341 } # getnext
 342
 343 sub lastid() {
 344   my ($self) = @_;
 345
 346   my $statement = 'select last_insert_id()';
 347
 348   my $sth = $self->{db}->prepare($statement)
 349     or $self->_dberror('MyDB::lastid: Unable to prepare statement', $statement);
 350
 351   $sth->execute
 352     or $self->_dberror('MyDB::lastid: Unable to execute statement', $statement);
 353
 354   my @row = $sth->fetchrow_array;
 355
 356   return $row[0];
 357 } # lastid
 358
 359 sub lock(;$$) {
 360   my ($self, $type, $table) = @_;
 361
 362   $type //= 'read';
 363
 364   croak "Type must be read or write" unless $type =~ /(read|write)/;
 365
 366   my $tables;
 367
 368   if (ref $table eq 'ARRAY') {
 369     $tables = join " $type,", @$table;
 370   } else {
 371     $tables = $table;
 372   } # if
 373
 374   my $statement  = "lock tables $tables";
 375      $statement .= " $type";
 376
 377   $self->{db}->do($statement);
 378
 379   return $self->_dberror("MyDB::lock Unable to lock $tables", $statement);
 380 } # lock
 381
 382 sub modify($$%) {
 383   my ($self, $table, $condition, %rec) = @_;
 384
 385   my $statement  = "update $table set ";
 386      $statement .= join ',', $self->_formatNameValues(%rec);
 387      $statement .= " where $condition" if $condition;
 388
 389   $self->{db}->do($statement);
 390
 391   return $self->_dberror("MyDB::modify: Unable to update record in $table", $statement);
 392 } # modify
 393
 394 sub new(;$$$$) {
 395   my ($class, $username, $password, $database, $dbserver) = @_;
 396
 397   my $self = {
 398     username => $username || $opts{MYDB_USERNAME},
 399     password => $password || $opts{MYDB_PASSWORD},
 400     database => $database || $opts{MYDB_DATABASE},
 401     dbserver => $dbserver || $opts{MYDB_SERVER},
 402   };
 403
 404   bless $self, $class;
 405
 406   $self->{dbdriver} = 'mysql';
 407
 408   $self->{db} = DBI->connect(
 409     "DBI:$self->{dbdriver}:$database:$self->{dbserver}",
 410     $self->{username},
 411     $self->{password},
 412     {PrintError => 0},
 413   ) or croak "MyDB::new: Couldn't connect to $database database as $self->{username}\@$self->{dbserver}";
 414
 415   return $self;
 416 } # new
 417
 418 sub optimize($) {
 419   my ($self, $table) = @_;
 420
 421   my @tables;
 422
 423   if (ref $table eq 'ARRAY') {
 424     @tables = @$table;
 425   } else {
 426     push @tables, $table;
 427   } # if
 428
 429   my $statement  = 'optimize table ';
 430      $statement .= join ',', @tables;
 431
 432   $self->{db}->do($statement);
 433
 434   return $self->_dberror('MyDB::optimize: Unable to optimize tables', $statement);
 435 } # optimize
 436
 437 sub unlock() {
 438   my ($self) = @_;
 439
 440   my $statement = 'unlock tables';
 441
 442   $self->{db}->do($statement);
 443
 444   return $self->_dberror('MyDB::unlock: Unable to unlock tables', $statement);
 445 } # unlock
 446
 447 sub update($$%) {
 448   # Using a Perl goto statement in this fashion really just creates an alias
 449   # such that the user can call either modify or update.
 450   goto &modify;
 451 } # update
 452
 453 1;