package Cpanel::Class::Meta::Class;

use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed', 'reftype', 'isweak', 'weaken';

use Cpanel::Class::Meta::Attribute;
use Cpanel::Class::Meta::Method;
use Cpanel::Class::Meta::Method::Wrapped;

use base 'Cpanel::Class::Meta::Module';

our $VERSION = '1.0.5';

my %_CLASSES = ();

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

    confess "Argument to new must be hash reference" if reftype $args ne 'HASH';
    confess 'package is required argument' if !exists $args->{'package'} and !$args->{'package'};

    my $self = {
        '$!package'             => $args->{'package'},
        '$!method_metaclass'    => $args->{'method_metaclass'} || 'Cpanel::Class::Meta::Method',
        '$!attribute_metaclass' => $args->{'attribute_metaclass'} || 'Cpanel::Class::Meta::Attribute',
        '%!methods'             => {},
        '%!attributes'          => {},
    };

    return bless $self, $class;
}

# Class method
sub initialize {
    my ( $class, $pkg ) = @_;
    $_CLASSES{$pkg} ||= Cpanel::Class::Meta::Class->new( { package => $pkg } );
    return $_CLASSES{$pkg};
}

sub method_metaclass    { $_[0]->{'$!method_metaclass'} }
sub attribute_metaclass { $_[0]->{'$!attribute_metaclass'} }

sub get_attributes_map {
    my ($self) = @_;
    return $self->{'%!attributes'};
}

sub add_attribute {
    my ( $self, $attr, %desc ) = @_;

    $desc{'reader'}   ||= $attr;
    $desc{'writer'}   ||= $attr;
    $desc{'init_arg'} ||= $attr;

    my $attribute = $self->attribute_metaclass->new( { package => $self->name, attr => $attr, %desc } );
    $attribute->attach_to_class($self);
    $self->remove_attribute( $attribute->attr ) if $self->has_attribute( $attribute->attr );

    $attribute->build_attribute($attr);
    $self->get_attributes_map->{$attr} = $attribute;
}

sub get_attribute {
    my ( $self, $name ) = @_;
    $self->get_attributes_map->{$name};
}

sub has_attribute {
    my ( $self, $attribute_name ) = @_;
    ( defined $attribute_name && $attribute_name )
      || confess "You must define an attribute name";
    exists $self->get_attributes_map->{$attribute_name} ? 1 : 0;
}

sub remove_attribute {
    my ( $self, $attribute_name ) = @_;
    ( defined $attribute_name && $attribute_name )
      || confess "You must define an attribute name";
    my $removed_attribute = $self->get_attribute_map->{$attribute_name};
    return unless defined $removed_attribute;
    delete $self->get_attribute_map->{$attribute_name};
    $removed_attribute->remove_accessors();
    $removed_attribute->detach_from_class();
    return $removed_attribute;
}

sub construct_instance {
    my ($self) = @_;
    bless {}, $self->name;
}

sub new_object {
    my ( $self, $args ) = @_;
    my $instance = $self->construct_instance;

    foreach my $pkg ( reverse $self->linearized_isa ) {
        foreach my $attribute_name ( keys %{ $pkg->meta->get_attributes_map } ) {
            my $attribute = $pkg->meta->get_attribute($attribute_name);

            #Init_args
            if ( $attribute->has_init_arg and exists $args->{ $attribute->init_arg } ) {
                $instance->{ $attribute->attr } = $args->{ $attribute->init_arg };
            }

            # Defaults
            elsif ( $attribute->has_default and !$attribute->is_lazy and ( reftype $attribute->default || '' ) eq 'CODE' ) {
                $instance->{ $attribute->attr } = $attribute->default->($instance);
            }
            elsif ( $attribute->has_default and !$attribute->is_lazy ) {
                $instance->{ $attribute->attr } = $attribute->default;
            }

            # Triggers
            if ( $attribute->has_trigger and exists $instance->{ $attribute->attr } ) {
                $attribute->trigger->( $instance, $instance->{ $attribute->attr }, $attribute );
            }

            # WeakRefs
            if ( $attribute->is_weak and $instance->{ $attribute->attr } and !isweak( $instance->{ $attribute->attr } ) ) {
                weaken( $instance->{ $attribute->attr } );
            }

            if ( $attribute->is_required and !defined $instance->{ $attribute->attr } ) {
                my $name = $attribute->attr;
                confess "attribute \"$name\" is required to be set";
            }
        }
    }
    return $instance;
}

