Revision 458 (by ahitrov, 2014/12/03 16:56:21) Upgrade to Cache::Memcached::Fast
package Contenido::Keeper;

# ----------------------------------------------------------------------------
# ����� ���� ������
# ----------------------------------------------------------------------------
use strict;
use warnings;
use locale;

use vars qw($VERSION $AUTOLOAD);
$VERSION = '5.0';

use base qw(Contenido::DB::PostgreSQL);

use Data::Dumper;
use Time::HiRes;

use Contenido::Globals;
use Contenido::Msg;

# TODO
# ������ �� 2-4 ������ ���������� �������....!  

use constant DATA_SOURCE_LOCAL      => 10;
use constant DATA_SOURCE_MEMCACHED  => 20;
use constant DATA_SOURCE_DATABASE   => 30;

# # ------------------------------------------------------------------------------------------------
# ����������� ������� ���� ������.
#  ������������ �������� - ������ ������ Contenido::State �� ��������
#  ����������� ������� ����������� ��������� ��� ������� � �� � �.�.
#
# ������ ������:
#  Contenido::Keeper->new($state)
# ------------------------------------------------------------------------------------------------
sub new {
    my ($proto, $local_state) = @_;

    unless ( ref $local_state ) {
        $log->error("������������ ����� ������������ ������� ���� ������. � ���������� ��� ������� ������ Contenido::State");
        die;
    }

    my $class = ref($proto) || $proto;
    my $self = {};
    bless($self, $class);


    # �������� ����������� �������� ����������� �������...
    $self->{db_host} = $local_state->db_host();
    $self->{db_name} = $local_state->db_name();
    $self->{db_user} = $local_state->db_user();
    $self->{db_password} = $local_state->db_password();
    $self->{db_port} = $local_state->db_port();
    # AUTOLOAD method, can �� ��������
    $self->{db_client_encoding} = $local_state->{attributes}{db_client_encoding} ? $local_state->db_client_encoding() : '';
    $self->{db_enable_utf8}	= $local_state->{attributes}{db_enable_utf8} ? $local_state->db_enable_utf8() : 0;

    $self->{data_dir} = $self->{data_directory} = $local_state->data_directory();
    $self->{images_dir} = $self->{images_directory} = $local_state->images_directory();
    $self->{binary_dir} = $self->{binary_directory} = $local_state->binary_directory();
    $self->{preview} = $local_state->preview();
    $self->{convert_binary} = $local_state->can('convert_binary') ? $local_state->convert_binary : undef;
    
    $self->{debug} = $local_state->debug();
    $self->{store_method} = $local_state->store_method();
    $self->{cascade} = $local_state->cascade();

    $self->{default_status} = [
        [0, '�������'],
        [1, '��������'],
        [2, '�������'],
        [3, '��������'],
    ];

    $self->{state} = $local_state;
    $self->_init_();

    # ����������� � ����� ���� ������������ ���������� ����������
    $self->db_connect() if $local_state->db_type ne 'none' && $local_state->db_keepalive();
    # ����������� � memcached
    $self->MEMD()       if $local_state->memcached_enable();

    return $self;
}

# ----------------------------------------------------------------------------
# �������������.
#  - ������� ������ ������� ��� � ������ ����� - ��� ����� ��� �������
#   ������ ������ AUTOLOAD...
# ----------------------------------------------------------------------------
sub _init_ {
    my $self = shift;

    foreach my $attribute ( qw(
            db_host db_name db_user db_password db_port

            data_directory data_dir
            images_directory images_dir
            binary_directory binary_dir

            store_method cascade

            default_status

            debug
            state
            )    )
    {
        $self->{attributes}->{ $attribute } = 'SCALAR';
    }
}

