Revision 526 (by ahitrov, 2015/11/25 16:12:34) multimedia_multi - multifile field type

package Contenido::Object;

# ----------------------------------------------------------------------------
# ����� ������.
# ������������ ����� ��� ���� �����. ��� �� �� ���������� ���, �� �������
#  ������������� ��� ������������.
#
# �� ���� �� ����� ����������� ��������� ������ � ����������� ������, 
#  ��������� ������ � ��������� ������� � ��� �����...
# ----------------------------------------------------------------------------

use strict;
use warnings;
use locale;

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

use Utils;
use Contenido::Globals;
use Contenido::File;
use Data::Dumper;

use DBD::Pg;
use Encode;

use SQL::ProtoTable;

# required properties ������ ������� �� ������� �������
sub required_properties {
    my $self=shift;
    my $class = ref($self) || $self;
    if ($class->can('class_table')) {
        return $self->class_table->required_properties();
    } else {
        $log->error("$class cannot method class_table");
        return ();
    }
}

sub extra_properties {
    return ();
}

sub post_init {
    return;
}

sub pre_store {
    return 1;
}

sub post_store {
    return 1;
}

sub post_finish_store {
    return 1;
}

sub pre_delete {
    return 1;
}

sub post_delete {
    return 1;
}

sub pre_abort {
    return 1;
}

sub t_abort {
    my $self = shift;
    $self->pre_abort();
    return $self->keeper->t_abort();
}

sub new {
    $log->error("Method 'new' cannot be called for class Contenido::Object");
    die;
}

sub class_table {
    $log->error("Method 'class_table' cannot be called for Contenido::Object");
    die;
}              

#��������� ������ DESTROY ����� ��� ������ � AUTOLOAD �� ��������
sub DESTROY {}

#��������� ����� � ���� �� $object ��� �� $class/$id
#can be overloaded in class
sub get_object_key {
    my $self = shift;
    return $self->class_table->_get_object_key($self, @_);
}

#��������� ����� � ���� �� $object ��� �� $class/$unique
#can be overloaded in class
sub get_object_unique_key {
    my $self = shift;
    return $self->class_table->_get_object_unique_key($self, @_);
}

#�������� ��� ���������� �� ��������... ����������� 1 ��� �� ������ �����
#??? �������� ����� ������� ������ ������� � ��������� �� ���� �����
sub class_init {
    my $self = shift;
    my $class = ref($self) || $self; 

    {
        no strict 'refs';
        return 1 if (${$class.'::class_init_done'});
        use strict;
    }

    #�������������� ��������� �������
    if ($class->can('class_table')) {
        eval { SQL::ProtoTable->table_init($class->class_table) };
        do { $log->error("Cannot initialise class $class!"); die } if ($@);
    }

    #��������� ������������ ������ (todo)
    #$self->class_validate();

    my $funct;

    #������ ������ ������� �������������� ������ �� ����
    my $funct_begin = "
    my (\$class, \$row, \$keeper, \$light) = \@_;
";

    my $funct_start_obj ='  return bless({';
    my $funct_end_obj = "}, '$class');
";
    my $funct_begin_if_light = '
    if ($light) {';
    my $funct_elsif_light = '
    } else {';
    my $funct_endif_light = '
    }';

    my $func_start_encode = '';
    my $func_end_encode = '';

    if ($state->db_encode_data) {
        $func_start_encode = 'Encode::encode("'.$state->db_encode_data.'", ';
        $func_end_encode = ', Encode::FB_HTMLCREF)';
    }
    
    my @funct_default_fields = ("class=>'$class'", "keeper=>\$keeper", "__light=>\$light");
    my @funct_exra_fields = ();

    #�� ���� ������� ���� ������� ���������� ��� ������������� ������
    my (%props, %attributes, @extra_fields, %virtual_fields, @structure);

    my $pos = 0;
    #������������������ reload: required_properties ����� ���� ���������� ����� add_properties ������� ����� ���� ����� �������� ����� extra_properties

    foreach my $prop ($self->required_properties()) {
        my $attr = $prop->{attr};
        unless ($attr) {
            $log->error("$class have wrong data in required_properties (no attr for field)");
            next;
        }
        unless ($prop->{db_type} || $prop->{virtual}) {
            $log->warning("$class with class table: ".$self->class_table()." property '$attr' missing db_type in table descriptor... can be incompatible with future versions!");
        }

        $props{$attr} = $prop;

        push @structure, $prop;

        #������ � ������� ���� ��������... ���� ���� ��� ��� ����� ������ ����� ���� �� �����... ������ ����� ���
        next if ($attr eq 'class');

        #���� ������� ���� � DB ����� ���� ��������� ������ � required_properties
        if (exists($prop->{db_field}) and $prop->{db_field}) {
            $pos++;
            #$DBD::Pg versions since 2.0.0 do it automatically
            if ($DBD::Pg::VERSION=~/^1\./ and $prop->{db_type} and (($prop->{db_type} eq 'integer[]') or ($prop->{db_type} eq 'integer_ref[]'))) { 
                push @funct_default_fields, "$attr=>[(\$row->[$pos] and \$row->[$pos]=~/^{(\\d+(?:,\\d+)*)}\$/) ? split(/,/, \$1) : ()]";
            } else {
                push @funct_default_fields, "$attr=>$func_start_encode\$row->[$pos]$func_end_encode";
            }
        }

        if ($prop->{db_type} and ($prop->{db_type} eq 'integer[]')) {
            $attributes{$attr} = 'ARRAY';
        } elsif($prop->{db_type} and ($prop->{db_type} eq 'integer_ref[]')) {
            $attributes{$attr} = 'ARRAY_REF';                                
        } else {
            $attributes{$attr} = 'SCALAR';
        }
    }
    push @funct_default_fields, "attributes=>\$${class}::attributes";

    my $have_extra = $self->class_table->have_extra;
    if ($have_extra) {
        my @ap = $self->add_properties()    if $self->can('add_properties');
        #������������������ reload: required_properties ����� ���� ���������� ����� add_properties ������� ����� ���� ����� �������� ����� extra_properties
        foreach my $prop (@ap, $self->extra_properties()) {
            my $attr = $prop->{attr};
            if (exists($props{$attr})) {
                #reload code
                $log->info("Reloaded property $attr for class $class") if ($DEBUG);
                while ( my ($field, $value) = each(%$prop)) {
                    $props{$attr}->{$field} = $value;
                }
            } else {
                $props{$attr} = $prop;
                #���� ��� ��� �� overload �� ��� ����� extra ����
                push @extra_fields, $attr; 
                push @structure, $prop;
                $attributes{$attr} = 'SCALAR';
                if ($prop->{virtual}) {
                    #���������� ��� ��� ������ ����������� �������
                    $virtual_fields{$attr} = 1;
                } else {
                    #�������������� �� dump ��� ����� ����������� �������
                    push @funct_exra_fields, "$attr=>$func_start_encode\$dump->{$attr}$func_end_encode";
                }
            }
        }
    }

    $attributes{class}  = 'SCALAR';

    #���� � ������� ���� extra_attributes ���� �� ������� restore_extras ���� �� ������ light
    #������� have_extra � ������� �� ����� � ������������� ������� extra_fields
    if (@extra_fields) {
        # --------------------------------------------------------------------------------------------
        # ������ �� ������ ����� � ���� ������
        # --------------------------------------------------------------------------------------------
        my $funct_eval_dump .= '
    my $dump = Contenido::Object::eval_dump(\\$row->[-1]);
';
        $funct = $funct_begin.$funct_begin_if_light.$funct_start_obj.join(', ', @funct_default_fields).$funct_end_obj.$funct_elsif_light.$funct_eval_dump.$funct_start_obj.join(', ', (@funct_default_fields, @funct_exra_fields)).$funct_end_obj.$funct_endif_light;
    } else {
        $funct = $funct_begin.$funct_start_obj.join(', ', @funct_default_fields).$funct_end_obj;
    }

    create_method($class, 'init_from_db', $funct);

    {
        no strict 'refs';
        ${$class.'::structure'}     = \@structure;
        ${$class.'::attributes'}    = \%attributes;
        ${$class.'::extra_fields'}  = \@extra_fields;
        ${$class.'::virtual_fields'}    = \%virtual_fields;
        ${$class.'::class_init_done'}   = 1;
    }
    return 1;
}

