package PROP::Link;

use strict;
use Carp;
use PROP::Schema;
use PROP::Constants;
use PROP::SQL::Select;
use PROP::SQL::Insert;
use PROP::SQL::Update;
use PROP::SQL::Delete;
use PROP::ResultSet::Link;
use PROP::Exception;
use PROP::Exception::Configuration;
use Hash::Util qw/lock_hash/;

sub new {
    my ($invocant, $table_name, $parent_class, $child_class) = @_;

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

    $self->{-table_name}   = $table_name;
    $self->{-parent_class} = $parent_class;
    $self->{-child_class}  = $child_class;

    $self->{-table} = new PROP::Schema($table_name);

    my $pk = $self->{-table}->get_pk_name();

    unless(ref($pk) eq 'ARRAY' and scalar(@$pk) == 2) {
	my $msg = "link table $table_name does not have a properly configured" .
	    " primary key (it must be a dual primary key, for a parent id" .
	    " and child id)";
	die new PROP::Exception::Configuration($msg);
    }

    lock_hash(%$self) if DEBUG;

    return $self;
}

sub get_table_name {
    my ($self) = @_;
    return $self->{-table_name};
}

sub get_parent_table_name {
    my ($self) = @_;
    return $self->get_parent_class()->get_table_name();
}

sub get_child_table_name {
    my ($self) = @_;
    return $self->get_child_class()->get_table_name();
}

sub get_parent_class {
    my ($self) = @_;
    return $self->{-parent_class};
}

sub get_child_class {
    my ($self) = @_;
    return $self->{-child_class};
}

sub get_parent_field_name {
    my ($self) = @_;
    return $self->get_schema()->get_pk_name()->[0];
}

sub get_child_field_name {
    my ($self) = @_;
    return $self->get_schema()->get_pk_name()->[1];
}

