use strict;
use warnings;

package Clownfish::Type::Object;
use base qw( Clownfish::Type );
use Clownfish::Parcel;
use Clownfish::Util qw( verify_args );
use Scalar::Util qw( blessed );
use Carp;

our %new_PARAMS = (
    const       => undef,
    specifier   => undef,
    indirection => 1,
    parcel      => undef,
    incremented => 0,
    decremented => 0,
    nullable    => 0,
);

sub new {
    my ( $either, %args ) = @_;
    verify_args( \%new_PARAMS, %args ) or confess $@;
    my $incremented = delete $args{incremented} || 0;
    my $decremented = delete $args{decremented} || 0;
    my $nullable    = delete $args{nullable}    || 0;
    my $indirection = delete $args{indirection};
    $indirection = 1 unless defined $indirection;
    my $self = $either->SUPER::new(%args);
    $self->{incremented} = $incremented;
    $self->{decremented} = $decremented;
    $self->{indirection} = $indirection;
    $self->{nullable}    = $nullable;
    $self->{parcel} ||= Clownfish::Parcel->default_parcel;
    my $prefix = $self->{parcel}->get_prefix;

    # Validate params.
    confess("Indirection must be 1") unless $self->{indirection} == 1;
    confess("Can't be both incremented and decremented")
        if ( $incremented && $decremented );
    confess("Missing required param 'specifier'")
        unless defined $self->{specifier};
    confess("Illegal specifier: '$self->{specifier}")
        unless $self->{specifier}
            =~ /^(?:$prefix)?[A-Z][A-Za-z0-9]*[a-z]+[A-Za-z0-9]*(?!\w)/;

    # Add $prefix if necessary.
    $self->{specifier} = $prefix . $self->{specifier}
        unless $self->{specifier} =~ /^$prefix/;

    # Cache C representation.
    my $string = $self->const ? 'const ' : '';
    $string .= "$self->{specifier}*";
    $self->set_c_string($string);

    # Cache boolean indicating whether this type is a string type.
    $self->{is_string_type} = $self->{specifier} =~ /CharBuf/ ? 1 : 0;

    return $self;
}

sub is_object      {1}
sub incremented    { shift->{incremented} }
sub decremented    { shift->{decremented} }
sub is_string_type { shift->{is_string_type} }

sub set_nullable { $_[0]->{nullable} = $_[1] }

sub similar {
    my ( $self, $other ) = @_;
    for (qw( const incremented decremented nullable )) {
        return 0 if ( $self->{$_} xor $other->{$_} );
    }
    return 1;
}

sub equals {
    my ( $self, $other ) = @_;
    return 0 unless $self->similar($other);
    return 0 unless $self->{specifier} eq $other->{specifier};
    return 1;
}

1;

__END__

=head1 NAME

Clownfish::Type::Clownfish - An object Type.

=head1 DESCRIPTION

Clownfish::Type::Object supports object types for all classes.  The type's 
C<specifier> must match the last component of the class name -- i.e. for the
class "Crustacean::Lobster" it must be "Lobster".

=head1 METHODS

=head2 new

    my $type = Clownfish::Type::Object->new(
        specifier   => "Lobster",       # required
        parcel      => "Crustacean",    # default: the default Parcel.
        const       => undef,           # default undef
        indirection => 1,               # default 1
        incremented => 1,               # default 0
        decremented => 0,               # default 0
        nullable    => 1,               # default 0
    );

=over

=item * B<specifier> - Required.  Must follow the rules for
L<Clownfish::Class> class name components.

=item * B<parcel> - A L<Clownfish::Parcel> or a parcel name.

=item * B<const> - Should be true if the Type is const.  Note that this refers
to the object itself and not the pointer.

=item * B<indirection> - Level of indirection.  Must be 1 if supplied.

=item * B<incremented> - Indicate whether the caller must take responsibility
for an added refcount.

=item * B<decremented> - Indicate whether the caller must account for
for a refcount decrement.

=item * B<nullable> - Indicate whether the object specified by this type may
be NULL.

=back

The Parcel's prefix will be prepended to the specifier by new().

=head2 incremented

Returns true if the Type is incremented.

=head2 decremented

Returns true if the Type is decremented.

=head2 similar

    do_stuff() if $type->similar($other_type);

Weak checking of type which allows for covariant return types.

=head1 COPYRIGHT AND LICENSE

Copyright 2008-2010 Marvin Humphrey

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut