package LISM::Storage::SQL;

use strict;
use base qw(LISM::Storage);
use Net::LDAP::Filter;
use Net::LDAP::Constant qw(:all);
use DBI;
use Encode;
use Sys::Syslog;
use Sys::Syslog qw(:macros);
use Data::Dumper;

=head1 NAME

LISM::Storage::SQL - SQL storage for LISM

=head1 DESCRIPTION

This class implements the L<LISM::Storage> interface for SQL DB.

=head1 METHODS

=head2 init

Connect RDB server.

=cut

sub init
{
    my $self = shift;

    return $self->SUPER::init();
}

=pod

=head2 commit

Commit the transaction to the RDB.

=cut

sub commit
{
    my $self = shift;
    my $rc = 0;

    if (!defined($self->{db})) {
        return $rc;
    }

    if (!$self->{db}->commit) {
        $self->log(level => 'crit', message => "Can't commit: ".$self->{db}->errstr);
        $rc = -1;
    }

    $self->_freeConnect();

    return $rc;
}

=pod

=head2 rollback

Rollback the transaction to the RDB.

=cut

sub rollback
{
    my $self = shift;
    my $rc = 0;

    if (!defined($self->{db})) {
        return $rc;
    }

    if (!$self->{db}->rollback) {
        $self->log(level => 'crit', message => "Can't rollback: ".$self->{db}->errstr);
        $rc = -1;
    }

    $self->_freeConnect();

    return $rc;
}

=pod

=head2 hashPasswd($passwd, $salt)

add hash schema at the head of hashed password.

=cut

sub hashPasswd
{
    my $self = shift;
    my ($passwd, $salt) =@_;
    my $conf = $self->{_config};
    my $hashpw;

    my ($htype, $otype) = split(/:/, $conf->{hash});

    my $hashpw = $self->SUPER::hashPasswd($passwd, $salt);

    if ($htype =~ /^MYSQL$/i) {
        # get MySQL password
        if ($self->_getConnect()) {
            return $passwd;
        }

        my $sth = $self->{db}->prepare("select password(\'$passwd\');");
        if (!$sth->execute) {
            $self->log(level => 'error', message => "MySQL PASSWORD(\'$passwd\') failed: ".$sth->errstr);
            return $passwd;
        }
        my @data = $sth->fetchrow_array;
        $hashpw = $data[0];
        $sth->finish;
    }

    return $hashpw;
}

sub _getConnect
{
    my $self = shift;
    my $conf = $self->{_config};

    if (defined($self->{db})) {
        my $sth = $self->{db}->prepare("select 'check';");
        if (!$sth->execute) {
            $self->log(level => 'error', message => "Connection check failed");
        } else {
            return 0;
        }
        $sth->finish;
    }

    $self->{db} = DBI->connect($conf->{dsn}[0], $conf->{admin}[0], $conf->{passwd}[0]);
    if (!$self->{db}) {
        $self->log(level => 'alert', message => "Can't connect $conf->{dsn}[0]: ".$DBI::errstr);
        return -1;
    }

    if (defined($conf->{initquery}) && !$self->{db}->do($conf->{initquery}[0])) {
        $self->log(level => 'crit', message => "$conf->{initquery}[0] failed: ".$self->{db}->errstr);
        return -1;
    }

    return 0;
}

sub _freeConnect
{
    my $self = shift;

    if ($self->{db}->err) {
        $self->{db}->disconnect();

        undef($self->{db});
    }
}

sub _checkConfig
{
    my $self = shift;
    my $conf = $self->{_config};
    my $rc = 0;

    $rc = $self->SUPER::_checkConfig();
    if ($rc) {
        return $rc;
    }

    foreach my $oname (keys %{$conf->{object}}) {
        my $oconf = $conf->{object}{$oname};

        # check container fromtbls
        if (defined($oconf->{container}[0]->{oname})) {
            if (defined($oconf->{container}[0]->{fromtbls})) {
                my $poconf = $self->{object}{$oconf->{container}[0]->{oname}[0]}->{conf};
                if (",$oconf->{container}[0]->{fromtbls}[0]," =~
                    /,$poconf->{table}[0], */) {
                    $self->log(level => 'alert', message => "fromtbls($oconf->{container}[0]->{fromtbls}[0]) mustn't include container object table");
                    return 1;
                }
            }
        }

        foreach my $attr (keys %{$oconf->{attr}}) {
            # check attribute fromtbls
            if (defined($oconf->{attr}{$attr}->{oname})) {
                if (defined($oconf->{attr}{$attr}->{fromtbls})) {
                    my $aoconf = $self->{object}{$oconf->{attr}{$attr}->{oname}[0]}->{conf};
                    if (",$oconf->{attr}{$attr}->{fromtbls}[0]," =~
                        /,$aoconf->{table}[0], */) {
                        $self->log(level => 'alert', message => "fromtbls($oconf->{attr}{$attr}->{fromtbls}[0]) mustn't include attribute object table");
                        return 1;
                    }
                }
            }
        }
    }

    return 0;
}

=pod

=head2 _objSearch($obj, $parent, $suffix, $sizeLim, $filter)

Search the appropriate records in the object's table.

=cut