sub get_contextual_field_names {
    my ($self) = @_;
    my @fields = $self->get_schema()->get_field_names();
    return unless scalar(@fields) > 2;
    return @fields[2..$#fields];
}

sub get_schema {
    my ($self) = @_;
    return $self->{-table};
}

sub insert {
    my ($self, $parent, $child, $contextual_values) = @_;
    
    # allow passing as arguments either a primary key, or the object itself

    unless($parent =~ /^\d+$/) {
	die new PROP::Exception::IllegalArgument('parent cannot be undefined')
	    unless($parent);

	die new PROP::Exception("parent's primary key is not set")
	    unless $parent->get_pk_value();

	$parent = $parent->get_pk_value();
    }

    unless($child =~ /^\d+$/) {
	die new PROP::Exception::IllegalArgument('child cannot be undefined')
	    unless($child);

	die new PROP::Exception("child's primary key is not set")
	    unless $child->get_pk_value();

	$child = $child->get_pk_value();
    }

    my $stmt = new PROP::SQL::Insert;

    $stmt->add_table($self->{-table_name});

    my @bindings = ($parent, $child);

    $stmt->push_field($self->get_parent_field_name());
    $stmt->push_field($self->get_child_field_name());
    
    foreach (keys(%$contextual_values)) {
	unless($self->get_schema()->has_field($_)) {
	    my $msg = "unknown contextual field '$_' for link table "
		. $self->get_table_name();

	    die new PROP::Exception::IllegalArgument($msg);
	}

	$stmt->push_field($_);
	push(@bindings, $contextual_values->{$_});
    }

    my $sth = PROP::DBH->get_handle()->prepare($stmt->stringify());

    unless($sth->execute(@bindings)) {
	my $msg = "problem inserting into link table " .
	    $self->{-table_name} . " with parent=" . $parent .
	    " and child=" . $child;
	die new PROP::Exception($msg);
    }
}

sub update {
    my ($self, $parent, $child, $contextual_values) = @_;
    
    # allow passing as arguments either a primary key, or the object itself
    $parent = $parent->get_pk_value() unless $parent =~ /^\d+$/;
    $child  = $child->get_pk_value()  unless $child  =~ /^\d+$/;

    my $stmt = new PROP::SQL::Update;

    $stmt->add_table($self->{-table_name});

    my @bindings;
    
    foreach (keys(%$contextual_values)) {
	unless($self->get_schema()->has_field($_)) {
	    my $msg = "unknown contextual field '$_' for link table "
		. $self->get_table_name();

	    die new PROP::Exception($msg);
	}
	$stmt->push_field($_);
	push(@bindings, $contextual_values->{$_});
    }

    $stmt->push_conditional_expression($self->get_parent_field_name() . ' = ?');
    $stmt->push_conditional_expression($self->get_child_field_name()  . ' = ?');

    push(@bindings, ($parent, $child));

    my $sth = PROP::DBH->get_handle()->prepare($stmt->stringify());
    $sth->execute(@bindings);
}

sub delete {
    my ($self, $parent, $child) = @_;

    # allow passing as arguments either a primary key, or the object itself
    $parent = $parent->get_pk_value() unless $parent =~ /^\d+$/;
    $child  = $child->get_pk_value()  unless $child  =~ /^\d+$/;

    my $stmt = new PROP::SQL::Delete;

    $stmt->add_table($self->{-table_name});
    $stmt->push_conditional_expression($self->get_parent_field_name() . ' = ?');
    $stmt->push_conditional_expression($self->get_child_field_name()  . ' = ?');

    my $sth = PROP::DBH->get_handle()->prepare($stmt->stringify());
    unless($sth->execute($parent, $child)) {
	my $msg = 'problem while removing link from ' . $self->{-table_name} . 
	    ' for ' . $self->get_parent_field_name() . '=' . $parent .
	    ' and ' . $self->get_child_field_name()  . '=' . $child;

	die new PROP::Exception($msg);
    }
}

1;

=head1 Name

PROP::Link

=head1 Description

This class is an abstraction of a link table in a database that ties
together pairs of objects, possibly with additional contextual
information.  Relationships can be inserted, updated, and deleted.

=head1 Synopsis

 $l = PROP::Link->new($table_name, $parent_class, $child_class);

=head1 Methods

=over

=item new

 $l = PROP::Link->new($table_name, $parent_class, $child_class);

This method creates an instance of the class PROP::Link as follow:
$table_name is the name of the link table; $parent_class is the name
of the class that is represented by the parent field in the link
table; $child_class is the name of the class that is represented by
the child field in the link table.

=item insert

 $l->insert($parent, $child, $contextual_values);

This method inserts a relationship into the link table as follows:
$parent is either the parent object or the ID thereof; $child is
either the child object or the ID thereof; $contextual_values is a
hash array reference containing a mapping of contextual field names to
values.

=item update

 $l->update($parent, $child, $contextual_values);

This method is much the same as insert, except it operates on a
pre-existing row.

=item delete

 $l->delete($parent, $child);

This method deletes a link in the link table as follows: $parent is
either the parent object or the ID thereof; $child is either the child
object or the ID thereof.

=item get_table_name

 $l->get_table_name()

This method returns the name of the link table.

=item get_schema

 $l->get_schema()

This method returns a PROP::Schema object that represents the underlying
database table.

=item get_parent_table_name

 $l->get_parent_table_name()

This method returns the name of the table in which objects of the
parent class are stored.

=item get_child_table_name

 $l->get_child_table_name()

This method returns the name of the table in which objects of the
child class are stored.

=item get_parent_class

 $l->get_parent_class()

This method returns the name of the class for parental objects.

=item get_child_class

 $l->get_child_class()

This method returns the name of the class for child objects.

=item get_parent_field_name

 $l->get_parent_field_name()

This method returns the name of the parent field in the link table,
which must be the first column.

=item get_child_field_name

 $l->get_child_field_name()

This method returns the name of the child field in the link table,
which must be the second column.

=item get_contextual_field_names

 $l->get_contextual_field_names()

This method returns an array that contains the names of the contextual
fields, in the order that they appear in the table, which must begin
at the third column and run through the end of the table, if there are
any.

=back

=head1 Author

Andrew Gibbs (awgibbs@awgibbs.com,andrew.gibbs@nist.gov)

=head1 Legalese

This software was developed at the National Institute of Standards and
Technology by employees of the Federal Government in the course of
their official duties. Pursuant to title 17 Section 105 of the United
States Code this software is not subject to copyright protection and
is in the public domain. PROP is an experimental system. NIST
assumes no responsibility whatsoever for its use by other parties, and
makes no guarantees, expressed or implied, about its quality,
reliability, or any other characteristic. We would appreciate
acknowledgement if the software is used.  This software can be
redistributed and/or modified freely provided that any derivative
works bear some notice that they are derived from it, and any modified
versions bear some notice that they have been modified.
