package KM::Object;

#
# Copyright (c) by Kirill Miazine <km@krot.org>
#
# This software is distributed under an ISC-style license, please see
# <http://km.krot.org/code/license.txt> for details.
#

use strict;
use vars qw($AUTOLOAD);
use utf8;

use Carp qw(carp croak);
use Encode qw(encode_utf8 decode_utf8);


sub _dbh      { croak 'No database handle' }

sub _pkey     { 'id' }
sub _table    { 'obj' }
sub _attrs_ro { () }
sub _attrs_rw { () }
sub _attrs    { ($_[0]->_pkey, $_[0]->_attrs_ro, $_[0]->_attrs_rw) }


sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $id = shift or croak 'Missing object id';
    croak 'Object id must not be a reference' if ref $id;

    my $self = {};
    bless $self, $class;

    return if !$self->_init($id);
    return $self;
}

sub _init {
    my $self = shift;
    my $id = shift or croak 'No object id';
    $self->{'_id'} = $id;
    $self->{'_attrs'} = { map { $_ => 1 } $self->_attrs };
    $self->{'_attrs_ro'} = { map { $_ => 1 } $self->_attrs_ro };
    $self->{'_attrs_rw'} = { map { $_ => 1 } $self->_attrs_rw };
    return $self->reload() ? 1 : 0;
}

sub id { $_[0]->{'_id'} }
sub dbh { $_[0]->_dbh }

sub reload {
    my $self = shift;
    my $res = $self->_dbh->dselect([$self->_attrs], $self->_table,
                                   $self->_pkey . '=?', $self->id);
    @{$self}{keys %{$res}} = map { decode_utf8($_) } values %{$res} if defined $res;
    return exists $self->{$self->_pkey} ? 1 : 0;
}

sub find {
    my $self = shift;
    croak 'Odd number of parameters' if @_ % 2;
    my %attr = @_;
    @attr{keys %attr} = map { encode_utf8($_) } values %attr;
    my $id = $self->_dbh->dfind($self->_pkey, $self->_table, \%attr);
    return $id ? $self->new($id) : undef;
}

sub create {
    my $self = shift;
    croak 'Odd number of parameters' if @_ % 2;
    my %attr = @_;
    my %data = map { $_ => undef } $self->_attrs;
    @data{keys %attr} = map { encode_utf8($_) } values %attr;
    $self->_dbh->dinsert($self->_table, \%data);
    my $id = $data{$self->_pkey} || $self->_dbh->last_insert_id(undef, undef, undef, undef);
    return $id ? $self->new($id) : undef;
}

sub ficr {
    my $self = shift;
    return $self->find(@_) || $self->create(@_);
}

sub delete {
    my $self = shift;
    $self->_dbh->ddelete($self->_table, $self->_pkey . '=?', $self->id);
}

sub _attr {
    my $self = shift;
    my ($key, $val) = @_;

    croak "Unknown attr '$key'" if !exists $self->{'_attrs'}->{$key};

    if (@_ == 2) {
        croak "Read-only attr '$key'" if exists $self->{'_attrs_ro'}->{$key};
        $self->_dbh->dupdate($self->_table, {$key => encode_utf8($val)},
                             $self->_pkey . '=?', $self->id);
        $self->{$key} = $val;
    }

    return $self->{$key};
}

sub DESTROY { }

sub AUTOLOAD {
    my $self = shift;
    my ($attr) = ($AUTOLOAD =~ /::([^:]+)$/);

    if ($attr =~ /^([a-zA-Z0-9_]+)$/) {
        if (exists $self->{'_attrs'}->{$attr}) {
            eval "sub $attr { shift->_attr('$attr', \@_); }";
        }
        return $self->_attr($attr, @_);
    }
}

1;