File Coverage

blib/lib/Venus/Core/Role.pm

Criterion	Covered	Total	%
statement	41	67	61.1
branch			n/a
condition			n/a
subroutine	13	17	76.4
pod	2	5	40.0
total	56	89	62.9

package Venus::Core::Role;

use 5.018;

use strict;
use warnings;

no warnings 'once';

use base 'Venus::Core';

# METHODS

sub BUILD {
  my ($self, @data) = @_;

  no strict 'refs';

  my @roles = @{$self->META->roles};

  for my $action (grep defined, map *{"${_}::BUILD"}{"CODE"}, @roles) {
    $self->$action(@data);
  }

  return $self;
}

sub DESTROY {
  my ($self, @data) = @_;

  no strict 'refs';

  my @mixins = @{$self->META->mixins};

  for my $action (grep defined, map *{"${_}::DESTROY"}{"CODE"}, @mixins) {
    $self->$action(@data);
  }

  my @roles = @{$self->META->roles};

  for my $action (grep defined, map *{"${_}::DESTROY"}{"CODE"}, @roles) {
    $self->$action(@data);
  }

  return $self;
}

sub EXPORT {
  my ($self, $into) = @_;

  return [];
}

sub IMPORT {
  my ($self, $into) = @_;

  no strict 'refs';
  no warnings 'redefine';

  for my $name (grep !*{"${into}::${_}"}{"CODE"}, @{$self->EXPORT($into)}) {
    *{"${into}::${name}"} = \&{"@{[$self->NAME]}::${name}"};
  }

  return $self;
}

sub does {
  my ($self, @args) = @_;

  return $self->DOES(@args);
}

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

  require Venus;

  @_ = ("${self} cannot be used via the \"use\" declaration");

  goto \&Venus::fault;
}

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

  return $self->META;
}

sub unimport {
  my ($self, @args) = @_;

  my $target = caller;

  return $self->UNIMPORT($target, @args);
}

1;



=head1 NAME

Venus::Core::Role - Role Base Class

=cut

=head1 ABSTRACT

Role Base Class for Perl 5

=cut

=head1 SYNOPSIS

  package Person;

  use base 'Venus::Core::Role';

  package User;

  use base 'Venus::Core::Class';

  package main;

  my $user = User->ROLE('Person')->new(
    fname => 'Elliot',
    lname => 'Alderson',
  );

  # bless({fname => 'Elliot', lname => 'Alderson'}, 'User')

=cut

=head1 DESCRIPTION

This package provides a role base class with role building and object
construction lifecycle hooks.

=cut

=head1 INHERITS

This package inherits behaviors from:

L

=cut

=head1 METHODS

This package provides the following methods:

=cut

=head2 does

  does(Str $name) (Bool)

The does method returns true if the object is composed of the role provided.

I>

=over 4

=item does example 1

  package Employee;

  use base 'Venus::Core::Role';

  Employee->ROLE('Person');

  package main;

  my $user = User->ROLE('Employee')->new(
    fname => 'Elliot',
    lname => 'Alderson',
  );

  my $does = Employee->does('Person');

  # 1

=back

=cut

=head2 import

  import(Any @args) (Any)

The import method throws a fatal exception whenever the L
declaration is used with roles as they are meant to be consumed via the C
or C keyword functions.

I>

=over 4

=item import example 1

  package main;

  use Person;

  # Exception! (isa Venus::Fault)

=back

=cut

=head2 meta

  meta() (Meta)

The meta method returns a L objects which describes the package's
configuration.

I>

=over 4

=item meta example 1

  package main;

  my $user = User->ROLE('Person')->new(
    fname => 'Elliot',
    lname => 'Alderson',
  );

  my $meta = Person->meta;

  # bless({...}, 'Venus::Meta')

=back

=cut

=head2 unimport

  unimport(Any @args) (Any)

The unimport method invokes the C lifecycle hook and is invoked
whenever the L declaration is used.

I>

=over 4

=item unimport example 1

  package main;

  no User;

  # ()

=back

=cut

=head1 AUTHORS

Awncorp, C

=cut

=head1 LICENSE

Copyright (C) 2000, Al Newkirk.

This program is free software, you can redistribute it and/or modify it under
the terms of the Apache license version 2.0.

=cut