# -------------------------------------------------------------------------------------------
# ��������� ������� �������� ������� � ����������� �� ���������� �������...
# -------------------------------------------------------------------------------------------
sub store_extras {
    my $self = shift;
    my %opts = @_;
    do {$log->error("����� store_extras() ����� �������� ������ � ��������, �� �� �������\n"); die } unless ref($self);

    do { $log->error("� ������� �� ���������� ������ �� ���� ������"); die } unless ref($self->keeper);
    do { $log->error("�� ����� ����� ���������� ������ (insert/update)"); die } if (($opts{mode} ne 'insert') && ($opts{mode} ne 'update'));
    do { $log->error("�� ����� ������������� ������� (� ������ ���� ����� � ������������ �������)"); die }  unless($self->id());

    if ($self->keeper->store_method() eq 'sqldump') {
        my $extra_table=$self->class_table->extra_table;
        do { $log->error("No extra table for class $self->{class}"); die } unless ($extra_table);
        if ($opts{mode} eq 'insert') {
            $self->keeper->TSQL->do("INSERT INTO $extra_table (id, data) VALUES (?, ?)", {}, $self->id(), $self->_create_extra_dump()) || $self->t_abort();
        } else {
            $self->keeper->TSQL->do("UPDATE $extra_table SET data=? WHERE id=?", {}, $self->_create_extra_dump(), $self->id()) || $self->t_abort();
        }

    } elsif ($self->keeper->store_method() eq 'toast') {
        my $table = $self->class_table->db_table;
        do { $log->error("There no db_table for class $self->{class}"); die } unless ($table);
        $self->keeper->TSQL->do("UPDATE $table SET data=? WHERE id=?", {}, $self->_create_extra_dump(), $self->id()) || $self->t_abort();

    } else {
        $log->error("����� ���������� �������� ����� �������! ��������� �������� - TOAST, SQLDUMP");
        die;
    }

    return 1;
}


