Revision 280

Date:
2013/02/18 17:36:00
Author:
ahitrov
Revision Log:
Plugin import
Files:

Legend:

 
Added
 
Removed
 
Modified

  • utf8/plugins/MySQL/comps/contenido/MySQL/autohandler

     
    1 <%init>
    2
    3 $r->content_type('text/html');
    4 $m->call_next();
    5
    6 </%init>

  • utf8/plugins/MySQL/comps/contenido/MySQL/dhandler

     
    1 <& $call, %ARGS &>
    2 <%init>
    3
    4 my $call;
    5 if ( $r->uri eq '/contenido/MySQL/' ) {
    6 $call = 'index.html';
    7 } else {
    8 &abort404;
    9 }
    10
    11 </%init>

  • utf8/plugins/MySQL/comps/contenido/MySQL/index.html

     
    1 <& "/contenido/components/header.msn" &>
    2 <& "/contenido/components/naviline.msn" &>
    3
    4 <p>PLugin [MySQL]</p>
    5
    6 </body>
    7 </html>

  • utf8/plugins/MySQL/config.proto

     
    1 #############################################################################
    2 #
    3 # Параметры данного шаблона необходимо ВРУЧНУЮ добавить в config.mk проекта
    4 # и привести в соответствие с требованиями проекта
    5 #
    6 #############################################################################
    7
    8 PLUGINS += MySQL
    9 PROJECT_REQUIRED +=
    10
    11 MYSQL_DB_HOST =
    12 MYSQL_DB_NAME =
    13 MYSQL_DB_USER =
    14 MYSQL_DB_PASSWORD =
    15 MYSQL_DB_PORT =
    16
    17 REWRITE += MYSQL_DB_HOST MYSQL_DB_NAME MYSQL_DB_USER MYSQL_DB_PASSWORD MYSQL_DB_PORT

  • utf8/plugins/MySQL/lib/MySQL/Apache.pm

     
    1 package MySQL::Apache;
    2
    3 use strict;
    4 use warnings 'all';
    5
    6 use MySQL::State;
    7 use Contenido::Globals;
    8
    9
    10 sub child_init {
    11 # встраиваем keeper плагина в keeper проекта
    12 $keeper->{mysql} = MySQL::Keeper->new($state->{mysql});
    13 }
    14
    15 sub request_init {
    16 }
    17
    18 sub child_exit {
    19 }
    20
    21 1;

  • utf8/plugins/MySQL/lib/MySQL/Globals.pm

     
    1 package MySQL::Globals;
    2
    3 use strict;
    4 use warnings 'all';
    5 use vars qw($VERSION @ISA @EXPORT $mysql $mstate);
    6
    7 use Exporter;
    8 @ISA = qw(Exporter);
    9 @EXPORT = qw ( $mysql $mstate );
    10
    11 $VERSION = '1.0';
    12
    13 $mysql = undef;
    14 $mstate = undef;
    15
    16 1;

  • utf8/plugins/MySQL/lib/MySQL/Init.pm

     
    1 package MySQL::Init;
    2
    3 use strict;
    4 use warnings 'all';
    5 use vars qw($VERSION @ISA @EXPORT);
    6
    7 use Exporter;
    8 @ISA = qw(Exporter);
    9 @EXPORT = qw ( $mysql $mstate );
    10
    11 use Contenido::Globals;
    12 use MySQL::Globals;
    13 use MySQL::Apache;
    14 use MySQL::Keeper;
    15
    16 # загрузка всех необходимых плагину классов
    17 # MySQL::SQL::SomeTable
    18 # MySQL::SomeClass
    19 Contenido::Init::load_classes(qw(
    20 ));
    21
    22 sub init {
    23 warn "Contenido Init: Инициализация MySQL ($$)\n" if ($DEBUG);
    24
    25 $mstate = MySQL::State->new();
    26 $mysql = MySQL::Keeper->new($mstate);
    27
    28 0;
    29 }
    30
    31 1;

  • utf8/plugins/MySQL/lib/MySQL/Keeper.pm

     
    1 package MySQL::Keeper;
    2
    3 use strict;
    4 use warnings 'all';
    5 use base qw(Contenido::Keeper);
    6 use locale;
    7
    8 use Data::Dumper;
    9 use DBI;
    10 use DBD::mysql;
    11 use IO::File;
    12 use File::Copy;
    13 use Image::Size;
    14
    15 use Contenido::Globals;
    16 use MySQL::Globals;
    17
    18 # ------------------------------------------------------------------------------------------------
    19 # Конструктор объекта базы данных.
    20 # Обязательный параметр - объект класса Contenido::State из которого
    21 # конструктор возьмет необходимые параметры для доступа к БД и т.д.
    22 #
    23 # Формат вызова:
    24 # MySQL::Keeper->new($state)
    25 # ------------------------------------------------------------------------------------------------
    26 sub new
    27 {
    28 my ($proto, $state) = @_;
    29 die "Contenido Die: Неправильный вызов конструктора объекта базы данных. В параметрах нет объекта класса MySQL::State\n" unless ref($mstate);
    30
    31 my $class = ref($proto) || $proto;
    32 my $self = {};
    33 bless($self, $class);
    34
    35 # Заполним собственные свойства конкретными данными...
    36 $self->{db_type} = 'remote';
    37 $self->{db_keepalive} = 1;
    38
    39 $self->{db_host} = $state->db_host();
    40 $self->{db_name} = $state->db_name();
    41 $self->{db_user} = $state->db_user();
    42 $self->{db_password} = $state->db_password();
    43 $self->{db_port} = $state->db_port();
    44
    45 # $self->{data_dir} = $self->{data_directory} = $state->data_directory();
    46 # $self->{images_dir} = $self->{images_directory} = $state->images_directory();
    47 # $self->{binary_dir} = $self->{binary_directory} = $state->binary_directory();
    48
    49 # $self->{debug} = $state->debug();
    50 # $self->{store_method} = $state->store_method();
    51 # $self->{cascade} = $state->cascade();
    52
    53 $self->{state} = $state;
    54 $self->_init_();
    55
    56 # соединяемся с базой если используется постоянное соединение
    57 $self->connect();
    58
    59 return $self;
    60 }
    61
    62 # МЕТОДЫ ДОСТУПА К СОЕДИНЕНИЯМ С БАЗОЙ УМНЫЕ
    63 # получение соединения с базой или установка нового если его не было
    64 sub SQL {
    65 my $self = shift;
    66 return ($self->connect_check() ? $self->{SQL} : undef);
    67 }
    68
    69
    70 # -------------------------------------------------------------------------------------------------
    71 # Открываем соединение с базой данных
    72 # -------------------------------------------------------------------------------------------------
    73 sub connect {
    74 my $self = shift;
    75 #соединение уже есть
    76 if ($self->is_connected) {
    77 } else {
    78 unless ($self->{SQL} = $self->db_connect) {
    79 warn "Не могу соединиться с базой данных";
    80 die;
    81 }
    82 $self->{SQL}->do("SET NAMES '".$self->state->db_client_encoding."'") if ($self->state->db_client_encoding);
    83 }
    84
    85 $self->{_connect_ok} = 1;
    86 return 1;
    87 }
    88
    89
    90 #проверка соединения с базой кеширующая состояние соединения
    91 sub connect_check {
    92 my $self = shift;
    93 return 1 if ($self->{_connect_ok});
    94 if ($self->is_connected) {
    95 $self->{_connect_ok} = 1;
    96 return 1;
    97 } else {
    98 if ($self->connect) {
    99 return 1;
    100 } else {
    101 #сюда по логике попадать не должно так как die вылететь должен
    102 warn "Connect failed\n";
    103 return 0;
    104 }
    105 }
    106 }
    107
    108
    109 sub db_connect {
    110 my $self = shift;
    111 my $dbh = DBI->connect("DBI:mysql:database=".$self->{db_name}.";host=".$self->{db_host}, $self->{db_user}, $self->{db_password})
    112 || die "Contenido Error: Не могу соединиться с MySQL базой данных\n";
    113
    114 $dbh->{'AutoCommit'} = 1;
    115 $dbh->{mysql_auto_reconnect} = 1;
    116
    117 return $dbh;
    118 }
    119
    120 sub is_connected {
    121 my $self = shift;
    122 if (ref($self->{SQL}) and $self->{SQL}->can('ping') and $self->{SQL}->ping()) {
    123 $self->{_connect_ok} = 1;
    124 return 1;
    125 } else {
    126 $self->{_connect_ok} = 0;
    127 return 0;
    128 }
    129
    130 # warn 'Check if MySQL DB connected: '.(ref $self && exists $self->{SQL} && ref $self->{SQL} ? 1 : 0 ) if $DEBUG;
    131 # return ( ref($self) && exists $self->{SQL} && ref $self->{SQL} );
    132 }
    133
    134 # -------------------------------------------------------------------------------------------------
    135 # Закрываем соединение с базой данных
    136 # -------------------------------------------------------------------------------------------------
    137 sub shutdown
    138 {
    139 my $self = shift;
    140 $self->{SQL}->disconnect() if ref $self->{SQL};
    141 delete $self->{SQL};
    142
    143 warn "SQL= ".(exists $self->{SQL} && ref $self->{SQL} ? 1 : 0) if $DEBUG;
    144 warn "Contenido Debug: Закрыто соединение с базой данных MySQL на порту ".$self->{db_port}." keepalive=".$mstate->db_keepalive." .\n" if ($self->{debug});
    145 }
    146
    147
    148 # ----------------------------------------------------------------------------
    149 # Инициализация.
    150 # - Создает внутри объекта хэш с типами полей - это нужно для быстрой
    151 # работы метода AUTOLOAD...
    152 # ----------------------------------------------------------------------------
    153 sub _init_
    154 {
    155 my $self = shift;
    156
    157 foreach my $attribute ( qw(
    158 db_host db_name db_user db_password db_port
    159 db_type db_keepalive
    160 default_status
    161
    162 debug
    163 state
    164 SQL) )
    165 {
    166 $self->{attributes}->{ $attribute } = 'SCALAR';
    167 }
    168 }
    169
    170
    171 # ----------------------------------------------------------------------------
    172 # Функции работы с данными:
    173 #
    174 # >> get_object
    175 # table => название таблицы
    176 # fields => [fieldname, fieldname, ..., fieldname]
    177 # wheres => список ограничений
    178 # wheres => 'condition'
    179 # wheres => ['condition 1', 'condition 2']
    180 # wheres => { field1 => 'value1', field2 => 'value2' }
    181 # values => список значений для wheres с передачей списка
    182 # limit => Limit
    183 # offset => Offset
    184 # order_by=> Сортировка
    185 # id => По ID
    186 # count => Just count
    187 #
    188 # ----------------------------------------------------------------------------
    189 sub get_object {
    190
    191 my $self = shift;
    192 my %opts = @_;
    193
    194 return undef unless $opts{table};
    195
    196 my $ret_value = [];
    197 my $request = "SELECT ";
    198 if ( exists $opts{count} && $opts{count} ) {
    199 $request .= 'COUNT(*) AS cid ';
    200 } else {
    201 $request .= ( exists $opts{fields} && ref $opts{fields} eq 'ARRAY' ? join(', ',@{$opts{fields}}) : '*' );
    202 }
    203 my (@wheres, @values);
    204 $request .= " FROM $opts{table}";
    205 if ( exists $opts{id} && $opts{id} ) {
    206 if (ref $opts{id} eq 'ARRAY') {
    207 @wheres = ( "id IN (".join(',', map { '?' } @{$opts{id}} ).")" );
    208 @values = @{ $opts{id} };
    209 } else {
    210 @wheres = ( "id = ?" );
    211 @values = ( $opts{id} );
    212 }
    213 }
    214
    215 if ( exists $opts{wheres} && $opts{wheres} ) {
    216 if ( ref $opts{wheres} eq 'ARRAY' ) {
    217 push @wheres, @{ $opts{wheres} };
    218 if ( exists $opts{values} && $opts{values} ) {
    219 if ( exists $opts{values} && ref $opts{values} eq 'ARRAY' && @{ $opts{values} } ) {
    220 push @values, @{ $opts{values} };
    221 } elsif ( !ref $opts{values} ) {
    222 push @values, $opts{values};
    223 }
    224 }
    225 } elsif ( ref $opts{wheres} eq 'HASH' ) {
    226 while ( my ($field, $value) = each %{ $opts{wheres} } ) {
    227 push @wheres, "$field = ?";
    228 push @values, $value;
    229 }
    230 } else {
    231 push @wheres, $opts{wheres};
    232 if ( exists $opts{values} && $opts{values} ) {
    233 if ( exists $opts{values} && ref $opts{values} eq 'ARRAY' && @{ $opts{values} } ) {
    234 push @values, @{ $opts{values} };
    235 } elsif ( !ref $opts{values} ) {
    236 push @values, $opts{values};
    237 }
    238 }
    239 }
    240 }
    241 if ( @wheres ) {
    242 $request .= ' WHERE '.join( ' and ', map { "($_)" } @wheres );
    243 }
    244
    245 if ( $opts{order_by} ) {
    246 $request .= " ORDER BY $opts{order_by}";
    247 }
    248 if ( $opts{limit} ) {
    249 $request .= " LIMIT $opts{limit}";
    250 }
    251 if ( $opts{offset} ) {
    252 $request .= " OFFSET $opts{offset}";
    253 }
    254 warn $request if $DEBUG;
    255 warn "Values: [".join(',', map { defined $_ ? $_ : 'NULL' } @values )."]\n" if $DEBUG && @values;
    256 my $dbh = $self->SQL;
    257 my $result = $dbh->prepare($request);
    258 my $res = $result->execute( @values );
    259
    260 unless ( $res ) {
    261 warn $dbh->errstr;
    262 warn "QUERY: [$request]\n";
    263 warn "OPTS: [".Dumper(\%opts)."]\n";
    264 return undef;
    265 }
    266
    267 if ( $opts{count} ) {
    268 my $ln = $result->fetchrow_hashref();
    269 return $ln->{cid};
    270 }
    271 while ( my $ln = $result->fetchrow_hashref() ) {
    272 push @$ret_value, $ln;
    273 }
    274 if ( $opts{id} && ref $opts{id} ne 'ARRAY' && ref $ret_value eq 'ARRAY' && scalar @$ret_value) {
    275 $ret_value = $ret_value->[0];
    276 } elsif ( $opts{id} && ref $opts{id} eq 'ARRAY' && ref $ret_value eq 'ARRAY' && scalar @$ret_value) {
    277
    278 } elsif ( $opts{id} ) {
    279 return undef;
    280 } elsif ( ref $ret_value ne 'ARRAY' ) {
    281 return undef;
    282 }
    283 $result->finish;
    284 return $ret_value;
    285 }
    286
    287
    288 # ---------------------------------------------------------------------------
    289 # Получить следующий ID в объекте
    290 # >> get_next_id
    291 # table => название таблицы
    292 #
    293 # ----------------------------------------------------------------------------
    294 sub get_next_id {
    295
    296 my $self = shift;
    297 my $tablename = shift;
    298 return unless $tablename;
    299
    300 my $request = "SELECT MAX(id)+1 FROM $tablename";
    301 my $dbh = $self->SQL;
    302 my $result = $dbh->prepare($request);
    303 $result->execute();
    304 my $ln = $result->fetchrow();
    305 $result->finish;
    306
    307 return $ln;
    308 }
    309
    310
    311 # ---------------------------------------------------------------------------
    312 # Сохранить Объект:
    313 # store_object( 'tablename', key => 'value', key => 'value' )
    314 # object => {
    315 # key => 'value',
    316 # }
    317 # ----------------------------------------------------------------------------
    318 sub store_object {
    319
    320 my $self = shift;
    321 my $tablename = shift;
    322 return unless $tablename;
    323 my %object = @_;
    324
    325 my $request;
    326 my @values;
    327 my $id = 0;
    328 if ( exists $object{id} && $object{id} ) {
    329 $id = $object{id};
    330 $request = "UPDATE $tablename SET " ;
    331 my $i = 0;
    332 foreach my $field ( keys %object ) {
    333 next if $field eq 'id';
    334 $request .= ',' if $i++;
    335 $request .= " $field = ?";
    336 push @values, $object{$field};
    337 }
    338 $request .= ' WHERE id='.$object{id};
    339 } else {
    340 $id = $self->get_next_id($tablename);
    341 $request = "INSERT INTO $tablename " ;
    342 my @keys = grep { $_ ne 'id' } keys %object;
    343 @values = map { $object{$_} } @keys;
    344 unshift @keys, 'id';
    345 unshift @values, $id;
    346 $request .= " (".join(', ', @keys).") ";
    347 $request .= " VALUES (".join(', ', map { '?' } @keys).")";
    348 }
    349 warn $request."\n" if $DEBUG;
    350 warn "Values: [".join(',',@values)."]\n" if $DEBUG;
    351
    352 my $dbh = $self->SQL;
    353 my $result = $dbh->prepare($request);
    354 my $res = $result->execute(@values);
    355 unless ( $res ) {
    356 warn "OBJECT STORE ERROR: [".$result->errstr."]\n";
    357 }
    358 $result->finish;
    359 return $res ? $id : undef;
    360
    361 }
    362
    363
    364 # ---------------------------------------------------------------------------
    365 # Сохранить Объект с автоинкрементом:
    366 #
    367 # store_object_autoinc( 'tablename', key => 'value', key => 'value' )
    368 # object => {
    369 # key => 'value',
    370 # }
    371 #
    372 # ----------------------------------------------------------------------------
    373 sub store_object_autoinc {
    374
    375 my $self = shift;
    376 my $tablename = shift;
    377 return unless $tablename;
    378 my (%object) = @_;
    379
    380 my $request;
    381 my @values;
    382 my $id = 0;
    383 if ( exists $object{id} && $object{id} ) {
    384 $id = $object{id};
    385 $request = "UPDATE $tablename SET " ;
    386 my $i = 0;
    387 foreach my $field ( keys %object ) {
    388 next if $field eq 'id';
    389 $request .= ',' if $i++;
    390 $request .= " $field = ?";
    391 push @values, $object{$field};
    392 }
    393 $request .= ' WHERE id='.$object{id};
    394 } else {
    395 $request = "INSERT INTO $tablename " ;
    396 my @keys = grep { $_ ne 'id' } keys %object;
    397 @values = map { $object{$_} } @keys;
    398 $request .= " (".join(', ', @keys).") ";
    399 $request .= " VALUES (".join(', ', map { '?' } @keys).")";
    400 }
    401 warn $request."\n" if $DEBUG;
    402 warn "Values: [".join(',', map { !defined $_ ? 'NULL' : $_ } @values)."]\n" if $DEBUG;
    403
    404 my $dbh = $self->SQL;
    405 my $result = $dbh->prepare($request);
    406 my $res = $result->execute(@values);
    407 unless ( $res ) {
    408 warn "OBJECT STORE ERROR: [".$result->errstr."]\n";
    409 }
    410 unless ( $id ) {
    411 $id = $dbh->last_insert_id(undef, undef, undef, undef);
    412 warn "INSERT TRACK. ID = [$id]\n";
    413 }
    414 $result->finish;
    415 return $res ? $id : undef;
    416
    417 }
    418
    419
    420 # ---------------------------------------------------------------------------
    421 # Удалить Объект:
    422 #
    423 # ----------------------------------------------------------------------------
    424 sub delete_object {
    425
    426 my $self = shift;
    427 my $tablename = shift;
    428 return unless $tablename;
    429 my %opts = @_;
    430
    431 my $request;
    432 if ( exists $opts{id} && $opts{id} ) {
    433 $request = "DELETE FROM $tablename WHERE id = ?";
    434 }
    435 warn $request if $DEBUG;
    436
    437 my $dbh = $self->SQL;
    438 my $result = $dbh->prepare($request);
    439 $result->execute($opts{id});
    440 $result->finish;
    441 }
    442
    443
    444 1;

  • utf8/plugins/MySQL/lib/MySQL/State.pm.proto

     
    1 package MySQL::State;
    2
    3 use strict;
    4 use warnings 'all';
    5 use vars qw($AUTOLOAD);
    6 use Contenido::Globals;
    7 use Contenido::State;
    8 use MySQL::Globals;
    9
    10
    11 sub new {
    12 my ($proto) = @_;
    13 my $class = ref($proto) || $proto;
    14 my $self = {};
    15 bless $self, $class;
    16
    17 # configured
    18 $self->{debug} = (lc('') eq 'yes');
    19 $self->{project} = '';
    20
    21 # зашитая конфигурация плагина
    22 $self->{db_type} = 'none'; ### For REAL database use 'remote'
    23 $self->{db_keepalive} = 0;
    24 $self->{db_host} = '@MYSQL_DB_HOST@';
    25 $self->{db_name} = '@MYSQL_DB_NAME@';
    26 $self->{db_user} = '@MYSQL_DB_USER@';
    27 $self->{db_password} = '@MYSQL_DB_PASSWORD@';
    28 $self->{db_port} = '@MYSQL_DB_PORT@';
    29 $self->{db_client_encoding} = '@MYSQL_DB_ENCODING@' || 'utf8';
    30 $self->{store_method} = 'toast';
    31 $self->{cascade} = 1;
    32 $self->{db_prepare} = 0;
    33
    34 $self->{memcached_enable} = lc( '' ) eq 'yes' ? 1 : 0;
    35 $self->{memcached_enable_compress} = 1;
    36 $self->{memcached_backend} = '';
    37 $self->{memcached_servers} = [qw()];
    38 $self->{memcached_busy_lock} = 60;
    39 $self->{memcached_delayed} = lc('') eq 'yes' ? 1 : 0;
    40
    41 $self->{serialize_with} = 'json'; ### or 'dumper'
    42
    43 # not implemented really (core compatibility)
    44 $self->{binary_directory} = '/nonexistent';
    45 $self->{data_directory} = '/nonexistent';
    46 $self->{images_directory} = '/nonexistent';
    47 $self->{preview} = '0';
    48
    49 $self->_init_();
    50 $self;
    51 }
    52
    53 sub info {
    54 my $self = shift;
    55 return unless ref $self;
    56
    57 for (sort keys %{$self->{attributes}}) {
    58 my $la = length $_;
    59 warn "\t$_".("\t" x (2-int($la/8))).": $self->{$_}\n";
    60 }
    61 }
    62
    63 sub _init_ {
    64 my $self = shift;
    65
    66 # зашитая конфигурация плагина
    67 $self->{attributes}->{$_} = 'SCALAR' for qw(
    68 debug
    69 project
    70
    71 db_type
    72 db_keepalive
    73 db_host
    74 db_port
    75 db_name
    76 db_user
    77 db_password
    78 store_method
    79 cascade
    80 db_prepare
    81 db_client_encoding
    82
    83 memcached_enable
    84 memcached_enable_compress
    85 memcached_backend
    86 memcached_servers
    87 memcached_busy_lock
    88 memcached_delayed
    89
    90 binary_directory
    91 data_directory
    92 images_directory
    93 preview
    94 );
    95 }
    96
    97 sub AUTOLOAD {
    98 my $self = shift;
    99 my $attribute = $AUTOLOAD;
    100
    101 $attribute =~ s/.*:://;
    102 return unless $attribute =~ /[^A-Z]/; # Отключаем методы типа DESTROY
    103
    104 if (!exists $self->{attributes}->{$attribute}) {
    105 warn "Contenido Error (MySQL::State): Вызов метода, для которого не существует обрабатываемого свойства: ->$attribute()\n";
    106 return;
    107 }
    108
    109 $self->{$attribute} = shift @_ if $#_>=0;
    110 $self->{$attribute};
    111 }
    112
    113 1;