sub get_items {
    my ($self, $proto, %opts) = @_;

    $log->info("get_items($proto) called with opts: ".Data::Dumper::Dumper(\%opts)) if $DEBUG;

    #��������� ��� �����
    $opts{all_childs} = $self->_all_childs($opts{s}) if ($opts{dive} and $opts{s});

    # -------------------------------------------------------------------------------------------
    # ���������� ����� ������������ ������ (array|array_ref|hash|hash_ref|count)
    # default array for compatibility reasons
    # hash/hash_ref �������� �� ��������� �� ���� id...
    # hash_by �������� ����� ���������� ������������ ���� ������� ��� ���������� ����
    # return_mode => 'count' ������������ count=>1
    # return_mode ����� ����� ������� ��������� ��� count

    if ($opts{count} and $opts{return_mode} and ($opts{return_mode} ne 'count')) {
        $log->warning("get_items($proto) have count=>1 and return_mode=>$opts{return_mode} set... using $opts{return_mode} mode"); delete $opts{count};
    } elsif ($opts{count}) {
        $opts{return_mode} = 'count';
    } elsif (defined($opts{return_mode}) and $opts{return_mode} eq 'count') {
        $opts{count} = 1;
    }

    # ���������� ����������� �������� return_mode ���� �� �������� ���������
    my $mode = $opts{return_mode} || 'array';
    # ----------------------------------------------------------------------------------------

        #-----------------------------------------------------------------------------------------
        # ������� ��������� ���������� ���� ������� in_id_sort
        # � ����������� sort_list ���� �� �� �����
        #-----------------------------------------------------------------------------------------
        if ($opts{in_id_sort} && $opts{in_id}) {
        $opts{sort_list} = $opts{in_id};
    }

    #-----------------------------------------------------------------------------------------
    # ���� ���� sort_list � return_mode �� array ��� array_ref �������� � ���������� sort_list
    #-----------------------------------------------------------------------------------------
    if ($opts{sort_list} and ($mode ne 'array') and ($mode ne 'array_ref')) {
        delete $opts{sort_list};
        $log->warning("sort_list set with incompatible return_mode: '$mode'");
    }

    # -----------------------------------------------------------------------------------------
    # ������� ��� order_by ���� � ��� hash ��� hash_ref return_mode ��� ����� in_id_sort
    # ������ ����� ������������ ������ �� ������������ ���������� ����� ���� ����
    # ����� ������ ��������� ���� ����� ������� � opts
    # todo �������� ����� warns ���� ��� ���� order ��� order_by � ���������� ����
    # ----------------------------------------------------------------------------------------
    if ( (($mode eq 'hash' or $mode eq 'hash_ref') && !(exists $opts{limit} || exists $opts{offset})) or ($mode eq 'count') or $opts{sort_list}) {
        $opts{no_order} = 1;
        if ($opts{order} or $opts{order_by}) {
            my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef;
            my $mason_file = ref($mason_comp) ? $mason_comp->path : undef;
            $log->warning("�������� ���������� ��������������� ��� ��� ������ ������������� �����. ".($mason_file ? "called from $mason_file" : ''));
            delete $opts{order};
            delete $opts{order_by};
        }
    }

    # ----------------------------------------------------------------------------------------
    # ��������� ������
    # ToDo: �������� �������� ����������� ���������� ��������
    #-----------------------------------------------------------------------------------------
    my ($query, $binds) = $proto->_get_sql(%opts);
    return unless ($query);


    my $start = Time::HiRes::time() if ($DEBUG);
    # ---------------------------------------------------------------------------------------
    # �������������� ������ � �������� ���������� prepared ������� (�� ����������� DBI �� ���� prepare_cached)
    # ������������� �������� �� pgsql 8.0+ � ����� ������� DBD (� ��������!)
    # ----------------------------------------------------------------------------------------
    my $sth;
    if ($opts{no_prepare_cached}) {
        unless ($sth = $self->SQL->prepare($$query)) {
           $self->error;
           $log->error("DBI prepare error on $$query\ncalled with opts: ".Data::Dumper::Dumper(\%opts));
           return;
        }
    } else {
        unless ($sth = $self->SQL->prepare_cached($$query, {}, 1)) {
           $self->error;
           $log->error("DBI prepare error on $$query\ncalled with opts: ".Data::Dumper::Dumper(\%opts));
           return;
        }
    }

    # ----------------------------------------------------------------------------------------
    # ���������
    # ----------------------------------------------------------------------------------------
    unless ($sth->execute(@$binds)) {
       $self->error;
       $log->error("DBI execute error on $$query\n".Data::Dumper::Dumper($binds)."\ncalled with opts:\n".Data::Dumper::Dumper(\%opts));
       return;
    }
    my $finish1 = Time::HiRes::time() if ($DEBUG);

    #-----------------------------------------------------------------------------------------
    # �������������� ���������� � ������ �������
    #-----------------------------------------------------------------------------------------
    my ($res, $total);
    ($res, $total) = $self->_prepare_array_results($sth, \%opts) if ($mode eq 'array' or $mode eq 'array_ref');
    ($res, $total) = $self->_prepare_hash_results($sth,  \%opts) if ($mode eq 'hash'  or $mode eq 'hash_ref');
    ($res, $total) = $self->_prepare_count_results($sth, \%opts) if ($mode eq 'count');
    $sth->finish();
    my $finish2 = Time::HiRes::time() if ($DEBUG);

    if ($DEBUG) {
        my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef;
        my $mason_file = ref($mason_comp) ? $mason_comp->path : undef;
        my $db_time    = int(10000*($finish1-$start))/10;
        my $core_time  = int(10000*($finish2-$finish1))/10;
        my $total_time = int(10000*($finish2-$start))/10;

        $Contenido::Globals::DB_TIME   += $finish1-$start;
        $Contenido::Globals::CORE_TIME += $finish2-$finish1;
        $Contenido::Globals::DB_COUNT++;

        $log->info("get_items($proto) ".($mason_file ? "called from $mason_file" : '')." SQL: '$$query' with binds: '".join("', '", @$binds)."' fetched: $total records (total work time: $total_time ms, database time $db_time ms, core time $core_time ms)");
    }

    #������ �������������� ���� ��������� ����� 500 �������� �� �� ��������� no_limit
    if ($total>999 and !($opts{no_limit} or $opts{limit})) {
        my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef;
        my $mason_file = ref($mason_comp) ? $mason_comp->path : undef;
        $log->error("get_items($proto) ".($mason_file ? "called from $mason_file" : '')." SQL: '$$query' with binds: '".join("', '", @$binds)."' fetched 1000 records... �������������� ����� ������� �� �������� �� ����... ��� �������� no_limit=>1 ��� ����������� ������ ��� ����� ������ ���������");
    } elsif ($total>500 and !($opts{no_limit} or $opts{limit})) {
        my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef;
        my $mason_file = ref($mason_comp) ? $mason_comp->path : undef;
        $log->warning("get_items($proto) ".($mason_file ? "called from $mason_file" : '')." SQL: '$$query' with binds: '".join("', '", @$binds)."' fetched over 500 ($total) records... ��� �������� no_limit=>1 ��� ����������� ������ ��� ����� ������ ���������");
    }

    # -----------------------------------------------------------------------------------------
    # ���������� ������ ���������� � ����������� �� ���� ����� return_mode ������
    # -----------------------------------------------------------------------------------------
    if ($mode eq 'array') {
        return @$res;
    } elsif ($mode eq 'array_ref') {
        return $res;
    } elsif ($mode eq 'hash') {
        return %$res;
    } elsif ($mode eq 'hash_ref') {
        return $res;
    } elsif ($mode eq 'count') {
        return $res;
    } else {
        $log->error("get_items($proto) unsupported return_mode called with opts: ".Data::Dumper::Dumper(\%opts));
        return;
    }
}