sub _objSearch
{
    my $self = shift;
    my ($obj, $pkey, $suffix, $sizeLim, $filter) = @_;
    my $conf = $self->{_config};
    my $oconf = $obj->{conf};
    my @match_entries = ();
    my @match_keys = ();
    my $rc = LDAP_SUCCESS;

    DO: {
        # get data of the entries
        my $sql = "select distinct $oconf->{table}[0].$oconf->{id}[0]->{column}[0]";
        foreach my $attr ('objectclass', keys %{$oconf->{attr}}) {
            if (!defined($oconf->{attr}{$attr}) || !defined($oconf->{attr}{$attr}->{column})) {
                next;
            }
            $sql = "$sql, $oconf->{table}[0].$oconf->{attr}{$attr}->{column}[0]";
        }

        # exchange the LDAP filter to SQL
        my $from;
        my $where;
        if (!$self->_filter2sql($oconf, $filter, \$from, \$where)) {
            $rc = LDAP_FILTER_ERROR;
            @match_entries = ();
            last DO;
        }

        # entries below suffix
        if ($pkey && defined($oconf->{container}) && !defined($oconf->{container}[0]->{rdn})) {
            my $poconf = $self->{object}{$oconf->{container}[0]->{oname}[0]}->{conf};

            $from = "$from, $poconf->{table}[0]";
            if (defined($oconf->{container}[0]->{fromtbls})) {
                $from = "$from, $oconf->{container}[0]->{fromtbls}[0]";
            }

            $where = "$where and $poconf->{table}[0].$poconf->{id}[0]->{column}[0] = \'$pkey\'";
            if (defined($oconf->{container}[0]->{joinwhere})) {
                $where = "$where and $oconf->{container}[0]->{joinwhere}[0]";
            }
        }

        $sql = "$sql from $from where $where";

        # multibyte value
        $sql = encode($conf->{mbcode}[0], decode('utf8', $sql));
        my $sth = $self->{db}->prepare($sql);
        if (!$sth->execute) {
            $self->log(level => 'error', message => "Searching by \"$sql\" failed: ".$sth->errstr);
            $rc = LDAP_OPERATIONS_ERROR;
            @match_entries = ();
            last DO;
        }

        # get the record from the result
        while (my @data = $sth->fetchrow_array) {
            my $entry;

            # check the number of returned entries
            if ($sizeLim >= 0 && @match_entries == $sizeLim) {
                $rc = LDAP_SIZELIMIT_EXCEEDED;
                last DO;
            }

            my $key = shift(@data);
            if ($key eq '') {
                next;
            }

            my $j = 0;
            foreach my $attr ('objectclass', keys %{$oconf->{attr}}) {
                if ($attr =~ /^objectclass$/i) {
                    foreach my $oc (@{$oconf->{oc}}) {
                        $entry = $entry."objectclass: $oc\n";
                    }
                } elsif (!defined($oconf->{attr}->{$attr})) {
                    next;
                } elsif (defined($oconf->{attr}{$attr}->{column})) {
                    my $value = $data[$j];
                    $value =~ s/ *$//;
                    if ($value) {
                        $entry = $entry."$attr: $value\n";
                    }
                    $j++;
                } else {
                    # get the values from the attribute's table
                    my $values = $self->_getAttrValues($oconf, $attr, $key);
                    if (!defined($values)) {
                        $rc = LDAP_OPERATIONS_ERROR;
                        @match_entries = ();
                        last DO;
                    }

                    if ($values) {
                        $entry = $entry.$values;
                    }
                }
            }

            # multibyte value
            if ($conf->{dsn}[0] =~ /^DBI:Oracle/i && Encode::is_utf8($entry)) {
                # add-hoc method for Oracle
                if (Encode::is_utf8($entry)) {
                    Encode::_utf8_off($entry);
                }
            }

            Encode::from_to($entry, $conf->{mbcode}[0], 'utf8');
            $entry = decode('utf8', $entry);

            my ($rdn_val) = ($entry =~ /^$oconf->{rdn}[0]: (.*)$/mi);
            my $rdn = "$oconf->{rdn}[0]=$rdn_val";
            $entry = "dn: $rdn,$suffix\n$entry";
            push(@match_entries, $self->_pwdFormat($entry));
            push(@match_keys, $key);
        }

        $sth->finish;
    }

    return ($rc, \@match_keys, @match_entries);
}

=pod

=head2 _objModify($obj, $peky, $dn, @list)

Update the data of the object's table and insert the data to the attribute's table.

=cut