sub get_method_map {
    my ($self) = @_;

    if ( defined $self->{'$!_package_cache_flag'}
        && $self->{'$!_package_cache_flag'} == Cpanel::Class::check_package_cache_flag( $self->name ) ) {
        return $self->{'%!methods'};
    }

    my $map = $self->{'%!methods'};

    my $class_name       = $self->name;
    my $method_metaclass = $self->method_metaclass;

    foreach my $symbol ( $self->list_all_package_symbols('CODE') ) {
        my $code = $self->get_package_symbol( '&' . $symbol );

        next
          if exists $map->{$symbol}
              && defined $map->{$symbol}
              && blessed( $map->{$symbol} )
              && $map->{$symbol}->isa('Cpanel::Class::Meta::Method')
              && $map->{$symbol}->body == $code;

        my ( $pkg, $name ) = Cpanel::Class::get_code_info($code);
        next
          if ( $pkg || '' ) ne $class_name;

        $map->{$symbol} = $method_metaclass->wrap($code);
    }
    return $self->{'%!methods'};
}

sub has_method {
    my ( $self, $method_name ) = @_;
    ( defined $method_name && $method_name )
      || confess "You must define a method name";

    return 0 unless exists $self->get_method_map->{$method_name};
    return 1;
}

sub add_method {
    my ( $self, $name, $code ) = @_;

    confess 'No name passed' if !$name;

    my $body;
    if ( blessed($code) ) {
        $body = $code->body;
    }
    else {
        $body = $code;
        ( 'CODE' eq ( reftype($body) || '' ) )
          || confess "Your code block must be a CODE reference";
        $code = $self->method_metaclass->wrap($body);
    }

    $self->get_method_map->{$name} = $code;
    $self->add_package_symbol( '&' . $name, $body );
    $self->update_package_cache_flag;
}

sub get_method_list {
    my ($self) = @_;
    keys %{ $self->get_method_map };
}

sub compute_all_applicable_methods {
    my $self = shift;
    my ( @methods, %seen_method );
    foreach my $class ( $self->linearized_isa ) {

        # fetch the meta-class ...
        my $meta = $self->initialize($class);
        foreach my $method_name ( $meta->get_method_list() ) {
            next if exists $seen_method{$method_name};
            $seen_method{$method_name}++;
            push @methods => {
                name  => $method_name,
                class => $class,
                code  => $meta->get_method($method_name)
            };
        }
    }
    return @methods;
}

sub get_method {
    my ( $self, $method_name ) = @_;
    ( defined $method_name && $method_name )
      || confess "You must define a method name";
    return $self->get_method_map->{$method_name};
}

sub find_method_by_name {
    my ( $self, $method_name ) = @_;
    ( defined $method_name && $method_name )
      || confess "You must define a method name to find";
    foreach my $class ( $self->linearized_isa ) {

        # fetch the meta-class ...
        my $meta = $self->initialize($class);
        return $meta->get_method($method_name)
          if $meta->has_method($method_name);
    }
    return;
}

sub find_all_methods_by_name {
    my ( $self, $method_name ) = @_;
    ( defined $method_name && $method_name )
      || confess "You must define a method name to find";
    my @methods;
    foreach my $class ( $self->linearized_isa ) {

        # fetch the meta-class ...
        my $meta = $self->initialize($class);
        push @methods => {
            name  => $method_name,
            class => $class,
            code  => $meta->get_method($method_name)
        } if $meta->has_method($method_name);
    }
    return @methods;
}

sub find_next_method_by_name {
    my ( $self, $method_name ) = @_;
    ( defined $method_name && $method_name )
      || confess "You must define a method name to find";
    my @cpl = $self->linearized_isa;
    shift @cpl;    # discard ourselves
    foreach my $class (@cpl) {

        # fetch the meta-class ...
        my $meta = $self->initialize($class);
        return $meta->get_method($method_name)
          if $meta->has_method($method_name);
    }
    return;
}

