racalmas/lib/calcms/db.pm

package db;

use strict;
use warnings;
no warnings 'redefine';
use feature 'state';

use DBD::mysql();
use Digest::MD5 qw();
use Data::Dumper;

#use base 'Exporter';
our @EXPORT_OK = qw(
  connect disconnect
  get insert put
  next_id get_max_id
  shift_date_by_hours shift_datetime_by_minutes
  get_columns get_columns_hash
  $write
  $read
);

#database control
our $read  = 1;
our $write = 1;

# connect to database
my $database;
sub connect($;$) {
    my ($options, $request) = @_;

    return $request->{connection} if defined $request and defined $request->{connection};

    my $access_options = $options->{access};
    my $hostname = $access_options->{hostname};
    my $port     = $access_options->{port};
    $database    = $access_options->{database};
    my $username = $access_options->{username};
    my $password = $access_options->{password};

    if ( ( defined $access_options->{write} ) && ( $access_options->{write} eq '1' ) ) {
        $username = $access_options->{username_write};
        $password = $access_options->{password_write};
    }

    my $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port";
    my $key = Digest::MD5::md5_hex($dsn.$username.$password);
    return $options->{connections}->{$key} if defined $options->{connections}->{$key}; 
    state $connections = {};
    return $connections->{$key} if defined $connections->{$key} and $connections->{$key}->ping;

    my $dbh = DBI->connect( $dsn, $username, $password, { mysql_enable_utf8 => 1 } )
      || die "could not connect to database: $DBI::errstr";
    $dbh->{RaiseError} = 1;
    $dbh->{HandleError} = sub{
        print STDERR join(",",(caller($_))[0..3])."\n" for (1..2);
        return 0;
    };
    $dbh->{'mysql_enable_utf8'} = 1;
    put( $dbh, "set character set utf8", undef );
    put( $dbh, "set names utf8", undef );
    put( $dbh, "set time_zone='" . $options->{date}->{time_zone} . "'", undef );
    $request->{connection} = $dbh;
    #$options->{connections}->{$key} = $dbh;
    $connections->{$key} = $dbh;
    return $dbh;
}

sub disconnect ($){
    my ($request) = @_;
    my $dbh     = $request->{connection};
    $dbh->disconnect;
    delete $request->{connection};
    return;
}

# get all database entries of an sql query (as list of hashs)
sub get($$;$) {
    my ( $dbh, $sql, $bind_values ) = @_;

    my $sth = $dbh->prepare($sql);
    if ( ( defined $bind_values ) && ( ref($bind_values) eq 'ARRAY' ) ) {
        my $result = $sth->execute(@$bind_values);
        unless ($result) {
            print STDERR $sql . "\n";
            die "db: $DBI::errstr $sql" if ( $read == 1 );
        }
    } else {
        $sth->execute() or die "db: $DBI::errstr $sql" if $read == 1;
    }

    my $results = $sth->fetchall_arrayref({});

    $sth->finish;
    return $results;
}

# get list of table columns
sub get_columns($$) {
    my ($dbh, $table) = @_;
    my $columns = db::get( $dbh,
        qq{
            select column_name from information_schema.columns
            where table_schema=?
            and table_name = ?
            order by ordinal_position
        },
        [$database, $table]
    );
    return [ map { values %$_ } @$columns ];
}

# get hash with table columns as keys
sub get_columns_hash($$) {
    my ($dbh, $table) = @_;
    my $columns = get_columns($dbh, $table);
    return { map { $_ => 1 } @$columns };
}

#returns last inserted id
sub insert ($$$){
    my ($dbh, $table, $entry) =@_;

    my @keys = sort keys %$entry;
    my $keys = join( ",", map {"`$table`.`$_`"} @keys );
    my $values = join( ",", map { '?' } @keys );
    my @bind_values = map { $entry->{$_} } @keys;

    my $sql = "insert into `$table` \n ($keys) \n values ($values);\n";
    put( $dbh, $sql, \@bind_values );
    my $result = get( $dbh, 'SELECT LAST_INSERT_ID() id;' );
    return $result->[0]->{id} if $result->[0]->{id} > 0;
    return undef;
}

# execute a modifying database command (update,insert,...)
sub put($$$) {
    my ($dbh, $sql, $bind_values) =@_;

    my $sth = $dbh->prepare($sql);
    if ( $write == 1 ) {
        if ( ( defined $bind_values ) && ( ref($bind_values) eq 'ARRAY' ) ) {
            $sth->execute(@$bind_values);
        } else {
            $sth->execute();
        }
    }
    $sth->finish;

    my $result = get( $dbh, 'SELECT ROW_COUNT() changes;' );
    return $result->[0]->{changes} if $result->[0]->{changes} > 0;
    return undef;
}

# deprecated
sub quote($$) {
    my ($dbh, $sql) = @_;

    $sql =~ s/\_/\\\_/g;
    return $dbh->quote($sql);
}

#subtract hours, deprecated(!)
sub shift_date_by_hours($$$) {
    my ($dbh, $date, $offset) = @_;

    my $query       = 'select date(? - INTERVAL ? HOUR) date';
    my $bind_values = [ $date, $offset ];
    my $results     = db::get( $dbh, $query, $bind_values );
    return $results->[0]->{date};
}

#add minutes, deprecated(!)
sub shift_datetime_by_minutes($$$) {
    my ($dbh, $datetime, $offset) = @_;

    my $query       = "select ? + INTERVAL ? MINUTE date";
    my $bind_values = [ $datetime, $offset ];
    my $results     = db::get( $dbh, $query, $bind_values );
    return $results->[0]->{date};
}

# get next free id of a database table
sub next_id ($$){
    my ($dbh, $table) = @_;

    my $query = qq{
		select max(id) id
		from $table
		where 1
	};
    my $results = get( $dbh, $query );
    return $results->[0]->{id} + 1;
}

# get max id from table
sub get_max_id($$) {
    my ($dbh, $table) = @_;

    my $query = qq{
		select max(id) id
		from $table
		where 1
	};
    my $results = get( $dbh, $query );
    return $results->[0]->{id};
}

#do not delete last line!
1;