sub _objModify
{
    my $self = shift;
    my ($obj, $pkey, $dn, @list) = @_;
    my $conf = $self->{_config};
    my $oconf = $obj->{conf};
    my $rc = LDAP_SUCCESS;

    DO: {
        # start transaction
        if (!$self->{db}->begin_work) {
            $self->log(level => 'error', message => "Can't begin: ".$self->{db}->errstr);
            $rc = LDAP_OPERATIONS_ERROR;
            last DO;
        }

        my $entry;
        my $key;

        ($rc, $key, $entry) = $self->_baseSearch($obj, $pkey, $dn, 0, 0, 1, 0, undef);
        if ($rc) {
            last DO;
        }

        if (!$entry) {
            $rc = LDAP_NO_SUCH_OBJECT;
            last DO;
        }
        $entry = encode('utf8', $entry);

        while ( @list > 0 ) {
            my $action = shift @list;
            my $attr    = lc(shift @list);
            my @values;
            my $sql;
            my $sth;

            while (@list > 0 && $list[0] ne "ADD" && $list[0] ne "DELETE" && $list[0] ne "REPLACE") {
                push(@values, shift @list);
            }

            if (!defined($oconf->{attr}{$attr})) {
                next;
            }

            # can't modify the attribute for rdn
            if ($attr eq $oconf->{rdn}[0]) {
                if ($action ne "REPLACE" || @values != 1) {
                    $rc = LDAP_CONSTRAINT_VIOLATION;
                    last DO;
                } else {
                    my $value = $values[0];
                    $value =~ s/([.*+?\[\]()|\^\$\\])/\\$1/g;
                    if ($entry !~ /^$attr: $value$/mi) {
                        $rc = LDAP_CONSTRAINT_VIOLATION;
                        last DO;
                    }
                }
            }

            for (my $i = 0; $i < @values; $i++) {
                if ($values[$i]) {
                    # escape special character
                    $values[$i] =~ s/'/''/g;
                    $values[$i] =~ s/\\/\\\\/g;
                }
            }

            if($action eq "ADD") {
                # check whether the value already exists
                my $vals_str = "(".join('|', @values).")";
                $vals_str =~ s/([.*+?\[\]()|\^\$\\])/\\$1/g;
                if ($entry =~ /^$attr: $vals_str *$/mi) {
                    $rc = LDAP_TYPE_OR_VALUE_EXISTS;
                    last DO;
                }

                if (defined($oconf->{attr}{$attr}->{column})) {
                    # the attribute must not exist
                    if ($entry =~ /^$attr: /mi) {
                        $rc = LDAP_CONSTRAINT_VIOLATION;
                        last DO;
                    }
                    $sql = "update $oconf->{table}[0] set $oconf->{attr}{$attr}->{column}[0] = \'$values[0]\' where $oconf->{id}[0]->{column}[0] = \'$key\'";

                    # multibyte value
                    $sql = encode($conf->{mbcode}[0], decode('utf8', $sql));

                    $sth = $self->{db}->prepare($sql);
                    if (!$sth->execute) {
                        $self->log(level => 'error', message => "Adding values by \"$sql\" failed: ".$sth->errstr);
                        $rc = LDAP_OPERATIONS_ERROR;
                        last DO;
                    }
                    $sth->finish;
                }

                if (defined($oconf->{attr}{$attr}->{addproc})) {
                    for (my $i = 0; $i < @values; $i++) {
                        if ($self->_addAttrValues($oconf, $key, $attr, $values[$i])) {
                            $rc = LDAP_OPERATIONS_ERROR;
                            last DO;
                        }
                    }
                }
            } elsif( $action eq "DELETE" ) {
                # check whether the value exists
                for (my $i = 0; $i < @values; $i++) {
                    my $value = $values[$i];
                    $value =~ s/([.*+?\[\]()|\^\$\\])/\\$1/g;
                    if ($value && $entry !~ /^$attr: $value *$/mi) {
                        $rc = LDAP_NO_SUCH_ATTRIBUTE;
                        last DO;
                    }
                }

                if (defined($oconf->{attr}{$attr}->{column})) {
                    $sql = "update $oconf->{table}[0] set $oconf->{attr}{$attr}->{column}[0] = \'\' where $oconf->{id}[0]->{column}[0] = \'$key\'";

                    # multibyte value
                    $sql = encode($conf->{mbcode}[0], decode('utf8', $sql));


                    $sth = $self->{db}->prepare($sql);
                    if (!$sth->execute) {
                        $self->log(level => 'error', message => "Deleting values by \"$sql\" failed: ".$sth->errstr);
                        $rc = LDAP_OPERATIONS_ERROR;
                        last DO;
                    }
                    $sth->finish;
                }

                if (defined($oconf->{attr}{$attr}->{delproc})) {
                    if (!@values || !$values[0]) {
                        @values = ($entry =~ /^$attr: (.*)$/mgi);
                        for (my $i = 0; $i < @values; $i++) {
                            # escape special character
                            $values[$i] =~ s/'/''/g;
                            $values[$i] =~ s/\\/\\\\/g;
                        }
                    }

                    foreach my $value (@values) {
                        if ($self->_delAttrValues($oconf, $key, $attr, $value)) {
                            $rc = LDAP_OPERATIONS_ERROR;
                            last DO;
                        }
                    }
                }
            } elsif( $action eq "REPLACE" ) {
                if (defined($oconf->{attr}{$attr}->{column})) {
                    # the attribute must not have more than two value
                    if (@values > 1) {
                        $rc = LDAP_CONSTRAINT_VIOLATION;
                        last DO;
                    }
                    $sql = "update $oconf->{table}[0] set $oconf->{attr}{$attr}->{column}[0] = \'$values[0]\' where $oconf->{id}[0]->{column}[0] = \'$key\'";

                    # multibyte value
                    $sql = encode($conf->{mbcode}[0], decode('utf8', $sql));

                    $sth = $self->{db}->prepare($sql);
                    if (!$sth->execute) {
                        $self->log(level => 'error', message => "Replacing values by \"$sql\" failed: ".$sth->errstr);
                        $rc = LDAP_OPERATIONS_ERROR;
                        last DO;
                    }
                    $sth->finish;
                }

                if (defined($oconf->{attr}{$attr}->{addproc}) || defined($oconf->{attr}{$attr}->{delproc})) {
                    my @old_vals = ($entry =~ /^$attr: (.*)$/mgi);
                    my @existing_vals;

                    # delete the old values which exists
                    foreach my $old_val (@old_vals) {
                        my $match = 0;
                        for (my $i = 0; $i < @values; $i++) {
                            my $value = $values[$i];
                            $value =~ s/([.*+?\[\]()|\^\$\\])/\\$1/g;
                            if ($old_val =~ /^$value$/i) {
                                $match = 1;
                                next;
                            }
                        }
                        if ($match) {
                            push(@existing_vals, $old_val);
                            next;
                        }

                        # escape special character
                        $old_val =~ s/'/''/g;
                        $old_val =~ s/\\/\\\\/g;

                        if ($self->_delAttrValues($oconf, $key, $attr, $old_val)) {
                            $rc = LDAP_OPERATIONS_ERROR;
                            last DO;
                        }
                    }

                    # add the new values doesn't exist
                    for (my $i = 0; $i < @values; $i++) {
                        my $value = $values[$i];
                        $value =~ s/([.*+?\[\]()|\^\$\\])/\\$1/g;
                        if (grep(/^$value$/i, @existing_vals)) {
                            next;
                        }

                        if ($self->_addAttrValues($oconf, $key, $attr, $values[$i])) {
                            $rc = LDAP_OPERATIONS_ERROR;
                            last DO;
                        }
                    }
                }
            }
        }
    }

    if ($rc) {
        $self->rollback();
    }

    return $rc;
}

