package MySQL::Keeper;
use strict;
use warnings 'all';
use base qw(Contenido::Keeper);
use locale;
use Data::Dumper;
use DBI;
use DBD::mysql;
use IO::File;
use File::Copy;
use Image::Size;
use Contenido::Globals;
use MySQL::Globals;
# ------------------------------------------------------------------------------------------------
# Конструктор объекта базы данных.
# Обязательный параметр - объект класса Contenido::State из которого
# конструктор возьмет необходимые параметры для доступа к БД и т.д.
#
# Формат вызова:
# MySQL::Keeper->new($state)
# ------------------------------------------------------------------------------------------------
sub new
{
my ($proto, $state) = @_;
die "Contenido Die: Неправильный вызов конструктора объекта базы данных. В параметрах нет объекта класса MySQL::State\n" unless ref($mstate);
my $class = ref($proto) || $proto;
my $self = {};
bless($self, $class);
# Заполним собственные свойства конкретными данными...
$self->{db_type} = 'remote';
$self->{db_keepalive} = 1;
$self->{db_host} = $state->db_host();
$self->{db_name} = $state->db_name();
$self->{db_user} = $state->db_user();
$self->{db_password} = $state->db_password();
$self->{db_port} = $state->db_port();
# $self->{data_dir} = $self->{data_directory} = $state->data_directory();
# $self->{images_dir} = $self->{images_directory} = $state->images_directory();
# $self->{binary_dir} = $self->{binary_directory} = $state->binary_directory();
# $self->{debug} = $state->debug();
# $self->{store_method} = $state->store_method();
# $self->{cascade} = $state->cascade();
$self->{state} = $state;
$self->_init_();
# соединяемся с базой если используется постоянное соединение
$self->connect();
return $self;
}
# МЕТОДЫ ДОСТУПА К СОЕДИНЕНИЯМ С БАЗОЙ УМНЫЕ
# получение соединения с базой или установка нового если его не было
sub SQL {
my $self = shift;
return ($self->connect_check() ? $self->{SQL} : undef);
}
# -------------------------------------------------------------------------------------------------
# Открываем соединение с базой данных
# -------------------------------------------------------------------------------------------------
sub connect {
my $self = shift;
#соединение уже есть
if ($self->is_connected) {
} else {
unless ($self->{SQL} = $self->db_connect) {
warn "Не могу соединиться с базой данных";
die;
}
$self->{SQL}->do("SET NAMES '".$self->state->db_client_encoding."'") if ($self->state->db_client_encoding);
}
$self->{_connect_ok} = 1;
return 1;
}
#проверка соединения с базой кеширующая состояние соединения
sub connect_check {
my $self = shift;
return 1 if ($self->{_connect_ok});
if ($self->is_connected) {
$self->{_connect_ok} = 1;
return 1;
} else {
if ($self->connect) {
return 1;
} else {
#сюда по логике попадать не должно так как die вылететь должен
warn "Connect failed\n";
return 0;
}
}
}
sub db_connect {
my $self = shift;
my $dbh = DBI->connect("DBI:mysql:database=".$self->{db_name}.";host=".$self->{db_host}, $self->{db_user}, $self->{db_password})
|| die "Contenido Error: Не могу соединиться с MySQL базой данных\n";
$dbh->{'AutoCommit'} = 1;
$dbh->{mysql_auto_reconnect} = 1;
return $dbh;
}
sub is_connected {
my $self = shift;
if (ref($self->{SQL}) and $self->{SQL}->can('ping') and $self->{SQL}->ping()) {
$self->{_connect_ok} = 1;
return 1;
} else {
$self->{_connect_ok} = 0;
return 0;
}
# warn 'Check if MySQL DB connected: '.(ref $self && exists $self->{SQL} && ref $self->{SQL} ? 1 : 0 ) if $DEBUG;
# return ( ref($self) && exists $self->{SQL} && ref $self->{SQL} );
}
# -------------------------------------------------------------------------------------------------
# Закрываем соединение с базой данных
# -------------------------------------------------------------------------------------------------
sub shutdown
{
my $self = shift;
$self->{SQL}->disconnect() if ref $self->{SQL};
delete $self->{SQL};
warn "SQL= ".(exists $self->{SQL} && ref $self->{SQL} ? 1 : 0) if $DEBUG;
warn "Contenido Debug: Закрыто соединение с базой данных MySQL на порту ".$self->{db_port}." keepalive=".$mstate->db_keepalive." .\n" if ($self->{debug});
}
# ----------------------------------------------------------------------------
# Инициализация.
# - Создает внутри объекта хэш с типами полей - это нужно для быстрой
# работы метода AUTOLOAD...
# ----------------------------------------------------------------------------
sub _init_
{
my $self = shift;
foreach my $attribute ( qw(
db_host db_name db_user db_password db_port
db_type db_keepalive
default_status
debug
state
SQL) )
{
$self->{attributes}->{ $attribute } = 'SCALAR';
}
}
# ----------------------------------------------------------------------------
# Функции работы с данными:
#
# >> get_object
# table => название таблицы
# fields => [fieldname, fieldname, ..., fieldname]
# wheres => список ограничений
# wheres => 'condition'
# wheres => ['condition 1', 'condition 2']
# wheres => { field1 => 'value1', field2 => 'value2' }
# values => список значений для wheres с передачей списка
# limit => Limit
# offset => Offset
# order_by=> Сортировка
# id => По ID
# count => Just count
#
# ----------------------------------------------------------------------------
sub get_object {
my $self = shift;
my %opts = @_;
return undef unless $opts{table};
my $ret_value = [];
my $request = "SELECT ";
if ( exists $opts{count} && $opts{count} ) {
$request .= 'COUNT(*) AS cid ';
} else {
$request .= ( exists $opts{fields} && ref $opts{fields} eq 'ARRAY' ? join(', ',@{$opts{fields}}) : '*' );
}
my (@wheres, @values);
$request .= " FROM $opts{table}";
if ( exists $opts{id} && $opts{id} ) {
if (ref $opts{id} eq 'ARRAY') {
@wheres = ( "id IN (".join(',', map { '?' } @{$opts{id}} ).")" );
@values = @{ $opts{id} };
} else {
@wheres = ( "id = ?" );
@values = ( $opts{id} );
}
}
if ( exists $opts{wheres} && $opts{wheres} ) {
if ( ref $opts{wheres} eq 'ARRAY' ) {
push @wheres, @{ $opts{wheres} };
if ( exists $opts{values} && $opts{values} ) {
if ( exists $opts{values} && ref $opts{values} eq 'ARRAY' && @{ $opts{values} } ) {
push @values, @{ $opts{values} };
} elsif ( !ref $opts{values} ) {
push @values, $opts{values};
}
}
} elsif ( ref $opts{wheres} eq 'HASH' ) {
while ( my ($field, $value) = each %{ $opts{wheres} } ) {
push @wheres, "$field = ?";
push @values, $value;
}
} else {
push @wheres, $opts{wheres};
if ( exists $opts{values} && $opts{values} ) {
if ( exists $opts{values} && ref $opts{values} eq 'ARRAY' && @{ $opts{values} } ) {
push @values, @{ $opts{values} };
} elsif ( !ref $opts{values} ) {
push @values, $opts{values};
}
}
}
}
if ( @wheres ) {
$request .= ' WHERE '.join( ' and ', map { "($_)" } @wheres );
}
if ( $opts{order_by} ) {
$request .= " ORDER BY $opts{order_by}";
}
if ( $opts{limit} ) {
$request .= " LIMIT $opts{limit}";
}
if ( $opts{offset} ) {
$request .= " OFFSET $opts{offset}";
}
warn $request if $DEBUG;
warn "Values: [".join(',', map { defined $_ ? $_ : 'NULL' } @values )."]\n" if $DEBUG && @values;
my $dbh = $self->SQL;
my $result = $dbh->prepare($request);
my $res = $result->execute( @values );
unless ( $res ) {
warn $dbh->errstr;
warn "QUERY: [$request]\n";
warn "OPTS: [".Dumper(\%opts)."]\n";
return undef;
}
if ( $opts{count} ) {
my $ln = $result->fetchrow_hashref();
return $ln->{cid};
}
while ( my $ln = $result->fetchrow_hashref() ) {
push @$ret_value, $ln;
}
if ( $opts{id} && ref $opts{id} ne 'ARRAY' && ref $ret_value eq 'ARRAY' && scalar @$ret_value) {
$ret_value = $ret_value->[0];
} elsif ( $opts{id} && ref $opts{id} eq 'ARRAY' && ref $ret_value eq 'ARRAY' && scalar @$ret_value) {
} elsif ( $opts{id} ) {
return undef;
} elsif ( ref $ret_value ne 'ARRAY' ) {
return undef;
}
$result->finish;
return $ret_value;
}
# ---------------------------------------------------------------------------
# Получить следующий ID в объекте
# >> get_next_id
# table => название таблицы
#
# ----------------------------------------------------------------------------
sub get_next_id {
my $self = shift;
my $tablename = shift;
return unless $tablename;
my $request = "SELECT MAX(id)+1 FROM $tablename";
my $dbh = $self->SQL;
my $result = $dbh->prepare($request);
$result->execute();
my $ln = $result->fetchrow();
$result->finish;
return $ln;
}
# ---------------------------------------------------------------------------
# Сохранить Объект:
# store_object( 'tablename', key => 'value', key => 'value' )
# object => {
# key => 'value',
# }
# ----------------------------------------------------------------------------
sub store_object {
my $self = shift;
my $tablename = shift;
return unless $tablename;
my %object = @_;
my $request;
my @values;
my $id = 0;
if ( exists $object{id} && $object{id} ) {
$id = $object{id};
$request = "UPDATE $tablename SET " ;
my $i = 0;
foreach my $field ( keys %object ) {
next if $field eq 'id';
$request .= ',' if $i++;
$request .= " $field = ?";
push @values, $object{$field};
}
$request .= ' WHERE id='.$object{id};
} else {
$id = $self->get_next_id($tablename);
$request = "INSERT INTO $tablename " ;
my @keys = grep { $_ ne 'id' } keys %object;
@values = map { $object{$_} } @keys;
unshift @keys, 'id';
unshift @values, $id;
$request .= " (".join(', ', @keys).") ";
$request .= " VALUES (".join(', ', map { '?' } @keys).")";
}
warn $request."\n" if $DEBUG;
warn "Values: [".join(',',@values)."]\n" if $DEBUG;
my $dbh = $self->SQL;
my $result = $dbh->prepare($request);
my $res = $result->execute(@values);
unless ( $res ) {
warn "OBJECT STORE ERROR: [".$result->errstr."]\n";
}
$result->finish;
return $res ? $id : undef;
}
# ---------------------------------------------------------------------------
# Сохранить Объект с автоинкрементом:
#
# store_object_autoinc( 'tablename', key => 'value', key => 'value' )
# object => {
# key => 'value',
# }
#
# ----------------------------------------------------------------------------
sub store_object_autoinc {
my $self = shift;
my $tablename = shift;
return unless $tablename;
my (%object) = @_;
my $request;
my @values;
my $id = 0;
if ( exists $object{id} && $object{id} ) {
$id = $object{id};
$request = "UPDATE $tablename SET " ;
my $i = 0;
foreach my $field ( keys %object ) {
next if $field eq 'id';
$request .= ',' if $i++;
$request .= " $field = ?";
push @values, $object{$field};
}
$request .= ' WHERE id='.$object{id};
} else {
$request = "INSERT INTO $tablename " ;
my @keys = grep { $_ ne 'id' } keys %object;
@values = map { $object{$_} } @keys;
$request .= " (".join(', ', @keys).") ";
$request .= " VALUES (".join(', ', map { '?' } @keys).")";
}
warn $request."\n" if $DEBUG;
warn "Values: [".join(',', map { !defined $_ ? 'NULL' : $_ } @values)."]\n" if $DEBUG;
my $dbh = $self->SQL;
my $result = $dbh->prepare($request);
my $res = $result->execute(@values);
unless ( $res ) {
warn "OBJECT STORE ERROR: [".$result->errstr."]\n";
}
unless ( $id ) {
$id = $dbh->last_insert_id(undef, undef, undef, undef);
warn "INSERT TRACK. ID = [$id]\n";
}
$result->finish;
return $res ? $id : undef;
}
# ---------------------------------------------------------------------------
# Удалить Объект:
#
# ----------------------------------------------------------------------------
sub delete_object {
my $self = shift;
my $tablename = shift;
return unless $tablename;
my %opts = @_;
my $request;
if ( exists $opts{id} && $opts{id} ) {
$request = "DELETE FROM $tablename WHERE id = ?";
}
warn $request if $DEBUG;
my $dbh = $self->SQL;
my $result = $dbh->prepare($request);
$result->execute($opts{id});
$result->finish;
}
1;
Небольшая справка по веткам
cnddist – контейнер, в котором хранятся все дистрибутивы всех библиотек и программных пакетов, которые использовались при построении различных версий Contenido. Если какой-то библиотеки в данном хранилище нет, инсталлятор сделает попытку "подтянуть" ее с веба (например, с CPAN). Если библиотека слишком старая, есть очень большая вероятность, что ее там уже нет. Поэтому мы храним весь хлам от всех сборок. Если какой-то дистрибутив вдруг отсутствует в cnddist - напишите нам, мы положим его туда.
koi8 – отмирающая ветка, чей код, выдача и все внутренние библиотеки заточены на кодировку KOI8-R. Вносятся только те дополнения, которые касаются внешнего вида и функционала админки, баги ядра, обязательные обновления портов и мелочи, которые легко скопипастить. В дальнейшем планируется полная остановка поддержки по данной ветке.
utf8 – актуальная ветка, заточенная под UTF-8.
Внутри каждой ветки: core – исходники ядра; install – скрипт установки инсталляции; plugins – плагины; samples – "готовые к употреблению" проекты, которые можно поставить, запустить и посмотреть, как они работают.
