view release on metacpan or  search on metacpan

lib/FindApp/Object/Class.pm  view on Meta::CPAN

package FindApp::Object::Class;

use v5.10;
use strict;
use warnings;
use mro "c3";

use FindApp::Vars qw(:all);
use FindApp::Utils qw(:all);

use namespace::clean;

sub class($) {
    my $self = &myself;
    return blessed($self);
}

# postfix scalar operator
sub object($) {
    my $self = &myself;
    return $self;
}

################################################################
# Our three constructors: new, old, renew.
################################################################

# Make and return a new singleton, copying the old one to it.
# This is so subclasses can stick their own singleton into our
# slot without knowing who else put what there.
sub renew { &ENTER_TRACE;
    my $self = shift;
    my $new  = $self->new;
    my $old  = $self->old;
    $new->copy($old);
    $self->old($new);
}

## UNITCHECK { __PACKAGE__->renew }  # stash new singleton

# Return singleton, making one as needed.
# Stash the argument as the new singleton.
sub old { &ENTER_TRACE;
    my($self, $new) = @_;
    state $Singleton;
    $Singleton = $new        if $new;
    return $Singleton ||= $self->new;
}

# Allocate, initialize, and return a new instance
# of the invocant's class, or this one if none.
# As an instance method, copy the old instance's
# values to the new one.  Run any params separately.
# Subclasses should override init and copy methods
# but invoke the c3 next::method to get these ones
# to run, too.
sub new { &ENTER_TRACE;
    my $old = shift;
    my $class = blessed($old) || $old || __PACKAGE__;
    my $new   = bless { }, $class;
    $new->init;
    $new->copy($old)    if blessed($old);
    $new->params(@_)    if @_;
    return $new;
}

################################################################
# Our three subconstructors: init, copy, params.
################################################################

# The job of an init() method is to populate its
# object's attributes.  The base object has only 3:
# origin, default_origin, and groups.  Subclasses
# with their own attributes should override this
# but call their c3 next::method first to eventually
# get back to this one.
sub init { &ENTER_TRACE;
    my $self = shift;

    $self->reset_origin;
    $self->default_origin("script");
    $self->allocate_groups;

    $self->group("root")->allowed->add(".");
    for my $root ($self->rootdir->object) {
        $root->allowed(".");
        $root->wanted("lib/");
    }

    for my $group ($self->subgroups) {
        $group->allowed($group->name);
    }

    $self->bindirs->allowed->add( glob "{script,util}{,s}" );
    
    $self->maybe::next::method;
}

# The job of a copy() method is to mass-copy all the