=pod

=head2 _objAdd($obj, $pkey, $dn, $entryStr)

Insert the data to the object's and the attribute's table.

=cut

sub _objAdd
{
    my $self = shift;
    my ($obj, $pkey, $dn, $entryStr) = @_;
    my $conf = $self->{_config};
    my $oconf = $obj->{conf};
    my $rc = LDAP_SUCCESS;

    DO: {
        # start transaction
        if (!$self->{db}->begin_work) {
            $self->log(level => 'error', message => "Can't begin: ".$self->{db}->errstr);
            $rc = LDAP_OPERATIONS_ERROR;
            last DO;
        }

        # check whether the entry already exists
        my $entry;
        my $key;

        ($rc, $key, $entry) = $self->_baseSearch($obj, $pkey, $dn, 0, 0, 1, 0, undef);
        if ($rc && $rc != LDAP_NO_SUCH_OBJECT) {
             last DO;
        } elsif ($entry) {
             $rc = LDAP_ALREADY_EXISTS;
             last DO;
        }

        my @cols;
        my @values;
        my %attrs;

        if (defined($oconf->{id}[0]->{sequence})) {
            push(@cols, $oconf->{id}[0]->{column}[0]);
            push(@values, $oconf->{id}[0]->{sequence}[0]);
        }

        foreach (split(/\n/, $entryStr)) {
            my ($attr, $value) = split(/: /);
            $attr = lc($attr);
            if (!defined($oconf->{attr}{$attr})) {
                next;
            }

            # escape special character
            $value =~ s/'/''/g;
            $value =~ s/\\/\\\\/g;

            if (defined($oconf->{attr}{$attr}->{column})) {
                if (!grep(/^$oconf->{attr}{$attr}->{column}[0]$/, @cols)) {
                    push(@cols, $oconf->{attr}{$attr}->{column}[0]);
                    push(@values, "\'$value\'");
                }
            }
            if (defined($oconf->{attr}{$attr}->{addproc})) {
                push(@{$attrs{$attr}}, $value);
            }
        }

        # get the storage-specific information
        my @si_values = (); 
        foreach my $strginfo (@{$oconf->{strginfo}}) {
            my $value = $self->_getStaticValue($strginfo, $dn, $entryStr);
            push(@si_values, $value);

            if (defined($strginfo->{column})) {
                if (!grep(/^$strginfo->{column}[0]$/, @cols)) {
                    push(@cols, $strginfo->{column}[0]);
                    push(@values, "\'$value\'");
                }
            }
        }

        my $sql = "insert into $oconf->{table}[0](".join(', ', @cols).") values(".join(', ', @values).")";

        # multibyte value
        $sql = encode($conf->{mbcode}[0], decode('utf8', $sql));

        my $sth = $self->{db}->prepare("$sql");
        if (!$sth->execute) {
            $self->log(level => 'error', message => "Adding entry by \"$sql\" failed: ".$sth->errstr);
            $rc = LDAP_OPERATIONS_ERROR;
            last DO;
        }
        $sth->finish;

        # get the added object's id from the table
        my ($rdn, $pdn) = ($dn=~ /^([^,]+),(.*)$/);
        my $filter = Net::LDAP::Filter->new("($rdn)");
        my $keys;

        ($rc, $keys) = $self->_objSearch($obj, '', $pdn, -1, $filter);
        if ($rc || !@{$keys}) {
            $self->log(level => 'error', message => "Can't get id of $dn from the table");
            $rc = LDAP_OPERATIONS_ERROR;
            last DO;
        }

        # get newest id
        my $key;
        while (@{$keys} > 0) {
            $key = shift @{$keys};
        }

        # add the storage-specific information
        for (my $i = 0; $i < @{$oconf->{strginfo}}; $i++) {
            if (!defined(${$oconf->{strginfo}}[$i]->{addproc})) {
                next;
            }

            foreach my $addproc (@{${$oconf->{strginfo}}[$i]->{addproc}}) {
	        $sql = $addproc;
                $sql =~ s/\%o/$key/g;
                $sql =~ s/\%v/$si_values[$i]/g;

                # multibyte value
                $sql = encode($conf->{mbcode}[0], decode('utf8', $sql));

                $sth = $self->{db}->prepare("$sql");
                if (!$sth->execute) {
                    $self->log(level => 'error', message => "Adding storage-specific information by \"$sql\" failed: ".$sth->errstr);
                    $rc = LDAP_OPERATIONS_ERROR;
                    last DO;
                }
                $sth->finish;
            }
        }

        # add the values in the attribute's table
        foreach my $attr (keys %attrs) {
            foreach my $value (@{$attrs{$attr}}) {
                if ($rc = $self->_addAttrValues($oconf, $key, $attr, $value)) {
                    $self->log(level => 'error', message => "Adding values of $attr failed");
                    $rc = LDAP_OPERATIONS_ERROR;
                    last DO;
                }
            }
        }

        # add the link with container
        if (defined($oconf->{container}) && defined($oconf->{container}[0]->{addproc})) {
            $sql = $oconf->{container}[0]->{addproc}[0];
            $sql =~ s/\%o/$key/g;
            $sql =~ s/\%c/$pkey/g;
            $sth = $self->{db}->prepare("$sql");
            if (!$sth->execute) {
                $self->log(level => 'error', message => "Adding link of container by \"$sql\" failed: ".$sth->errstr);
                $rc = LDAP_OPERATIONS_ERROR;
                last DO;
            }
            $sth->finish;
        }
    }

    if ($rc) {
        $self->rollback();
    }

    return $rc;
}