#internal only method
sub _prepare_count_results {
    my ($self, $sth, $opts) = @_;
    my ($count) = $sth->fetchrow_array();
    return ($count, 1);
}

#internal only method
sub _prepare_hash_results {
    my ($self, $sth, $opts) = @_;

    #To Do ����� warnings ��� ������������� ������ ������������� � hash ��������... ��� ��: in_id_sort 
    #To Do �������� hash mode ��� $opts{names} � ��� $opts{ids}

    # ���������� ������������� �������� hash_by
    my $hash_by = $opts->{hash_by} || 'id';
        # ���������� ������������� �������� hash_index
        my $hash_index = $opts->{hash_index} || 0;

    my %items;
    my $total = 0;

    if ($opts->{names}) {
        while (my $row = $sth->fetch) {
            $items{$row->[0]} = $row->[1];
        }
    } elsif ($opts->{ids} || $opts->{field}) {
        if (ref($opts->{field})) {
                        #hashing by first field by default
                        while (my $row = $sth->fetch) {
                                $items{$row->[$hash_index]} = [@$row]; 
                        }
        } else {
            while (my $row = $sth->fetch) {
                $items{$row->[0]} = 1;
            }
        }
    } else {
        my $item;
        while (my $row = $sth->fetch) {
            eval { $item=$row->[0]->init_from_db($row, $self, $opts->{light}); };
            if ($@) {
                $log->error("�annot init item from database for $row->[0] because '$@'");
            } else {
                $item->post_init($opts);
                $self->set_object_to_cache($item, 30, $opts) if ($opts->{with_cache});
                $total++;
		if ( exists $item->{$hash_by} && defined $item->{$hash_by} ) {
	                $items{$item->{$hash_by}} = $item;
		} else {
                        $log->warning( "Can not HASH BY parameter [$hash_by]. It doesn't exists in row or the field is empty");
		}
            }
        }
    }
    return (\%items, $total);
}

