package Fey::Meta::HasOne;

use strict;
use warnings;

use Fey::Exceptions qw( param_error );

use Moose;
use MooseX::StrictConstructor;

extends 'Fey::Meta::FK';


has associated_attribute =>
    ( is         => 'rw',
      isa        => 'Maybe[Moose::Meta::Attribute]',
      init_arg   => undef,
      lazy_build => 1,
    );

has associated_method =>
    ( is         => 'rw',
      isa        => 'Maybe[Moose::Meta::Method]',
      init_arg   => undef,
      lazy_build => 1,
    );

has allows_undef =>
    ( is         => 'ro',
      isa        => 'Bool',
      lazy_build => 1,
    );

has handles =>
    ( is  => 'ro',
      # just gets passed on for attribute creation
      isa => 'Any',
    );


sub _build_associated_attribute
{
    my $self = shift;

    return unless $self->is_cached();

    # It'd be nice to set isa to the actual foreign class, but we may
    # not be able to map a table to a class yet, since that depends on
    # the related class being loaded. It doesn't really matter, since
    # this accessor is read-only, so there's really no typing issue to
    # deal with.
    my $type = 'Fey::Object::Table';
    $type = "Maybe[$type]" if $self->allows_undef();

    my %attr_p =
        ( is        => 'rw',
          isa       => $type,
          lazy      => 1,
          default   => $self->_make_subref(),
          writer    => q{_set_} . $self->name(),
          predicate => q{_has_} . $self->name(),
          clearer   => q{_clear_} . $self->name(),
        );

    $attr_p{handles} = $self->handles()
        if $self->handles();

    return
        $self->associated_class()->attribute_metaclass()
             ->new( $self->name(),
                    %attr_p,
                  );
}

sub _build_is_cached { 1 }

sub _build_associated_method
{
    my $self = shift;

    return if $self->is_cached();

    return
        $self->associated_class()->method_metaclass()
             ->wrap( name         => $self->name(),
                     package_name => $self->associated_class()->name(),
                     body         => $self->_make_subref(),
                   );
}

sub attach_to_class
{
    my $self  = shift;
    my $class = shift;

    $self->_set_associated_class($class);

    if ( $self->is_cached() )
    {
        $class->add_attribute( $self->associated_attribute() );
    }
    else
    {
        $class->add_method( $self->name() => $self->associated_method() );
    }
}

sub detach_from_class
{
    my $self  = shift;

    return unless $self->associated_class();

    if ( $self->is_cached() )
    {
        $self->associated_class->remove_attribute( $self->name() );
    }
    else
    {
        $self->associated_class->remove_method( $self->name() );
    }

    $self->_clear_associated_class();
}


no Moose;

__PACKAGE__->meta()->make_immutable();

1;

__END__

=head1 NAME

Fey::Meta::HasOne - A parent for has-one metaclasses

=head1 DESCRIPTION

This class exists to provide a common parent for the two has-one
metaclasses, L<Fey::Meta::HasOne::ViaFK> and
L<Fey::Meta::HasOne::ViaSelect>.

=head1 CONSTRUCTOR OPTIONS

This class accepts the following constructor options:

=over 4

=item * handles

This will simply be passed on when an attribute for this has-one
relationship is created. Note that this is ignore if C<is_cached> is
false.

=item * allows_undef

A boolean indicating whether or not the relationship's value can be
C<undef>.

=item * is_cached

Defaults to true for this class.

=back

=head1 METHODS

This provides the following methods:

=head2 $ho->name()

Corresponds to the value passed to the constructor.

=head2 $ho->table()

Corresponds to the value passed to the constructor.

=head2 $ho->foreign_table()

Corresponds to the value passed to the constructor.

=head2 $ho->is_cached()

Corresponds to the value passed to the constructor, or the calculated
default.

=head2 $ho->allows_undef()

Corresponds to the value passed to the constructor.

=head2 $ho->handles()

Corresponds to the value passed to the constructor.

=head2 $ho->attach_to_class($class)

This method takes a F<Fey::Meta::Class::Table> object and attaches the
relationship to the associated class. If this relationship is cached,
it creates a new attribute, otherwise it creates a new method.

The method/attribute returns an object belonging to the class
associated with the foreign table. It can return C<undef> if
C<allows_undef> is true.

=head2 $ho->associated_class()

The class associated with this object. This is undefined until C<<
$ho->attach_to_class() >> is called.

=head2 $ho->associated_attribute()

Returns the attribute associated with this object, if any.

=head2 $ho->associated_method()

Returns the method associated with this object, if any.

=head2 $ho->detach_from_class()

If this object was attached to a class, it removes any attribute or
method it made, and unsets the C<associated_class>.

=head1 AUTHOR

Dave Rolsky, <autarch@urth.org>

=head1 BUGS

See L<Fey::ORM> for details.

=head1 COPYRIGHT & LICENSE

Copyright 2006-2009 Dave Rolsky, All Rights Reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. The full text of the license
can be found in the LICENSE file included with this module.

=cut