use strict;
use warnings;

package Clownfish::Symbol;
use Clownfish::Parcel;
use Clownfish::Util qw( a_isa_b );
use Scalar::Util qw( blessed );
use Carp;

my %new_PARAMS = (
    parcel      => undef,
    exposure    => undef,
    class_name  => undef,
    class_cnick => undef,
    micro_sym   => undef,
);

my $struct_regex     = qr/[A-Z]+[A-Z0-9]*[a-z]+[A-Za-z0-9]*/;
my $class_name_regex = qr/^$struct_regex(::$struct_regex)*$/;

sub new {
    my ( $either, %args ) = @_;

    # Acquire a Parcel.
    my $parcel = $args{parcel};
    if ( !defined $parcel ) {
        $parcel = Clownfish::Parcel->default_parcel;
    }
    elsif ( blessed($parcel) ) {
        confess("Not a Clownfish::Parcel")
            unless $parcel->isa('Clownfish::Parcel');
    }
    else {
        $parcel = Clownfish::Parcel->singleton( name => $args{parcel} );
    }

    # Create the object.
    my $self = bless { %new_PARAMS, %args, parcel => $parcel },
        ref($either) || $either;

    # Validate micro_sym.
    confess "micro_sym is required" unless $self->{micro_sym};
    confess("Invalid micro_sym: '$self->{micro_sym}'")
        unless $self->{micro_sym} =~ /^[A-Za-z_][A-Za-z0-9_]*$/;

    # Validate exposure.
    confess("Invalid value for 'exposure': $self->{exposure}")
        unless $self->{exposure} =~ /^(?:public|parcel|private|local)$/;

    # Validate class name, validate or derive class_cnick.
    if ( defined $self->{class_name} ) {
        confess("Invalid class name: $self->{class_name}")
            unless $self->{class_name} =~ $class_name_regex;
        if ( !defined $self->{class_cnick} ) {
            $self->{class_name} =~ /(\w+)$/;
            $self->{class_cnick} = $1;
        }
        confess("Invalid class_cnick: $self->{class_cnick}")
            unless $self->{class_cnick} =~ /^[A-Z]+[A-Za-z0-9]*$/;
    }
    elsif ( defined $self->{class_cnick} ) {
        # Sanity check class_cnick without class_name.
        confess("Can't supply class_cnick without class_name");
    }

    return $self;
}

sub get_parcel      { shift->{parcel} }
sub get_class_name  { shift->{class_name} }
sub get_class_cnick { shift->{class_cnick} }
sub micro_sym       { shift->{micro_sym} }

sub get_prefix { shift->{parcel}->get_prefix; }
sub get_Prefix { shift->{parcel}->get_Prefix; }
sub get_PREFIX { shift->{parcel}->get_PREFIX; }

sub public  { shift->{exposure} eq 'public' }
sub private { shift->{exposure} eq 'private' }
sub parcel  { shift->{exposure} eq 'parcel' }
sub local   { shift->{exposure} eq 'local' }

sub full_sym {
    my $self   = shift;
    my $prefix = $self->get_prefix;
    return "$prefix$self->{class_cnick}_$self->{micro_sym}";
}

sub short_sym {
    my $self = shift;
    return "$self->{class_cnick}_$self->{micro_sym}";
}

sub equals {
    my ( $self, $other ) = @_;
    return 0 unless a_isa_b( $other, __PACKAGE__ );
    return 0 unless $self->{micro_sym} eq $other->{micro_sym};
    return 0 unless $self->{parcel}->equals( $other->{parcel} );
    if ( defined $self->{exposure} ) {
        return 0 unless defined $other->{exposure};
        return 0 unless $self->{exposure} eq $other->{exposure};
    }
    else {
        return 0 if defined $other->{exposure};
    }
    if ( defined $self->{class_name} ) {
        return 0 unless defined $other->{class_name};
        return 0 unless $self->{class_name} eq $other->{class_name};
    }
    else {
        return 0 if defined $other->{class_name};
    }
    return 1;
}

1;

__END__

__POD__

=head1 NAME

Clownfish::Symbol - Abstract base class for Clownfish symbols.

=head1 DESCRIPTION

Clownfish::Symbol serves as an abstract parent class for entities which may
live in the global namespace, such as classes, functions, methods, and
variables.

=head1 CONSTRUCTOR

    my $symbol = MySymbol->new(
        parcel      => 'Crustacean',             # default: special
        exposure    => 'parcel',                 # required
        class_name  => 'Crustacean::Lobster',    # default: undef
        class_cnick => undef,                    # default: special
        micro_sym   => 'average_lifespan',       # required
    );

=over

=item * B<parcel> - A Clownfish::Parcel, or a string that can be used to
create/retrieve one.  If not supplied, will be assigned to the default Parcel.

=item * B<exposure> - The scope in which the symbol is exposed.  Must be
'public', 'parcel', 'private', or 'local'.

=item * B<class_name> - A optional class name, consisting of one or more
components separated by "::".  Each component must start with a capital
letter, contain at least one lower-case letter, and consist entirely of the
characters [A-Za-z0-9].

=item * B<class_cnick> - The C nickname associated with the supplied class
name.  If not supplied, will be derived if possible from C<class_name> by
extracting the last class name component.

=item * B<micro_sym> - The local identifier for the symbol.

=back

=head1 OBJECT METHODS

=head2 get_parcel get_class_name get_class_cnick micro_sym

Getters.

=head2 get_prefix get_Prefix get_PREFIX

Get a string prefix, delegating to C<parcel> member var.

=head2 public parcel private local

    if    ( $sym->public ) { do_x() }
    elsif ( $sym->parcel ) { do_y() }

Indicate whether the symbol matches a given access level.

=head2 equals

    do_stuff() if $sym->equals($other_sym);

Returns true if the symbols are "equal", false otherwise.

=head2 short_sym

    # e.g. "Lobster_average_lifespan"
    print $symbol->short_sym;

Returns the C representation for the symbol minus the parcel's prefix.

=head2 full_sym

    # e.g. "crust_Lobster_average_lifespan"
    print $symbol->full_sym;

Returns the fully qualified C representation for the symbol.

=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