view release on metacpan or  search on metacpan

lib/OOP/Perlish/Class.pm  view on Meta::CPAN

    }

    ############################################################################################
    ## obtain the names and references to every accessor in our inheritance
    ############################################################################################
    sub ____inherit_accessors(@)
    {
        my ($self) = @_;

        ### Protect overloaded accessors by identifying those in our top-level namespace
        ### This cascaded up through the inheritance tree
        my %top_accessors = ();
        if( scalar( keys %{ $self->____OOP_PERLISH_CLASS_ACCESSORS() } ) ) {
            # XXX: Hash slice assignment
            @top_accessors{ keys %{ $self->____OOP_PERLISH_CLASS_ACCESSORS() } } =
              ( (1) x ( ( scalar keys %{ $self->____OOP_PERLISH_CLASS_ACCESSORS() } ) ) );
        }

        ### Assimilate inherited accessor references
        #for my $parent_class ( @{ $self->{____CLASS_ISA} } ) {
        for my $parent_class ( $self->_all_isa() ) {

lib/OOP/Perlish/Class.pm  view on Meta::CPAN

        if( !defined( $self->{____oop_perlish_class_required_fields} ) ) {
            my %required_fields = ();

            ### Obtain REQUIRED_FIELDS static from derived class. Assign it via hashslice
            @required_fields{ @{ $class->____OOP_PERLISH_CLASS_REQUIRED_FIELDS() } } = @{ $class->____OOP_PERLISH_CLASS_REQUIRED_FIELDS() };

            while( my ( $name, $field ) = each %{ $self->____OOP_PERLISH_CLASS_ACCESSORS() } ) {
                $required_fields{$name} = $name if( $field->required() );
            }

            # FIXME: Does not cascade beyond @ISA, should traverse inheritance tree and ensure that all required fields are
            # provided for any hiararchy. ... does cascade via new, but only to ancesters who conform with us. unsure how to fix
            #for my $parent_class ( @{ $self->{____CLASS_ISA} } ) {
            for my $parent_class ( $self->_all_isa() ) {
                if( bless( {}, $parent_class )->can('____OOP_PERLISH_CLASS_REQUIRED_FIELDS') ) {
                    @required_fields{ @{ $parent_class->____OOP_PERLISH_CLASS_REQUIRED_FIELDS() } } =
                      @{ $parent_class->____OOP_PERLISH_CLASS_REQUIRED_FIELDS() };
                }
            }

            @{ $self->{____oop_perlish_class_required_fields} } = keys %required_fields;
        }

lib/OOP/Perlish/Class.pm  view on Meta::CPAN

        my ($self) = @_;

        ### XXX: Hash slice assignment
        my %required_fields_lut;
        @required_fields_lut{ $self->____identify_required_fields() } = $self->____identify_required_fields();

        my %opts =
          map { ( $_ => $self->{____oop_perlish_class_opts}->{$_} ) }
          grep { !exists( $required_fields_lut{$_} ) } keys %{ $self->{____oop_perlish_class_opts} };

        # prepopulate accessors so that calls that cascade will have values assigned
        # Set everything by accessor that we ->can()
        while( my ( $method, $value ) = each %opts ) {
            $self->$method($value) if( $self->can($method) );
        }

        $self->____validate_defaults();

        # reset all accessors for actually set values, re-running cascades where applicable...
        # there must be a better way, but this works
        while( my ( $method, $value ) = each %opts ) {
            $self->$method($value) if( $self->can($method) );
        }
        return;
    }

    ############################################################################################
    ## verify all default values are valid for the class
    ############################################################################################