#internal only method
sub _prepare_array_results {
    my ($self, $sth, $opts) = @_;

    my @items;

    if ($opts->{names} || (ref($opts->{field}) eq 'ARRAY')) {
        @items = @{$sth->fetchall_arrayref()};
    } elsif ($opts->{ids} || $opts->{field}) {
        while (my $row = $sth->fetch) {
            push @items, $row->[0];
        }
    } else {
        my $item;
        while (my $row = $sth->fetch) {
            eval { $item=$row->[0]->init_from_db($row, $self, $opts->{light}); };
            if ($@) {
                $log->error("Cannot init item from database for $row->[0] because '$@'");
            } else {
                $item->post_init($opts);
                $self->set_object_to_cache($item, 30, $opts) if ($opts->{with_cache});
                push @items, $item;
            }
        }
    }

    return (\@items, scalar(@items));
}

#������ �� ����� ���� ����� �����
sub get_objects {
    return shift->get_items('Contenido::Object', @_);
}

# ------------------------------------------------------------------------------------------------
# ��������� ����������, ���������� ��� ������� ������:
#   @documents = $keeper->get_documents( %search_options )
#
# ��������� ������:
#   s - ����� ������ (���� ����� �������� dive, �� s ����� ��������� ������ ���� ����� ������, � ��������� ������ s
#   ����� ��������� ������ �� ������ ������� ������);
#   sfilter - ������-������. � �������� ������� ���������� ������ ���������, ���������� � sfilter (���� �� ������).
#   ����� ���� ����� ������ ������ (� ������� ������ �� ������);
#   dive - ���� ���������� � ������, �� ����� ����� ������������� �� ��� �� �����;
#   intersect - ���� "����������� ������". ���� ����������, �� ����� �������� ���������, ����������� �� ����
#   ������������� � s �������, ���� �� ���������� - � ����� �� ������������� ������.
#   include_parent - ���� ���� �������� �����, �� ����� ����� ����������� � �� ����� ������. �� ��������� - �����;
#   date_equal - ������ ������������ ���� (YYYY-MM-DD);
#   date - ������ �� ������ � ����� ������ (������� � ������ ���������);
#   previous_days - ������ �� ... ��������� ����;
#   datetime    - custom dtime filters ���������� �������� 'future','past','today' 
#
#   use_mtime   - ������������ �� ���� �������� �� ������� mtime ������ dtime (!)
#   use_ctime   - ������������ �� ���� �������� �� ������� ctime ������ dtime (!)
#
#   status - �������� ������������� ������� (��� ������ �� ������ �� ���������);
#   class - �������� ����� ������� (--"--);
#   order - ������� �������:
#   ['date','direct'] - �� ���� � ������ �������;
#   ['date','reverse'] - �� ���� � �������� �������;
#   ['name','direct'/'reverse'] - �� ����� � ������ ��� �������� �������;
#   [] - ��� ����������
#
#   in_id [id,id,id,...] - ������� �� ��������������� (�� ����� ����� - ������ �� ������ ���������������)
#   name - ����� �� ��������;
#   excludes - ������ �� ������ ���� ���������������, ������� ���� ��������� �� ������
#   class_excludes - ������ �� ������ �������, ����������� ��� �������
#   count - ���� ����� � �������, �� ������ ����� - ���������� ���������
#   ids - ���� ����� � �������, �� ������ ������ �������������� ��������...
#   names - ���� ����� � �������, �� ������ ����� ��� [�������������, ���]
#   offset - ����������� ������ ������ ��� ������� ����������...
#
#   like - ������� � ������� like (������ ���� ������ name)
#   ilike - ������� � ������� ilike (������ ���� ������ name)
#
#   light - ���� ���������� � 1, �� ������ ������� ��� ���������� restore()
#   limit - ����������� �� ���������� ������������ ���������
#
#   ��� ���������, ������� ��������� ��� ���������� join-��������. ������������� ������������ ��
#   ��� ������� ���������� ��������� � �����-�� ���������� ���������� �����-�� ���������� ������:
#   lclass - ����� �����
#   ldest - ������������� dest_id
#   lsource - ������������� source_id
#   lstatus - ������ � ������� ������
#   id - ������� 1 ��������� �� id
# ------------------------------------------------------------------------------------------------
sub get_documents {
    return shift->get_items('Contenido::Document', @_);
}