sub remove_method {
    my ( $self, $method_name ) = @_;
    ( defined $method_name && $method_name )
      || confess "You must define a method name";

    my $removed_method = delete $self->get_method_map->{$method_name};

    $self->remove_package_symbol( '&' . $method_name );

    $self->update_package_cache_flag;

    return $removed_method;
}

sub superclasses {
    my $self = shift;
    if (@_) {
        my @supers = @_;
        @{ $self->get_package_symbol('@ISA') } = @supers;
    }
    @{ $self->get_package_symbol('@ISA') };
}

sub class_precedence_list {
    my ($self) = @_;
    { ( $self->name || return )->isa('This is a test for circular inheritance') }

    ( $self->name, map { $self->initialize($_)->class_precedence_list() } $self->superclasses() );
}

sub linearized_isa {
    my ($self) = @_;
    my %seen;
    grep { !( $seen{$_}++ ) } $self->class_precedence_list;
}

sub subclasses {
    my ($self) = @_;

    my $super_class = $self->name;
    my @derived_classes;

    my $find_derived_classes;
    $find_derived_classes = sub {
        my ($outer_class) = @_;

        my $symbol_table_hashref = do { no strict 'refs'; \%{"${outer_class}::"} };

      SYMBOL:
        for my $symbol ( keys %$symbol_table_hashref ) {
            next SYMBOL if $symbol !~ /\A (\w+):: \z/x;
            my $inner_class = $1;

            next SYMBOL if $inner_class eq 'SUPER';    # skip '*::SUPER'

            my $class =
              $outer_class
              ? "${outer_class}::$inner_class"
              : $inner_class;

            if ( $class->isa($super_class) and $class ne $super_class ) {
                push @derived_classes, $class;
            }

            next SYMBOL if $class eq 'main';           # skip 'main::*'

            $find_derived_classes->($class);
        }
    };

    my $root_class = q{};
    $find_derived_classes->($root_class);

    undef $find_derived_classes;

    @derived_classes = sort { $a->isa($b) ? 1 : $b->isa($a) ? -1 : 0 } @derived_classes;
    return @derived_classes;
}

{
    my $fetch_and_prepare_method = sub {
        my ( $self, $method_name ) = @_;

        # fetch it locally
        my $method = $self->get_method($method_name);

        # if we dont have local ...
        unless ($method) {

            # try to find the next method
            $method = $self->find_next_method_by_name($method_name);

            # die if it does not exist
            ( defined $method )
              || confess "The method '$method_name' is not found in the inheritance hierarchy for class " . $self->name;

            # and now make sure to wrap it
            # even if it is already wrapped
            # because we need a new sub ref
            $method = Cpanel::Class::Meta::Method::Wrapped->wrap($method);
        }
        else {

            # now make sure we wrap it properly
            $method = Cpanel::Class::Meta::Method::Wrapped->wrap($method)
              unless $method->isa('Cpanel::Class::Meta::Method::Wrapped');
        }
        $self->add_method( $method_name => $method );
        return $method;
    };

    sub add_before_method_modifier {
        my ( $self, $method_name, $method_modifier ) = @_;
        ( defined $method_name && $method_name )
          || confess "You must pass in a method name";
        my $method = $fetch_and_prepare_method->( $self, $method_name );
        $method->add_before_modifier($method_modifier);
    }

    sub add_after_method_modifier {
        my ( $self, $method_name, $method_modifier ) = @_;
        ( defined $method_name && $method_name )
          || confess "You must pass in a method name";
        my $method = $fetch_and_prepare_method->( $self, $method_name );
        no strict 'refs';
        $method->add_after_modifier($method_modifier);
    }

    sub add_around_method_modifier {
        my ( $self, $method_name, $method_modifier ) = @_;
        ( defined $method_name && $method_name )
          || confess "You must pass in a method name";
        my $method = $fetch_and_prepare_method->( $self, $method_name );
        $method->add_around_modifier($method_modifier);
    }
}

sub reset_package_cache_flag { (shift)->{'$!_package_cache_flag'} = undef }

sub update_package_cache_flag {
    my ($self) = @_;
    ($self)->{'$!_package_cache_flag'} = Cpanel::Class::check_package_cache_flag( $self->name );
}

1;