=pod

=head2 _objDelete

delete the data from the object's and the attribute's table.

=cut

sub _objDelete
{
    my $self = shift;
    my ($obj, $pkey, $dn) = @_;
    my $conf = $self->{_config};
    my $oconf = $obj->{conf};
    my $rc = LDAP_SUCCESS;

    DO: {
        # start transaction
        if (!$self->{db}->begin_work) {
            $self->log(level => 'error', message => "Can't begin: ".$self->{db}->errstr);
            $rc = LDAP_OPERATIONS_ERROR;
            last DO;
        }

        # get the object's id from the table
        my $key;

        ($rc, $key) = $self->_baseSearch($obj, $pkey, $dn, 0, 0, 1, 0, undef);
        if ($rc) {
            last DO;
        }
        if (!defined($key)) {
            $rc = LDAP_NO_SUCH_OBJECT;
            last DO;
        }

        my $sql;
        my $sth;

        # delete the values from the attribute's table
        foreach my $attr (keys %{$oconf->{attr}}) {
            if (defined($oconf->{attr}{$attr}) && defined($oconf->{attr}{$attr}->{delproc})) {
                if ($rc = $self->_delAttrValues($oconf, $key, $attr, '')) {
                    $rc = LDAP_OPERATIONS_ERROR;
                    last DO;
                }
            }
        }

        # delete the storage-specific information
        foreach my $strginfo (@{$oconf->{strginfo}}) {
            if (!defined($strginfo->{delproc})) {
                next;
            }
            my $value = $self->_getStaticValue($strginfo, $dn);
            foreach my $delproc (@{$strginfo->{delproc}}) {
	        $sql = $delproc;
                $sql =~ s/\%o/$key/g;
                $sql =~ s/\%v/$value/g;

                # multibyte value
                $sql = encode($conf->{mbcode}[0], decode('utf8', $sql));

                $sth = $self->{db}->prepare("$sql");
                if (!$sth->execute) {
                    $self->log(level => 'error', message => "Deleting storage-specific information by \"$sql\" failed: ".$sth->errstr);
                    $rc = LDAP_OPERATIONS_ERROR;
                    last DO;
                }
                $sth->finish;
            }
        }

        # delete the link with container
        if (defined($oconf->{container}) && defined($oconf->{container}[0]->{delproc})) {
            $sql = $oconf->{container}[0]->{delproc}[0];
            $sql =~ s/\%o/$key/g;
            $sql =~ s/\%c/$pkey/g;
            $sth = $self->{db}->prepare("$sql");
            if (!$sth->execute) {
                $self->log(level => 'error', message => "Adding link of container by \"$sql\" failed: ".$sth->errstr);
                $rc = LDAP_OPERATIONS_ERROR;
                last DO;
            }
            $sth->finish;
        }

        # delete the appropriate record from the object's table
        $sql = "delete from $oconf->{table}[0] where $oconf->{id}[0]->{column}[0] = \'$key\'";
        $sth = $self->{db}->prepare($sql);
        if (!$sth->execute) {
            $self->log(level => 'error', message => "Deleting entry by \"$sql\" failed: ".$sth->errstr);
            $rc = LDAP_OPERATIONS_ERROR;
            last DO;
        }
        $sth->finish;
    }

    if ($rc) {
        $self->rollback();
    }

    return $rc;
}