# ------------------------------------------------------------------------------------------------
# ��������� ������, ���������� ��� ������� ������:
#   @links = $keeper->get_links( %search_options )
#
# ��������� ������:
#   status - �������� ������������� ������� (��� ������ �� ������ ���������������);
#   class - �������� ����� ������� (--"--);
#
#   dest_id - ������������� (��� ������ �� ������ ���������������)
#   source_id - ������������� (��� ������ �� ������ ���������������)
#
#   excludes - ������ �� ������ ���� ���������������, ������� ���� ��������� �� ������
#   class_excludes - ������ �� ������ �������, ����������� ��� �������
#
#   count - ���� ����� � �������, �� ������ ����� - ���������� ���������
#   ids - ���� ����� � �������, �� ������ ������ �������������� ������...
#
#   offset - ����������� ������ ������ ��� ������� ����������...
#
#   light - ���� ���������� � 1, �� ������ ������� ��� ���������� restore()
#   limit - ����������� �� ���������� ������������ ���������
# ------------------------------------------------------------------------------------------------
sub get_links {
    return shift->get_items('Contenido::Link', @_);
}



# ------------------------------------------------------------------------------------------------
# ��������� ������, ���������� ��� ������� ������:
#   @sections = $keeper->get_sections( %search_options )
#
# ��������� ������:
#   s - ����� ������������;
#
#   status - �������� ������������� ������� (��� ������ �� ������);
#   class - �������� ����� ������ (--"--);
#   order - ������� �������:
#   ['name','direct'/'reverse'] - �� ����� � ������ ��� �������� �������;
#   [] - ��� ����������
#   name - ����� �� ��������;
#
#   in_id [id,id,id,...] - ������� �� ��������������� (�� ����� �����)
#   ids - ���� ����� � �������, �� ������ ������ �������������� ������...
#   names - ���� ����� � �������, �� ������ ����� ��� [�������������, ���]
#
#   light - ���� ���������� � 1, �� ������ ������� ��� ���������� restore()
#   limit - ����������� �� ������ �������
# ------------------------------------------------------------------------------------------------
sub get_sections {
    return shift->get_items('Contenido::Section', @_);
}

# ----------------------------------------------------------------------------
# ����� ��� ��������� ������ ������������� �������
#   @users = $keeper->_get_users( %search_options )
#
# ��������� ������:
#   s - ����� ������ (s ����� ��������� ������ �� ������ ������� ������);
#   intersect - ���� "����������� ������". ���� ����������, �� ����� �������� ���������, ����������� �� ����
#   ������������� � s �������, ���� �� ���������� - � ����� �� ������������� ������.
#   class - �������� ����� ������� (--"--);
# ----------------------------------------------------------------------------
sub _get_users {
    return shift->get_items('Contenido::User', @_);
}
# XXX �� ������������ - ����� ������� � ��������� �������. ������������ _get_users()
sub get_users {
    return shift->_get_users(@_);
}


# -------------------------------------------------------------------------------------------------
# ��������� �������...
# ���������:
#   light => ����������� ������
#   root => ������ ������ (�� ��������� - 1)
# -------------------------------------------------------------------------------------------------
sub get_tree {
	my $self = shift;
    return Contenido::Section->new($self)->get_tree(@_);
}

sub get_section_tree {
    my $self = shift;
    my ( %opts ) = @_;

    delete $opts{return_mode}		if exists $opts{return_mode};
    delete $opts{order_by}		if exists $opts{order_by};
    delete $opts{no_limit}		if exists $opts{no_limit};
    my $root_id = delete $opts{root_id};
    $opts{light} = exists $opts{light} ? $opts{light} : 1;
    my $sections = $self->get_sections (
		%opts,
		return_mode	=> 'array_ref',
		order_by	=> 'sorder',
		no_limit	=> 1,
	);
    my %section_hash = map { $_->id => $_ } @$sections	if ref $sections eq 'ARRAY';
    my %tree;
    if ( ref $sections eq 'ARRAY' ) {
	foreach my $sect ( @$sections ) {
		if ( !$sect->pid || $sect->id == 1 ) {
			$tree{0} = $sect;
		} else {
			if ( exists $tree{$sect->pid} ) {
				if ( exists $tree{$sect->pid}{children} ) {
					push @{ $tree{$sect->pid}{children} }, $sect;
				} else {
					$tree{$sect->pid}{children} = [$sect];
				}
			} elsif ( exists $section_hash{$sect->pid} ) {
				$tree{$sect->pid} = $section_hash{$sect->pid};
				$tree{$sect->pid}{children} = [$sect];
			}
			if ( $root_id && $sect->id == $root_id ) {
				$tree{root} = $sect;
			}
		}
	}
	if ( (!$root_id || !exists $tree{root}) && exists $tree{0} ) {
		$tree{root} = $tree{0};
	}
    }
    return \%tree;
}