sub _create_extra_dump {
    my $self = shift;

    do { $log->error("����� _create_extra_dump ����� �������� ������ � ��������, �� �� �������"); die }   unless ref($self);

    my $class_table = $self->class_table; 
    return undef unless ($class_table and $class_table->have_extra);

    my $extra_fields = [];
    my $virtual_fields = {};
    {
        no strict 'refs';
        local $Data::Dumper::Indent = 0;
        #���������� virtual attributes
        #�� � ���� ��� ��� ������ ������ �� ���� ����� ��� ���������
        $extra_fields = ${$self->{class}.'::extra_fields'};
        $virtual_fields = ${$self->{class}.'::virtual_fields'};
        #���� ������������ ��� extra ���� ����� ��� ��� ��������� � virtual_fields ������
        if ($state->db_encode_data) {
            return Data::Dumper::Dumper({map { $_=> Encode::decode($state->db_encode_data, $self->{$_}, Encode::FB_HTMLCREF) } grep { !$virtual_fields->{$_} && (defined $self->{$_}) } @$extra_fields});
        } else {
            return Data::Dumper::Dumper({map { $_=>$self->{$_} } grep { !$virtual_fields->{$_} && (defined $self->{$_}) } @$extra_fields});
        }
    }
}

# -------------------------------------------------------------------------------------------
# ��������� ������� �������� ������� � ����������� �� ���������� �������...
# -------------------------------------------------------------------------------------------
sub restore_extras {
    my ($self, $row) = @_;

    do { $log->error("����� restore_extras() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);

    my $extra_fields;
    {
        no strict 'refs';
        $extra_fields = ${$self->{class}.'::extra_fields'};
    }

    if (@$extra_fields) {
        if (($Contenido::Globals::store_method eq 'toast') or ($Contenido::Globals::store_method eq 'sqldump')) {
            # --------------------------------------------------------------------------------------------
            # ������ �� ������ ����� � ���� ������
            # --------------------------------------------------------------------------------------------
            my $dump_ = eval_dump(\$row->[-1]);
            if ($dump_) {
                foreach (@$extra_fields) {
                    $self->{$_} = $dump_->{$_};
                }
            }
        } else {
            $log->error("����� ���������� �������� ����� �������! ��������� �������� - TOAST, SQLDUMP, SINGLE, DUMP");
            die;
        }
    }
}

# ----------------------------------------------------------------------------
# �������� ��� �� ����-����� �� ��������
# ������:
# my $pics_hashe = $doc->get_data('images');
# ----------------------------------------------------------------------------
sub get_data {
    my $self = shift;
    my $attr = shift;
    my $data  = eval_dump(\$self->{$attr});
    return ($data || {});
}

# ----------------------------------------------------------------------------
# �������� �������� �� ������� �� �� ��������
# ���������� ������ ���� Contenido::Image
#
# ������:
# my $pic = $doc->get_pic('top_image');
#
# ----------------------------------------------------------------------------
sub get_pic {
    my $self = shift;
    my $attr = shift;

    Contenido::Image->new (
        img => $self->get_data($attr),
        attr    => $attr,
    );
}

# ----------------------------------------------------------------------------
# �������� �������� �� ������� �� �������� �� ���������
# ���������� ������ �������� ���� Contenido::Image
#
# ������:
# my @pics = $doc->get_pics('images', {
#   order   => 'reverse',   # ������� ���������� �� ������ ('reverse' ,'asis', �� ��������� - 'direct')
#   keys    => [3..12, 1..2],   # �������� ������
#   });
#
# ----------------------------------------------------------------------------
sub get_pics {
    my $self = shift;
    my $attr = shift;
    my %args = ref $_[0] ? %{$_[0]} : @_;
    my $pics = $self->get_data($attr);

    # �������
    $args{order} ||= 'direct';

    # �������� ������� ������ ��� ��������...
    my @keys = ref $args{keys} ne 'ARRAY' ? grep {s/\D+//, /^\d+$/} keys %{$pics} : @{$args{keys}};

    my $prefix = 'image_'; # � ���� ��, ���� ���: my $prefix = $attr.'_';

    map { Contenido::Image->new (
        img => $pics->{$prefix.$_},
        attr    => $prefix.$_,
        group   => $attr,
        key => $_,
    )} sort { $args{order} eq 'asis' ? 1 : $args{order} ne 'reverse' ? $a <=> $b : $b <=> $a } @keys;
}

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

    #������ ������ ������� �� ������� ��������
    my $table  = $self->_get_table(%opts);
    unless ($table) {
        $log->error("�� ���� �������� ������� �������");
        return;
    }

    my ($query, $binds) = $table->generate_sql(%opts);
    my @binds = ();

    if ($state->db_encode_data) {
        foreach my $i (0..$#{$binds}) {
            $binds->[$i] = Encode::decode($state->db_encode_data, $binds->[$i], Encode::FB_HTMLCREF);
        }
    }

    return $query, $binds;
}

# ������ �������������:
#  $document->store()
#
# ���� $id ����� �� �� �������, ��� ���� ������ � ���� ����. ����
#  �� �����, �� �� �������, ��� ����� ������� � ���� ��� � ������� ���. 
# ----------------------------------------------------------------------------
sub store {
    my $self = shift;
    do { $log->error("����� store() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);

    do { $log->error("� ������� ��������� �� ���������� ������ �� ���� ������"); die } unless ref($self->keeper);

    return undef if ($self->keeper->state->readonly());

    $self->keeper->t_connect() || do { $self->keeper->error(); return undef; };
    $self->{status} ||= 0;                    # �������� ������� �� ��������� = 0

    unless ($self->pre_store()) {
        $log->notice("pre_store call failed!");
        return undef;
    }

    my (@fields, @values, @default_pairs, @default_fields, @default_values, @binary_fields);

    foreach ($self->required_properties()) {

        my $value = $self->{$_->{attr}};
        if ( exists $_->{db_field} && $_->{db_field} ) {
            $value = undef if (defined($value) and $value eq '') and (lc($_->{db_type}) eq 'float' or lc($_->{db_type} eq 'integer'));
            $value = undef if lc $_->{db_type} eq 'integer[]' && ref $value ne 'ARRAY';
            $value = undef if lc $_->{db_type} eq 'integer_ref[]' && ref $value ne 'ARRAY';
        }

        #���������� readonly ���� � ��������� ��� ���� id
        if ($self->id() and $_->{readonly}) {

        #��� ���� � ���� � ��������
        } elsif (!$_->{db_field}) {

        #��������� default ���� ��� ���� � ����� ���� ��� ��� �������� � ����
        } elsif (defined($_->{default}) and ($_->{auto} or !defined($value))) {
            push @default_fields, $_->{db_field};
            push @default_values, $_->{default};
            push @default_pairs, "$_->{db_field}=$_->{default}";

        #���������� auto ��� default
        } elsif ($_->{auto}) {

        #��������� �������� �����
        } elsif (defined($value)) {
            push @fields, $_->{db_field};
            if ($_->{db_type} eq 'integer[]') {
                push @values, '{'.join(',', grep { $_ } @$value).'}';
            } elsif ($_->{db_type} eq 'integer_ref[]') {
                push @values, '{'.join(',', grep { $_ } @$value).'}';     
            } else {
                #some special work for bytea column type
                push @binary_fields, scalar(@fields) if ($_->{db_type} eq 'bytea');
                if ($state->db_encode_data) {
                    push @values, Encode::decode($state->db_encode_data, $value, Encode::FB_HTMLCREF);
                } else {
                    push @values, $value;
                }
            }

        #undef to NULL or empty array
        } else {
            push @default_fields, $_->{db_field};
            push @default_values, 'NULL';
            push @default_pairs, "$_->{db_field}=NULL";
        } 
    }

    #���� ����������� toast �� ���������� �� 1 sql ������ � extra ����
    if (($self->keeper->store_method() eq 'toast') and $self->class_table->have_extra and !$self->{__light}) {
        push @fields, 'data';
        push @values, $self->_create_extra_dump();
    }


    my $values_string = '';
    my $mode = 'update';
    if ($self->id()) {
        if (@fields) {
            $values_string = join(' = ?, ', @fields).' = ?';
            $values_string .= ', '.join(', ', @default_pairs) if (@default_pairs); 
        #��� ������� �������� �������� ������ �� @default_pairs
        } else {
            $values_string = join(', ', @default_pairs) if (@default_pairs);
        }
        my $sql='UPDATE '.$self->class_table->db_table.' SET '.$values_string." WHERE ".$self->class_table()->id_field()." = ?";

        my $sth=$self->keeper->TSQL->prepare_cached($sql, {}, 1) || return $self->t_abort();
        #settin special escape for bytea column type!!!
        foreach (@binary_fields) {
            $sth->bind_param($_, undef, {pg_type => DBD::Pg::PG_BYTEA});
        }
        unless ($sth->execute(@values, $self->{id})) {
            $log->error("DBI execute error on $sql\n".Data::Dumper::Dumper(\@values));
            $sth->finish();
            return $self->t_abort();
        }
        $sth->finish();

        if (($self->keeper->store_method() ne 'toast') and $self->class_table->have_extra and !$self->{__light}) {
            $self->store_extras(mode => $mode) || return $self->t_abort();
        }

    } else {
        $mode = 'insert';
        if (@fields) {
            $values_string = '?, 'x(scalar (@fields)-1).'?';
            $values_string .= ', '.join(', ', @default_values) if (@default_values);
        #��� ������� �������� �������� ������ �� @default_pairs
        } else {
            $values_string = join(', ', @default_values) if (@default_values);
        }
        my $sql='INSERT INTO '.$self->class_table->db_table.' ('.join(', ', (@fields, @default_fields)).') VALUES ('.$values_string.')';

        my $sth=$self->keeper->TSQL->prepare_cached($sql, {}, 1) || return $self->t_abort();
        #settin special escape for bytea column type!!!
        foreach (@binary_fields) {
            $sth->bind_param($_, undef, {pg_type => DBD::Pg::PG_BYTEA});
        }
        unless ($sth->execute(@values)) {
            $log->error("DBI execute error on $sql\n".Data::Dumper::Dumper(\@values));
            $sth->finish();
            return $self->t_abort();
        }
        $sth->finish();

        my $id = $self->keeper->TSQL->selectrow_array("SELECT currval('".$self->class_table->db_id_sequence()."')");
        $self->id($id);
        return $self->t_abort("��������� �������� �������� �������������") if (! defined($self->{id}) || ($self->{id} <= 0));

        if (($self->keeper->store_method() ne 'toast') and $self->class_table->have_extra and !$self->{__light}) {
            $self->store_extras(mode => $mode) || return $self->t_abort();
        }

    }

    $self->post_store(mode => $mode);

    $self->keeper->t_finish();

    $self->post_finish_store();

    $self->drop_cache($mode) if ($self->keeper->state()->memcached_enable());

    return 1;
}

# ----------------------------------------------------------------------------
# ����� delete() ��� �������� ������� �� ���� ������.
#
# ������ �������������:
#  $document->delete()
# ----------------------------------------------------------------------------
sub delete {
    my $self = shift;
    my (%opts) = @_;
    do { $log->error("����� delete() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);

    return undef if ($self->keeper->state->readonly());

    unless ($self->pre_delete()) {
        $log->error("pre_delete call failed!");
        return undef;
    }

    my $keeper = $self->keeper;
    do { $log->error("� ������� ��������� �� ���������� ������ �� ���� ������"); die } unless ref($keeper);

    if ( exists $opts{attachments} && $opts{attachments} ) {
	my @props = $self->structure();
	if ( @props ) {
		@props = grep { $_->{type} =~ /^(image|images|multimedia_new|multimedia_multi)$/ } @props;
		foreach my $prop ( @props ) {
			my $att = $self->get_image($prop->{attr});
			if ( $prop->{type} eq 'image' ) {
				if ( ref $att && exists $att->{filename} && $att->{filename} ) {
					Contenido::File::remove( $att->{filename} );
				}
				if ( exists $att->{mini} && ref $att->{mini} eq 'HASH' ) {
					Contenido::File::remove( $att->{mini}{filename} )	if exists $att->{mini}{filename};
					foreach my $val ( values %{ $att->{mini} } ) {
						if ( ref $val && exists $val->{filename} && $val->{filename} && ($val->{filename} ne $att->{mini}{filename}) ) {
							Contenido::File::remove( $val->{filename} );
						}
					}
				}
				
			} elsif ( $prop->{type} eq 'images' ) {
				for ( 1..100 ) {
					next	unless exists $att->{"image_$_"};
					my $img = $att->{"image_$_"};
					if ( ref $img && exists $img->{filename} && $img->{filename} ) {
						Contenido::File::remove( $img->{filename} );
					}
					if ( exists $img->{mini} && ref $img->{mini} eq 'HASH' ) {
						Contenido::File::remove( $img->{mini}{filename} )	if exists $img->{mini}{filename};
						foreach my $val ( values %{ $img->{mini} } ) {
							if ( ref $val && exists $val->{filename} && $val->{filename} && ($val->{filename} ne $img->{mini}{filename}) ) {
								Contenido::File::remove( $val->{filename} );
							}
						}
					}
				}
			} elsif ( $prop->{type} eq 'multimedia_new' ) {
				if ( ref $att && exists $att->{filename} && $att->{filename} ) {
					Contenido::File::remove( $att->{filename} );
				}
			} elsif ( $prop->{type} eq 'multimedia_multi' ) {
				for ( 1..100 ) {
					next    unless exists $att->{"file_$_"};
					my $file = $att->{"file_$_"};
					if ( ref $file && exists $file->{filename} && $file->{filename} ) {
						Contenido::File::remove( $file->{filename} );
					}
				}
			}
		}
	}
    }
    do { $log->warning("����� ������ delete() ��� �������� �������������� ��� ��������"); return undef }
						unless ($self->{id});
    $keeper->t_connect() || do { $keeper->error(); return undef; };
    $keeper->TSQL->do("DELETE FROM ".$self->class_table->db_table." WHERE id = ?", {}, $self->id) || return $self->t_abort();

    # �������� ������ ����� ��������� � ������� �����������...
    my %document_links;
    if ( $keeper->state->{available_links} && ref $keeper->state->{available_links} eq 'ARRAY' ) {
	foreach my $classlink ( @{ $keeper->state->{available_links} } ) {
		my $sources = $classlink->available_sources;
		if ( ref $sources eq 'ARRAY' && @$sources ) {
			$document_links{$classlink->class_table->db_table}{source} = 1		if grep { $self->class eq $_ } @$sources;
		}
		my $dests = $classlink->available_destinations;
		if ( ref $dests eq 'ARRAY' && @$dests ) {
			$document_links{$classlink->class_table->db_table}{dest} = 1		if grep { $self->class eq $_ } @$dests;
		}
	}
	foreach my $tablename ( keys %document_links ) {
		my (@wheres, @values);
		if ( exists $document_links{$tablename}{source} ) {
			push @wheres, "(source_id = ? AND source_class = ?)";
			push @values, ( $self->id, $self->class );
		}
		if ( exists $document_links{$tablename}{dest} ) {
			push @wheres, "(dest_id = ? AND dest_class = ?)";
			push @values, ( $self->id, $self->class );
		}
		my $request = "DELETE FROM $tablename WHERE ".join (' OR ', @wheres);
		warn "DELETE LINKS. Request: [$request]\n"			if $DEBUG;
		warn "Values: [".join(', ', @values)."]\n"			if $DEBUG;
		$keeper->TSQL->do($request, {}, @values) || return $self->t_abort();
	}
    } else {
	$keeper->TSQL->do("DELETE FROM links WHERE source_id = ? AND source_class = ? ", {}, $self->id, $self->class) || return $self->t_abort();
	$keeper->TSQL->do("DELETE FROM links WHERE dest_id = ? AND dest_class = ? ", {}, $self->id, $self->class) || return $self->t_abort();
    }
    $keeper->t_finish();

    $self->post_delete();

    $self->drop_cache('delete') if ($keeper->state()->memcached_enable());

    return 1;
}

# ----------------------------------------------------------------------------
# ����� links() ���������� ������ �������� ���� Contenido::Link
#
# ������ �������������:
#  $document->links([�����])
# ----------------------------------------------------------------------------
sub links {
    my ($self, $lclass, $direction, %opts) = @_;
    do { $log->error("����� ->links() ����� �������� ������ � ��������, �� �� �������"); die }  unless ref($self);

    do { $log->error("� ������� ��������� �� ���������� ������ �� ���� ������"); die } unless ref($self->keeper);

    do { $log->warning("����� ������ ->links() ��� �������� �������������� ���������-���������"); return () } unless ($self->id() > 0);

    my $check = defined $direction ? 'dest_id' : 'source_id';

    $opts{$check} = $self->id();

    if (defined($lclass) && (length($lclass) > 0)) {
	$opts{class} = $lclass;
    }

    my @links = $self->keeper->get_links(%opts);

    $self->{links} = \@links;
    return @links;
}


sub linked_to {
    my ($self, $lclass) = @_;
    $self->links($lclass, 1);
}


# ----------------------------------------------------------------------------
# ��������� �����. ������ ���� ����������� ����� �����...
#  � �������� source_id ��������� ������������� �������, � �������� $dest_id -
#  ��������.
#
# ������ �������������:
#  $document->set_link($lclass, $dest_id)
#
# �������� �� ������������ - � ��������� ����� ���� ��������� ����������
#  ������.
# ----------------------------------------------------------------------------
sub set_link {
    my ($self, $lclass, $dest_id, $dest_class, @opts) = @_;
    do { $log->error("����� ->set_link() ������ � ������������ ���-��� ����������"); die } if @opts % 2;
    do { $log->error("����� ->set_link() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);
    my %opts = @opts;

    return undef if ($self->keeper->state->readonly());

    do { $log->warning("����� ������ ->set_link() ��� �������� �������������� ���������-���������"); return undef } unless ($self->id() > 0);
    do { $log->warning("����� ������ ->set_link() ��� �������� �������������� ���������-����"); return undef } unless ($dest_id >= 0);
    do { $log->warning("����� ������ ->set_link() ��� �������� ������ �����"); }  unless defined($lclass) && length($lclass);

    # ������� ������ �����...
    my $link = $lclass->new($self->keeper);

    $link->dest_id($dest_id);
    $link->dest_class($dest_class);

    $link->status(1);

    $link->source_id($self->id());
    $link->source_class($self->class());
    
    while (my ($k,$v) = each %opts) {
	$link->{$k} = $v;
    }

    if ($link->store())
    {
	return $link->id;
    } else {
	return undef;
    }
}

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

    do { $log->error("����� ->prepare_for_cache() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);

    my $hash = {};

    foreach ( $self->structure() ) {
	$hash->{$_->{attr}} = $self->{$_->{attr}} if defined $self->{$_->{attr}};
    }
    bless $hash, $self->class();
    return $hash;
}

# -------------------------------------------------------------------
# ��������������� ����������� ������ �� �������������� ����.
# ��� ��� ���� ������������ � ����������� ������.
# -------------------------------------------------------------------
sub recover_from_cache {
    my $self = shift;
    my $keeper = shift;

    do { $log->error("����� ->recover_from_cache() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);
    do { $log->error("� ������� ��������� �� ���������� ������ �� ���� ������"); die } unless ref($keeper);

    #�� ����� ��� bless ���������... 100% ���� �� ������ � ��������� ����� �� �� ���� ����� ����� ������
    $self->init();
    $self->keeper($keeper);

    return 1;
}

# -------------------------------------------------------------------
# ���������� ���:
#   {��������1 => [���1, ���2, ...], ��������2 => [���1, ���2, ...], ...}
# �.�. ��� ������� �������� �������� ������ ���� ������ � ����,
# ������� ���� �������.
# ��������� ������� ��������: insert, update, delete
# ��� ����� ������� ������ ������ ���� ����� ������ ���� �������������
# � ������ ������ �������
#
sub dependencies {
    my ($self, $mode) = @_;

    my @keys = ($self->get_object_key,);
    my $object_unique_key = $self->get_object_unique_key;
    push @keys, $object_unique_key if defined $object_unique_key;

    return
        ($mode eq 'delete') || ($mode eq 'insert') || ($mode eq 'update')
            ? \@keys
            : [];
}

# -------------------------------------------------------------------
# ������� �� ���� �����, �������� ��� ������ dependencies().
# ������ ������:
#   $group->drop_cache('update');
#
sub drop_cache {
    my $self = shift;
    my $mode = shift;

    do { $log->error("����� ->drop_cache() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);

    my $keeper = $self->keeper;
    do { $log->error("� ������� ��������� �� ���������� ������ �� ���� ������"); die } unless ref($keeper);
    
    my $dependencies = $self->dependencies($mode, @_);

    my @not_deleted = ();
    if ( defined($dependencies) && (ref($dependencies) eq 'ARRAY') ) {
        for (@$dependencies) {
            my $res = $self->keeper->MEMD ? $self->keeper->MEMD->delete($_) : undef;
            push @not_deleted, $_ unless $res;
            $keeper->MEMD->delete($_) if ($keeper->MEMD);
        }
    }
    return @not_deleted;
}


sub keeper {
    my $self = shift;
    my $project_keeper = shift;

    do { $log->error("����� keeper() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);

    if ($project_keeper && ref $project_keeper) {
        $self->{keeper} = $project_keeper;
        return $project_keeper;
    }
    return $self->{keeper} && ref $self->{keeper} ? $self->{keeper} : $keeper;
}

#������ ������� ��� init_from_db ����� ������������������� ����� ���� ����
sub init_from_db {
    my $self = shift;

    my $class = ref($self) || $self;

    #������ �� ����������� �������� ���� class_init �� �����������
    if (defined($_[-1]) and ($_[-1] eq 'RECURSIVE CALL FLAG!')) {
        do { $log->error("$class cannot be initialized (->class_init dont work) (recursive call) !!!"); die };
    }

    #���� ���� ����� �� �������� ������� ��� ��� �� ������������������ �� ����������� �������������������
    #������ ������������� ������ init_from_db ��������� �� ref �� �����
    if ($class and $class->isa('Contenido::Object')) {
        no strict 'refs';
        if (${$class.'::class_init_done'}) {
            do { $log->error("$class already initialized but DONT HAVE init_from_db method!!!"); die };
        } else {
            if ($self->class_init()) {
                return $self->init_from_db(@_, 'RECURSIVE CALL FLAG!');
            } else {
                do { $log->error("$class cannot be initialized (->class_init dont work) !!!"); die };
            }
        }
    } else {
        do { $log->error("$class cannot be initialized (not Contenido::Object child class) !!!"); die };
    }
}

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

    $log->info("$self calling AUTOLOAD method: $attribute") if ($DEBUG_CORE);

    $attribute=~s/^.*:://;

    my $class = ref($self);
    unless ($class and $class->isa('Contenido::Object')) {

        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 ($package, $filename, $line) = caller;

        $log->warning("Wrong AUTOLOAD call with self='$self'/class='$class' and method '$attribute' called from '$package/$filename/$line' ".($mason_file ? "called from $mason_file" : '')."\n".Data::Dumper::Dumper($self));
        if (wantarray)  { return (); } else { return undef; }
    }

    #�������� ���� ���� �� �� ����� �������� ������������� ������ ���� �� �� ����� �� ������ ���� ������ ��� ��������������������� ������
    {
        no strict 'refs';
        unless (${$class.'::class_init_done'}) {
            my ($package, $filename, $line) = caller;
            $log->error("AUTOLOAD called method '$attribute' for not initialised class ($class) from '$package/$filename/$line'");
            if (wantarray)  { return (); } else { return undef; }
        }
    }

    if (! exists($self->{attributes}->{$attribute})) {

        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 ($package, $filename, $line) = caller;

        $log->error(ref($self)."): ����� ������, ��� �������� �� ���������� ��������������� ��������: ->$attribute() called from $package/$filename/$line ".($mason_file ? "called from $mason_file" : '')."\n".Data::Dumper::Dumper($self));
        if (wantarray)  { return (); } else { return undef; }
    #special work with ARRAY types
    } elsif ($self->{attributes}->{$attribute} eq 'ARRAY') {
        my $funct = "
        use Contenido::Globals;
        my \$self = shift;
        unless (ref(\$self->{$attribute}) eq 'ARRAY') {
            my (\$package, \$filename, \$line) = caller;
            \$log->error(\"Wrong structure in field $attribute called from \$package/\$filename/\$line \\n\".Data::Dumper::Dumper(\$self)) if (\$self->{$attribute});;
            \$self->{$attribute} = [];
        }
        \$self->{$attribute} = [\@_] if (\@_);
        return \@{\$self->{$attribute}};";

        if (create_method($class, $attribute, $funct)) {
            return $self->$attribute(@_);
        } else {
            $log->error("Cannot create method $attribute for class $self->{class}");
            #fallback to old autoload method if create method fail
            unless (ref($self->{$attribute}) eq 'ARRAY') {
                my ($package, $filename, $line) = caller;
                $log->error("Wrong structure in field $attribute called from $package/$filename/$line \n".Data::Dumper::Dumper($self));
                $self->{$attribute} = [];
            }
            $self->{$attribute} = [@_] if (@_);
            return @{$self->{$attribute}};
        }
    #todo: �������� ������ � images ���������� ����� ��� ����� ������
    } else {
        #todo: ��������� ������� �����
        my $funct = "
    my \$self = shift;
    \$self->{$attribute} = shift if (\@_);
    return \$self->{$attribute};";

        if (create_method($class, $attribute, $funct)) {
            return $self->$attribute(@_);
        } else {
            $log->error("Cannot create method $attribute for class $self->{class}");
            #fallback to old autoload method if create method fail
            $self->{$attribute} = shift if (@_);
            return $self->{$attribute};
        }
    }
}

sub eval_dump {
    no strict 'vars';
	return {} unless ${$_[0]};
    return eval ${$_[0]};
}

sub create_method {
    my ($class, $sub_name, $code) = @_;

    unless ($class and $sub_name and $code) {
        $log->error("Wrong call create_method $class/$sub_name/$code");
        return 0;
    }

    my $string = "package $class;\n\nsub $sub_name {\n$code\n}\n\n1;";
    eval $string;

    if ($@) {
        $log->error("Cannot create method $sub_name for class $class because $@ (method code:\n$string\n)");
        return 0;
    } else {
        $log->info("Method '$sub_name' for class '$class' (method code:\n$string\n) created ok") if ($DEBUG_CORE);
        return 1;
    }
}

######################################## ONLY FOR INTERNAL USE!!!! #################################################
#todo �������� �������� ��� ���� ������� ������ �� ��������� ��� � ��� 1 table � �� 5 ������
sub _get_table {
    my ($self, %opts) = @_;

    my $class_table;

    my $table=$opts{table};
    my $class=$opts{class} || ref $self || $self;

    #������ ������� � %opts
    if ($table and $table->can('new')) {
        $class_table=$table;
    #����� ������� �� ������
    } elsif ($class and !ref($class)) {
        unless ($class->can('class_table')) {
            $log->error("$class cannot class_table");
            return undef;
        }
        $class_table=$class->class_table();
    #����� ������� �� ������� ������ � ������
    } elsif ($class and ref($class) eq 'ARRAY' and @$class) {
        unless ($class->[0]->can('class_table')) {
            $log->error("$class->[0] cannot class_table");
            return undef;
        }
        $class_table=$class->[0]->class_table();
    #����� �������������
    } else {
        $class_table='SQL::DocumentTable';
    }

    if ($class_table->can('new')) {
        return $class_table->new();
    } else {
        $log->error("$class_table cannot new!!!!");
        return undef;
    }
}

#######################################################################################################################
########## OLD CODE FOR COMPATIBILITY #################################################################################
#######################################################################################################################
sub structure {
    my $self = shift;
    my $class = ref($self);
    {
        no strict 'refs';
        return @${$class.'::structure'};
    }
}


# ��������� ��� �������� �������������...
sub get_image {
    my $self = shift;
    $self->get_data(shift);
}

sub raw_restore {
    my $self = shift;
    do { $log->error("����� restore() ����� �������� ������ � ��������, �� �� �������"); die } unless ref $self;
    do { $log->warning("����� ������ Contenido\:\:Object\:\:raw_restore() ��� �������� �������������� ��� ������"); return undef } unless $self->id;
    $self->restore_extras();
}

sub init {
     my $self = shift;
     my $class = ref($self) || $self;
     $self->class_init();
     {
          no strict 'refs';
          $self->{attributes} = ${$class.'::attributes'};
     }
     return 1;
}

sub get_file_name {
    my $self = shift;

    do { $log->error("����� get_file_name ����� �������� ������ � ��������, �� �� �������"); die } unless ref $self;

    my @date;
    my $time = time;

    if ($self->{"dtime"} and $self->{"dtime"} =~ /^(\d{4})-(\d{2})-(\d{2})/) {
        @date = ($1, $2, $3);
    } else {
        @date = (localtime $time)[5, 4, 3]; $date[0] += 1900; $date[1] += 1;
    }

    my $component_class = lc((reverse split "::", ref $self)[0]);
    my $component_date = sprintf "%04d/%02d/%02d", @date;
    my $component_time_rand = sprintf "%010d_%05d", $time, int rand 99999;

    return join "/", $component_class, $component_date, $component_time_rand;
}

sub get {
    my ( $self, %opts ) =  @_;
    my $class = ref $self || $self;
    my $local_keeper = (ref($self) and ref($self->keeper)) ? $self->keeper : $keeper;
    delete $opts{class};
    return $keeper->get_documents( class => $class, %opts );
}

sub contenido_is_available {
    return 1;
}

sub contenido_status_style {
    return;
}

sub memcached_expire {
    return $_[0]->keeper->state->memcached_object_expire;
}

# ----------------------------------------------------------------------------
# ����� _store_image() ��������� �������, ����������� � ���� image ��� images 
#
# ������ �������������:
#  $document->_store_image( INPUT, attr => 'fieldname' )
#  $document->_store_image( INPUT, prop => $prophash )
# ----------------------------------------------------------------------------
sub _store_image {
    my $self = shift;
    do { $log->error("����� delete() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);

    my $input = shift;
    my (%opts) = @_;

    return Contenido::File::store_image( $input, object => $self, %opts );
}

# ----------------------------------------------------------------------------
# ����� _delete_image() ������� �����, ��������� � ����� image ��� images.
# �������� ��� ����-�����
#
# ������ �������������:
#  $document->_store_image( $image_attr_structure )
# ----------------------------------------------------------------------------
sub _delete_image {
    my $self = shift;
    my $IMAGE = shift;

    return Contenido::File::remove_image( $IMAGE );
}

# ----------------------------------------------------------------------------
# ����� _store_binary() ��������� ������������ �������� ����, ����������� � ���� multimedia_multi ��� multimedia_new 
#
# ������ �������������:
#  $document->_store_binary( INPUT, attr => 'fieldname' )
# ----------------------------------------------------------------------------
sub _store_binary {
    my $self = shift;
    do { $log->error("����� delete() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);

    my $input = shift;
    my (%opts) = @_;

    return Contenido::File::store_binary( $input, object => $self, attr => $opts{attr} );
}

# ----------------------------------------------------------------------------
# ����� _delete_binary() ������� �����, ��������� � ����� multimedia ��� multimedia_new.
# �� �������� ������ ����-�����
#
# ������ �������������:
#  $document->_delete_binary( $binary_attr_structure )
# ----------------------------------------------------------------------------
sub _delete_binary {
    my $self = shift;
    my $BINARY = shift;

    return Contenido::File::remove_binary( $BINARY );
}

1;