librole-commons-perl 0.101-2 / usr / share / perl5 / Role / Commons.pm

package Role::Commons;

use 5.008;
use strict;
use warnings;
use Carp qw[ carp croak ];
use Class::Load qw[ load_class ];
use Moo::Role qw[];
use Scalar::Does qw[ does ARRAY HASH ];

BEGIN {
	$Role::Commons::AUTHORITY = 'cpan:TOBYINK';
	$Role::Commons::VERSION   = '0.101';
}

my @ALL = qw(
	Authority
	ObjectID
	Tap
);

sub parse_arguments
{
	my $class = shift;
	
	# Translate "-all".
	my $all = 0;
	my @args = grep { /^\-all$/i ? do { $all++; 0 } : 1 } @_;
	unshift @args, @ALL if $all;
	
	my %roles;
	my %options;
	while (my $name = shift @args)
	{
		my $details;
		if ($name =~ /^-/ or ref $args[0])
			{ $details = shift @args }
		
		if ($name =~ /^\-(.+)$/i)
			{ $options{ lc $1 } = $details }
		else
			{ $roles{ $name } = $details }
	}
	
	carp "Role::Commons - no roles specified"
		if keys %options && !keys %roles;
	
	return(\%roles, \%options);
}

sub import
{
	my $class  = shift;
	my ($roles, $options) = $class->parse_arguments(@_);
	$options->{into} = caller unless exists $options->{into};
	
	foreach my $role (sort keys %$roles)
	{
		load_class( join q[::], $class, $role );
	}
	
	'Moo::Role'->apply_roles_to_package(
		$options->{into},
		map { join q[::], $class, $_ } sort keys %$roles,
	);
	
	foreach my $role (sort keys %$roles)
	{
		my $role_pkg = join q[::], $class, $role;
		my $details  = $roles->{$role};
		my $setup_method = do {
			no strict 'refs';
			${"$role_pkg\::setup_for_class"};
		} or next;
		$role_pkg->$setup_method(
			$options->{into},
			does($details, HASH)
				? %$details
				: ( does($details, ARRAY) ? @$details : (option => $details) ),
		);
	}
}

sub apply_roles_to_object
{
	my $class  = shift unless blessed($_[0]);
	my $object = shift;
	my ($roles, $options) = $class->parse_arguments(@_);
	
	foreach my $role (sort keys %$roles)
	{
		load_class( join q[::], $class, $role );
	}
	
	'Moo::Role'->apply_roles_to_object(
		$object,
		map { join q[::], $class, $_ } sort keys %$roles,
	);
	
	foreach my $role (sort keys %$roles)
	{
		my $role_pkg = join q[::], $class, $role;
		my $details  = $roles->{$role};
		my $setup_method = do {
			no strict 'refs';
			${"$role_pkg\::setup_for_class"};
		} || sub { 0 };
		$role_pkg->$setup_method(
			ref($object),
			does($details, HASH)
				? %$details
				: ( does($details, ARRAY) ? @$details : (option => $details) ),
		);
		$setup_method = do {
			no strict 'refs';
			${"$role_pkg\::setup_for_object"};
		} or next;
		$role_pkg->$setup_method(
			$object,
			does($details, HASH)
				? %$details
				: ( does($details, ARRAY) ? @$details : (option => $details) ),
		);
	}
}

1;

__END__

=head1 NAME

Role::Commons - roles that can be commonly used, for the mutual benefit of all

=head1 SYNOPSIS

 use 5.010;
 
 {
   package Local::Class;
   use Moo;
   use Role::Commons -all;
   our $AUTHORITY = 'cpan:JOEBLOGGS';
   our $VERSION   = '1.000';
 }
 
 say Local::Class->AUTHORITY
   if Local::Class->DOES('Role::Commons::Authority');
 
 my $obj = Local::Class->new;
 say $obj->object_id
   if $obj->DOES('Role::Commons::ObjectID');

=head1 DESCRIPTION

Role-Commons is not yet another implementation of roles. It is a collection
of generic, reusable roles that hopefully you will love to apply to your
classes. These roles are built using L<Moo::Role>, so automatically
integrate into the L<Moose> object system if you're using it, but they
do not require Moose.

The Role::Commons module itself provides shortcuts for applying roles to
your package, so that instead of doing:

 {
   package Local::Class;
   
   use Moo;  # or "use Moose"
   with qw( Role::Commons::Authority Role::Commons::ObjectID );
 }

You can just do this:

 {
   package Local::Class;
   
   use Moo;
   use Role::Commons qw( Authority ObjectID );
 }

It also handles passing some simple parameters through to the role
from the consuming class. (Because Moo doesn't have anything like
L<MooseX::Role::Parameterized>.)

=begin trustme

Not sure if these should be documented or not...

=item parse_arguments

=item apply_roles_to_object

=end trustme

=head2 Roles

=over

=item L<Role::Commons::Authority>

Sets up a C<AUTHORITY> method for your class which is conceptually a
little like C<VERSION>.

=item L<Role::Commons::ObjectID>

Provides an C<object_id> method for your class which returns a unique
identifier for each object.

=item L<Role::Commons::Tap>

Provides a C<tap> method for your class, inspired by Ruby's method
of the same name. Helpful for writing chained method calls.

=back

=head2 Obsolescence

Role-Commons is the successor for my older projects:
authority-shared,
Object-AUTHORITY,
Object-DOES,
Object-Role, and
Object-Tap.

Role-Commons includes the following (deprecated) modules for the sake
of backwards compatibility. I expect to phase them out around 2014.
L<authority::shared>,
L<Object::AUTHORITY>,
L<Object::Tap>.

=head1 BUGS

Please report any bugs to
L<http://rt.cpan.org/Dist/Display.html?Queue=Role-Commons>.

=head1 SEE ALSO

L<Role::Commons::Authority>,
L<Role::Commons::ObjectID>,
L<Role::Commons::Tap>.

L<Role::Tiny>,
L<Moo::Role>,
L<Moose::Role>.

=head1 AUTHOR

Toby Inkster E<lt>tobyink@cpan.orgE<gt>.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2012 by Toby Inkster.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=head1 DISCLAIMER OF WARRANTIES

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.