# -------------------------------------------------------------------------------------------------
# �������� ������ �� ��������������. � ����� ������ ����� ���� �����? �! ������ ��� ��
#  ��� �� ����� ����� ������.
#
# ���� ����� �������� ��� ����, ��� �� ��������� (������, ��������, �����)
# -------------------------------------------------------------------------------------------------
sub __get_by_id__ {
    my ($self, $proto, %opts) = @_;
    return unless ($opts{id});
    #�� ������ ������ ������������� ������� ������ 1 �������� �� ����
    $opts{limit} = 1;
    #��������� ���������� ��� �������������
    $opts{no_order} = 1;
    my ($item)=$self->get_items($proto, %opts);
    return $item;
}

sub get_document_by_id {
    my ($self, $id, %opts) = @_;
    return unless $id;
    $opts{id} = $id;
    return $self->__get_by_id__('Contenido::Document', %opts);
}

sub get_section_by_id {
    my ($self, $id, %opts) = @_;
    return unless $id;
    $opts{id} = $id;
    return $self->__get_by_id__('Contenido::Section', %opts);
}

sub get_link_by_id {
    my ($self, $id, %opts) = @_;
    return unless $id;
    $opts{id}=$id;
    return $self->__get_by_id__('Contenido::Link', %opts);
}

sub get_user_by_id {
    my ($self, $id, %opts) = @_;
    return unless $id;
    $opts{id}=$id;
    return $self->__get_by_id__('Contenido::User', %opts);
}


# -------------------------------------------------------------------
# ����� �����. ������� ���� ������ � $request->{_cache_},
# ����� � memcached (���� �������� ���������, �������), � ������ ����� ��� �ģ� � ����.
# ���������� �� ���� ������ ���������� � $request � � memcached.
# $level ��� � ���� ������ ������ �� ��� ��� ������� (10 ������� ��������� ���, 20 ������� memcached, 30 ����)
sub get_object_by_id {
    my ($self, $id, %opts) = @_;

    my ($object, $level) = $self->get_object_from_cache($id, \%opts) unless ($opts{expire});

    #�� ����� � ����� ���� � ����
    unless ($object) {
        $object = $self->__get_by_id__($opts{proto}||'Contenido::Document', %opts, id=>$id);
        $level = DATA_SOURCE_DATABASE;
    }
    
    #�� �� ������ � ��������... aka ��� ������ �� ����� ����� �������
    unless ($object) {
        return;
    }

    #���� � 10 ������ ������� �� ������ ����� ���������� �������� ��� ������
    $self->set_object_to_cache($object, $level, \%opts, $state->{memcached_set_mode})
        if $level > DATA_SOURCE_LOCAL;

    return $object;
}

# -------------------------------------------------------------------
# ���� ����� �����. �������� � �������� id �������� ����������� ������,
# � ��������� ������������� ��� - ���������, ��������, login � ��������
# users. ������ ������� �������� ������������ ����������� ��������������
# ����� ������� � ��� id, �������� �� ���������� � ���� ������ ��� ���
# ��������� ������ ����� �������.
# -------------------------------------------------------------------
sub get_object_by_unique_key {
    my ($self, $unique, %opts) = @_;

    return undef unless defined $unique;

    my ($id, $level) = (undef, DATA_SOURCE_DATABASE);
    my %key_list = ();

    my $class = $opts{class};
    return undef unless defined $class;

    my $key = $class->get_object_unique_key($unique);
    return undef unless $key;

    my $object = undef;

    unless ($opts{expire}) {
        if (exists $request->{_cache_}->{$key}) {
            ($id, $level) = $request->{_cache_}->{$key};
            $level = DATA_SOURCE_LOCAL;
        } elsif (($self->{state}->{memcached_enable}) &&
                 (defined ($id = $self->MEMD->get($key)))) {
            $level = DATA_SOURCE_MEMCACHED;
        }

        # ������������ � ���� �������, ���� ������ �� id
        if (defined $id) {
            $object = $self->get_object_by_id($id, %opts);
            # ���� �����-�� ������� ���������� �������� ������ � ����� ������������
            unless (defined $object) {
                $self->MEMD->delete($key);
            }
        }
    }

    # ������������ �� ������� ��� ������� ��������.
    unless (defined $object) {
        my $attr = $class->class_table->unique_attr;
        ($object) =
            $self->get_items(
                $class,
                'limit' => 1,
                'no_order' => 1,
                $attr => $unique,
                'class' => $class
            );
    }

    # ������ � ����� ���������� ������ �� ������.
    return undef unless defined $object;

    $self->set_object_unique_key_to_cache($object, $level, \%opts)
        if $level > DATA_SOURCE_LOCAL;

    return $object;
}