sub _getParentRdn
{
    my $self = shift;
    my ($obj, $key) = @_;
    my $conf = $self->{_config};
    my $oconf = $obj->{conf};
    my $selexpr;
    my $from;
    my $where;

    if (defined($oconf->{container}[0]->{rdn})) {
        return $oconf->{container}[0]->{rdn}[0];
    }
    if (!defined($oconf->{container}[0]->{oname})) {
        return undef;
    }

    my $poconf = $self->{object}{$obj->{parent}}->{conf};

    if (defined($poconf->{entry})) {
        return $poconf->{entry}[0]->{rdn}[0];
    }

    $selexpr = "$poconf->{table}[0].$poconf->{id}[0]->{column}[0],$poconf->{table}[0].$poconf->{attr}{$poconf->{rdn}[0]}->{column}[0]";

    $from = "$oconf->{table}[0], $poconf->{table}[0]";
    if (defined($oconf->{container}[0]->{fromtbls})) {
        $from = "$from,$oconf->{container}[0]->{fromtbls}[0]";
    }

    $where = "$oconf->{table}[0].$oconf->{id}[0]->{column}[0] = \'$key\'";
    if (defined($oconf->{container}[0]->{joinwhere})) {
        $where = "$where and $oconf->{container}[0]->{joinwhere}[0]";
    }

    my $sql = "select $selexpr from $from where $where";
    my $sth = $self->{db}->prepare($sql);
    if (!$sth->execute) {
        $self->log(level => 'error', message => "Getting rdn by \"$sql\" failed: ".$sth->errstr);
        return undef;
    }

    # get rdn value from the result
    my @data = $sth->fetchrow_array;
    $sth->finish;

    my $rdn_val = $data[1];
    $rdn_val =~ s/ *$//;

    return ("$poconf->{rdn}[0]=$rdn_val", $data[0]);
}

sub _getAttrValues
{
    my $self = shift;
    my ($oconf, $attr, $key) = @_;
    my $conf = $self->{_config};
    my $aobj = undef;
    my $aoconf = undef;
    my $cobj = undef;
    my $coconf = undef;
    my $attrStr = '';
    my $selexpr;
    my $from;
    my $where;

    $from = $oconf->{table}[0];
    if (defined($oconf->{attr}{$attr}->{oname})) {
        $aobj = $self->{object}{$oconf->{attr}{$attr}->{oname}[0]};
        $aoconf = $aobj->{conf};
        $selexpr = "$aoconf->{table}[0].$aoconf->{id}[0]->{column}[0]";
        if (defined($aoconf->{attr}{$aoconf->{rdn}[0]}->{selexpr})) {
            $selexpr = "$selexpr, $aoconf->{attr}{$aoconf->{rdn}[0]}->{selexpr}[0]";
        } else {
            $selexpr = "$selexpr, $aoconf->{table}[0].$aoconf->{attr}{$aoconf->{rdn}[0]}->{column}[0]";
        }

        if ($oconf->{table}[0] ne $aoconf->{table}[0]) {
            $from = "$from, $aoconf->{table}[0]";
        }

        if (defined($oconf->{attr}{$attr}->{cname})) {
            $cobj = $self->{object}{$oconf->{attr}{$attr}->{cname}[0]};
            $coconf = $cobj->{conf};
            $selexpr = "$selexpr, $coconf->{table}[0].$coconf->{id}[0]->{column}[0]";
            if (defined($aoconf->{attr}{$aoconf->{rdn}[0]}->{selexpr})) {
                $selexpr = "$selexpr, $coconf->{attr}{$coconf->{rdn}[0]}->{selexpr}[0]";
            } else {
                $selexpr = "$selexpr, $coconf->{table}[0].$coconf->{attr}{$coconf->{rdn}[0]}->{column}[0]";
            }

            $from = "$from, $coconf->{table}[0]";
        }
    } else {
        $selexpr = $oconf->{attr}{$attr}->{selexpr}[0];
    }

    if (defined($oconf->{attr}{$attr}->{fromtbls})) {
        $from = "$from,$oconf->{attr}{$attr}->{fromtbls}[0]";
    }

    $where = "$oconf->{table}[0].$oconf->{id}[0]->{column}[0] = \'$key\'";
    if (defined($oconf->{attr}{$attr}->{joinwhere})) {
        $where = "$where and $oconf->{attr}{$attr}->{joinwhere}[0]";
    }

    my $sql = "select $selexpr from $from where $where";
    my $sth = $self->{db}->prepare($sql);
    if (!$sth->execute) {
        $self->log(level => 'error', message => "Getting values by \"$sql\" failed: ".$sth->errstr);
        return undef;
    }

    # get the attribute's values from the result
    while (my @data = $sth->fetchrow_array) {
        if (!@data) {
            next;
        } elsif ($aoconf) {
            $attrStr = $attrStr."$attr: $aoconf->{rdn}[0]=$data[1],";
            if ($coconf) {
                $attrStr = $attrStr."$coconf->{rdn}[0]=$data[3],".$self->_getParentDn($cobj, $data[2])."\n";
            } else {
                $attrStr = $attrStr.$self->_getParentDn($aobj, $data[0])."\n";
            }
            $attrStr =~ s/ *,/,/g;
        } else{
            $data[0] =~ s/ *$//;
            if ($data[0]) {
                $attrStr = $attrStr."$attr: $data[0]\n";
            }
        }
    }
    $sth->finish;

    return $attrStr;
}