sub set_object_unique_key_to_cache {
    my ($self, $object, $level, $opts) = @_;

    my $key = $object->get_object_unique_key;

    if (defined $key) {
        if ($level > DATA_SOURCE_LOCAL) {
            $request->{_cache_}->{$key} = $object->id;
        }
        if (($level > DATA_SOURCE_MEMCACHED) and ($self->state->{memcached_enable})) {
            my $expire =
                exists $opts->{'expire_in'}
                    ? $opts->{'expire_in'}
                    : $object->memcached_expire;
            if ($self->state->{memcached_delayed}) {
                $request->{_to_memcache}{$key} = [$object->id, $expire, 'set'];
            } else {
                $self->MEMD->set($key, $object->id, $expire);
            }
        }
    }

    return $object;
}

#������� ������ �� ���� �� ��� id
sub get_object_from_cache {
    my ($self, $id, $opts) = @_;

    my $object;
    my %key_list = ();

    #���������� �� ������ ������ �������� (���� ��� ����������� ����� �����������)
    my @classes;
    if (ref($opts->{class}) eq 'ARRAY') {
            foreach my $class (@{$opts->{class}}) {
                    $key_list{$class->get_object_key($id, $opts)} = $class;
            }
    } elsif ($opts->{class}) {
        $key_list{$opts->{class}->get_object_key($id, $opts)} = $opts->{class};
    } elsif ($opts->{table}) {
        $key_list{$opts->{table}->_get_object_key(undef, $id, $opts)} = $opts->{table};
    } else {
        my $class = $opts->{proto} || 'Contenido::Document';
        $key_list{$class->get_object_key($id, $opts)} = $class;
    }

    while (my ($object_key, $class) = each(%key_list)) {
        if (defined($request->{_cache_}->{$object_key})) {
            return ($request->{_cache_}->{$object_key}, DATA_SOURCE_LOCAL);
        } elsif ($self->MEMD) {
            if ($object = $self->MEMD->get($object_key)) {
                $object->recover_from_cache($self, $opts) if $object->can('recover_from_cache');
                return ($object, DATA_SOURCE_MEMCACHED);
            } else {
                return;
            }
        }
    }
    return;
}

#����� ���������� ����� ������ �������������� ����� set_to_cache (�� ����������� ����������� Contenido::Object)
#$level ��� � ���� ������ ������ �� ��� ��� ������� (10 ������� ��������� ���, 20 ������� memcached, 30 ����)
#$mode => set|add (default set)
sub set_object_to_cache {
    my ($self, $object, $level, $opts, $mode) = @_;

    #���������� ���� �� �������
    my $object_key = $object->can('get_object_key') ? $object->get_object_key($opts) : ref($object).'|'.$object->id();

    if ($level > DATA_SOURCE_LOCAL) {
        $request->{_cache_}->{$object_key} = $object;
    }
    if ($level > DATA_SOURCE_MEMCACHED and $self->state->{memcached_enable}) {
        my $value = $object->can('prepare_for_cache') ? $object->prepare_for_cache($opts) : $object;
        my $expire = exists $opts->{'expire_in'} ? $opts->{'expire_in'} : $object->memcached_expire;
        if ($self->state->{memcached_delayed}) {
            $request->{_to_memcache}{$object_key} = [$value, $expire, $mode];
        } else {
            if ($mode && $mode eq 'add') {
                $self->MEMD->add($object_key, $value, $expire);
            } else {
                $self->MEMD->set($object_key, $value, $expire);
            }
        }
    }
    return $object;
}

sub get_user_by_login {
    my ($self, $login, %opts) = @_;
    return unless $login;
    $opts{login}=$login;
    my ($item)=$self->get_items('Contenido::User', %opts);
    return $item;
}

############################## DIFFERENT TRASH CODE #######################################################################
# ----------------------------------------------------------------------------
# ���������� ������. ����� ������ �������, ������ � ��� �� �����
#  ������� ��� ��������� ���� ������ � ��� �����...
# ���� �� ��� ������ ��� � ��� ������
# ----------------------------------------------------------------------------
sub error {
    my $self = shift;

    $self->{last_error} = shift || $self->SQL->errstr();
    chomp($self->{last_error});

    my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef;
    my $mason_file = ref($mason_comp) ? $mason_comp->path : undef;

    $log->error(($mason_file ? "Called from $mason_file" : '')."$self->{last_error}");
}