sub _addAttrValues
{
    my $self = shift;
    my ($oconf, $key, $attr, $value) = @_;
    my $conf = $self->{_config};

    if (!defined($oconf->{attr}{$attr}->{addproc})) {
        return -1;
    }

    foreach my $addproc (@{$oconf->{attr}{$attr}->{addproc}}) {
        my $sql = $addproc;
        $sql =~ s/\%o/$key/g;
        if (defined($oconf->{attr}{$attr}->{oname})) {
            my ($rc, $aobj, $attrpkey) = $self->_getObject($value);
            if ($rc) {
                return -1;
            }

            my $attrkey;
            ($rc, $attrkey) =$self->_baseSearch($aobj, $attrpkey, $value, 0, 0, 1, 0, undef);
            if ($rc) {
                $self->log(level => 'error', message => "Can't get id of $value in the table");
                return -1;
            } elsif (!$attrkey) {
		$self->log(level => 'error', message => "Id of $value doesn't exist in the table");
                return 1;
            }
            $sql =~ s/\%a/$attrkey/g;

            if (defined($oconf->{attr}{$attr}->{cname})) {
                my $contdn;
                ($contdn = $value) =~ s/^[^,]+,//;
                my ($rc, $cobj, $contpkey) = $self->_getObject($contdn);
                if ($rc) {
                    return -1;
                }

                my $contkey;
                ($rc, $contkey) =$self->_baseSearch($cobj, $contpkey, $contdn, 0, 0, 1, 0, undef);
                if ($rc) {
                    $self->log(level => 'error', message => "Can't get id of $contdn in the table");
                    return -1;
                } elsif (!$contkey) {
                    $self->log(level => 'error', message => "Id of $contdn doesn't exist in the table");
                    return 1;
                }
                $sql =~ s/\%c/$contkey/g;
            }
        } else {
            $sql =~ s/\%a/$value/g;
        }

        # multibyte value
        $sql = encode($conf->{mbcode}[0], decode('utf8', $sql));

        # add the values to the attribute's table
	my $sth = $self->{db}->prepare($sql);
        if (!$sth->execute) {
            $self->log(level => 'error', message => "Adding values by \"$sql\" failed: ".$sth->errstr);
            return -1;
        }
        $sth->finish;
    }

    return 0;
}

sub _delAttrValues
{
    my $self = shift;
    my ($oconf, $key, $attr, $value) = @_;
    my $conf = $self->{_config};

    if (!defined($oconf->{attr}{$attr}->{delproc})) {
        return 1;
    }

    foreach my $delproc (@{$oconf->{attr}{$attr}->{delproc}}) {
        my $sql = $delproc;
        $sql =~ s/\%o/$key/g;
        if ($value) {
            if (defined($oconf->{attr}{$attr}->{oname})) {
                my ($rc, $aobj, $attrpkey) = $self->_getObject($value);
                if ($rc) {
                    return -1;
                }

                my $attrkey;
                ($rc, $attrkey) =$self->_baseSearch($aobj, $attrpkey, $value, 0, 0, 1, 0, undef);
                if ($rc) {
		    $self->log(level => 'error', message => "Can't get id of $value from the table");
                    return -1;
                } elsif (!$attrkey) {
		    $self->log(level => 'error', message => "Id of $value doesn't exist in the table");
                    return 1;
                }
                $sql =~ s/\%a/$attrkey/g;

                if (defined($oconf->{attr}{$attr}->{cname})) {
                    my $contdn;
                    ($contdn = $value) =~ s/^[^,]+,//;
                    my ($rc, $cobj, $contpkey) = $self->_getObject($contdn);
                    if ($rc) {
                        return -1;
                    }

                    my $contkey;
                    ($rc, $contkey) =$self->_baseSearch($cobj, $contpkey, $contdn, 0, 0, 1, 0, undef);
                    if ($rc) {
                        $self->log(level => 'error', message => "Can't get id of $contdn in the table");
                        return -1;
                    } elsif (!$contkey) {
                        $self->log(level => 'error', message => "Id of $contdn doesn't exist in the table");
                        return 1;
                    }
                    $sql =~ s/\%c/$contkey/g;
                }
            } else {
                $sql =~ s/\%a/$value/g;
            }
        } else {
            $sql =~ s/\w*\s*=\s*'?\%a'?/1 = 1/g;
            $sql =~ s/\w*\s*=\s*'?\%c'?/1 = 1/g;
        }

        # multibyte value
        $sql = encode($conf->{mbcode}[0], decode('utf8', $sql));

        # delete the values from the attribute's table
        my $sth = $self->{db}->prepare($sql);
        if (!$sth->execute) {
            $self->log(level => 'error', message => "Deleting values by \"$sql\" failed: ".$sth->errstr);
            return -1;
        }
        $sth->finish;
    }

    return 0;
}