sub minimize_image {
    my $self = shift;
    my $IMAGE = shift;
    my $PREVIEW = shift;

    my $SLINE = $self->{convert_binary};
    my $PREVIEWLINE = " -geometry '".($PREVIEW || $self->{preview})."' -quality 80";
    my $SFILE = $IMAGE->{filename};
    my $DFILE = $SFILE;
    $DFILE =~ s/\.([^\.]*)$/\.mini\.$1/;
    $SLINE = $SLINE.' '.$PREVIEWLINE.' '.$self->{state}->{images_directory}.'/'.$SFILE.' '.$self->{state}->{images_directory}.'/'.$DFILE;

    my $RESULT = `$SLINE`;
    if (length($RESULT) > 0)
    {
        $log->error("��� ������ '$SLINE' ��������� ������ '$RESULT' ($@)");
        return undef;
    }
    
    $IMAGE->{mini}->{filename} = $DFILE;
    ($IMAGE->{mini}->{width}, $IMAGE->{mini}->{height}) = Image::Size::imgsize($self->{state}->{images_directory}.'/'.$DFILE);

    return $IMAGE;
}

sub get_sorted_documents {
    my ($self, %opts) = @_;
    unless ($opts{s}) {
        my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef;
        my $mason_file = ref($mason_comp) ? $mason_comp->path : undef;
        $log->warning("Method $keeper->get_sorted_documents(...) called without required param s=>".($mason_file ? "called from $mason_file":"")."\ncalled with opts:\n".Data::Dumper::Dumper(\%opts));
        return;
    }
    my $section = $self->get_section_by_id($opts{s});
    if ($section->{_sorted}) {
        $opts{sort_list} = [split(',', $section->_sorted_order())];
    } else {
        $log->warning("Method $keeper->get_sorted_documents(...) called with s=>$opts{s} but section have _sorted disabled\n");
    }
    return $self->get_documents(%opts);
}

sub _all_childs {
    my ($self, $s)=@_;
    return [] unless $s;
    # �������� ���� ������� �� ������ ������ � ������...
    my $tree = $self->get_section_tree( root_id => $s );
    return []	unless ref $tree && exists $tree->{root} && ref $tree->{root} && $tree->{root}->id == $s;
    my @all_childs;
    my $root = $tree->{root};
    my @stack = exists $root->{children} ? @{$root->{children}} : ();
    while ( @stack ) {
	my $sect = shift @stack;
	push @all_childs, $sect->id;
	if ( exists $sect->{children} ) {
		push @stack, @{$sect->{children}};
	}
    }
    return \@all_childs;
}

# -------------------------------------------------------------------
# �������������� $keeper->{MEMD}
#--------------------------------------------------------------------
sub MEMD {
    my $self = shift;

    return undef unless $self->{state}->{memcached_enable};

    unless ( $self->{MEMD} && ref $self->{MEMD} &&  ref $self->{MEMD}->server_versions eq 'HASH' && keys %{$self->{MEMD}->server_versions} ) {
        my $implementation = $self->state()->memcached_backend();
        $self->{MEMD} = $implementation->new({
            servers => $self->state()->memcached_servers(),
            compress_threshold => 10_000,
            namespace => $self->state()->memcached_namespace,
            enable_compress => $self->state()->memcached_enable_compress(),
            connect_timeout => 0.1,
            io_timeout => $self->state()->memcached_select_timeout(),
            check_args => 'skip'
        });
        $self->{MEMD}->enable_compress( $self->state()->memcached_enable_compress() );
    }
    return $self->{MEMD};
}

# ----------------------------------------------------------------------------
# ��� ����� AUTOLOAD. ����� ������� ��� ���������/������ �����...
# ������ 0.2
# ----------------------------------------------------------------------------
sub AUTOLOAD {
    my $self = shift;
    my $attribute = $AUTOLOAD;

    $attribute =~ s/.*:://;
    return undef    unless  $attribute =~ /[^A-Z]/;     # ��������� ������ ���� DESTROY

    unless (ref $self) { 
        $log->error("������ ����� ����������� ������� $AUTOLOAD()");
        return undef;
    } elsif (! exists($self->{attributes}->{$attribute})) {
        $log->error("����� ������, ��� �������� �� ���������� ��������������� ��������: ->$attribute()");
        return undef;
    }

    $self->{ $attribute } = shift @_  if scalar @_ > 0;
    return $self->{ $attribute };
}


1;