sub _filter2sql
{
    my $self = shift;
    my ($oconf, $filter, $from, $where) = @_;
    my ($type, $attr, $value);
    my $conf = $self->{_config};

    if (!$filter) {
        ${$from} = $oconf->{table}[0];
        ${$where} = '1 = 1';
        return 1;
    }

    my ($op) = keys %{$filter};
    my $args = $filter->{$op};

    if ($op eq 'and' || $op eq 'or') {
        my ($lfrom, $lwhere, $rfrom, $rwhere);
        my $left = $self->_filter2sql($oconf, @{$args}[0], \$lfrom, \$lwhere);
        my $right = $self->_filter2sql($oconf, @{$args}[1], \$rfrom, \$rwhere);
        if (!$left || !$right) {
            return 0;
        }

        ${$where} = "($lwhere $op $rwhere)";
        ${$from} = $lfrom;
        foreach my $table (split(/, */, $rfrom)) {
            if (",$lfrom," =~ /, *$table *,/) {
                next;
            }
            ${$from} = "${$from}, $table";
        }
        return 1;
    } elsif ($op eq 'not'){
        if (!$self->_filter2sql($oconf, $args, $from, $where)) {
            return 0;
        }

        return 1;
    }

    if ($op =~ /^(equalityMatch|greaterOrEqual|lessOrEqual)/) {
        $attr = lc($args->{attributeDesc});
        $value = $args->{assertionValue};
        if ($op eq 'equalityMatch') {
            $type = '=';
        } elsif ($op eq 'greaterOrEqual') {
            $type = '>=';
        } elsif ($op eq 'lessOrEqual') {
            $type = '<=';
        }
    } else {
        $type = 'like';
        if ($op eq 'substrings') {
            $attr = lc($args->{type});
            $value = $args->{substrings}[0]{initial}."%".$args->{substrings}[1]{final};
        } elsif ($op eq 'present') {
            $attr = lc($args);
            $value = '%';
        }

        if (defined($oconf->{attr}{$attr}) && defined($oconf->{attr}{$attr}->{oname})) {
            return 0;
        }
    }

    # escape special character
    $value =~ s/'/''/g;
    $value =~ s/\\/\\\\/g;

    ${$from} = $oconf->{table}[0];
    if ($attr =~ /^objectclass$/i) {
        # check object class in filter
        $value =~ s/%/.*/;
        if (grep(/^$value$/i, @{$oconf->{oc}})) {
            ${$where} = '1 = 1';
        } else {
            ${$where} = '1 = 0';
        }
    } elsif (!defined($oconf->{attr}{$attr})) {
        # attribute doesn't exit
        ${$where} = '1 = 0';
    } elsif (defined($oconf->{attr}{$attr}->{column})) {
        ${$where} = "lower($oconf->{table}[0].$oconf->{attr}{$attr}->{column}[0]) $type lower(\'$value\')";
    } elsif (defined($oconf->{attr}{$attr}->{oname})) {
        my $attrobj = $conf->{object}{$oconf->{attr}{$attr}->{oname}[0]};
        my $aconf = $attrobj->{conf};
        if (defined($oconf->{attr}{$attr}->{fromtbls})) {
            ${$from} = "${$from},$oconf->{attr}{$attr}->{fromtbls}[0]";
        }

        ($value) = ($value =~ /^$attrobj->{rdn}[0]=([^,]*)/i);
        ${$where} = "lower($attrobj->{table}[0].$attrobj->{attr}{$attrobj->{rdn}[0]}->{column}[0]) $type lower(\'$value\')";
        if (defined($oconf->{attr}{$attr}->{joinwhere})) {
            ${$where} = "${$where} and $oconf->{attr}{$attr}->{joinwhere}[0]";
        }

        if (defined($aconf->{container}) && !defined($aconf->{container}[0]->{rdn})) {
            my $paconf = $self->{object}{$aconf->{container}[0]->{oname}[0]}->{conf};

            $from = "$from, $paconf->{table}[0]";
            if (defined($aconf->{container}[0]->{fromtbls})) {
                $from = "$from, $oconf->{container}[0]->{fromtbls}[0]";
            }

            if (defined($aconf->{container}[0]->{joinwhere})) {
                $where = "$where and $aconf->{container}[0]->{joinwhere}[0]";
            }
        }
    } else {
        if (defined($oconf->{attr}{$attr}->{fromtbls})) {
            ${$from} = "${$from},$oconf->{attr}{$attr}->{fromtbls}[0]";
        }
        ${$where} = "lower($oconf->{attr}{$attr}->{selexpr}[0]) $type lower(\'$value\')";
        if (defined($oconf->{attr}{$attr}->{joinwhere})) {
            ${$where} = "${$where} and $oconf->{attr}{$attr}->{joinwhere}[0]";
        }
    }

    return 1;
}

=head1 SEE ALSO

L<LISM>,
L<LISM::Storage>

=head1 AUTHOR

Kaoru Sekiguchi, <sekiguchi.kaoru@secioss.co.jp>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Kaoru Sekiguchi

This library is free software; you can redistribute it and/or modify
it under the GNU LGPL.

=cut

1;
