File Coverage

blib/lib/Object/Meta/Plugin/ExportList.pm

Criterion	Covered	Total	%
statement	29	57	50.8
branch	7	16	43.7
condition			n/a
subroutine	8	11	72.7
pod	7	7	100.0
total	51	91	56.0

#!/usr/bin/perl
# $Id: ExportList.pm,v 1.5 2003/12/10 02:37:24 nothingmuch Exp $

package Object::Meta::Plugin::ExportList; # an object representing the skin of a plugin - what can be plugged and unseamed at the top level.

use strict;
use warnings;

# this is a simple string based Object::Meta::Plugin::Export list. That is, all the methods are strings, and not code refs,
# which gives a somewhat more controlled environment.

# you could laxen these limits by writing your own ExportList, which will use code refs, and thus allow a plugin to nibble methods from other classes without base classing.
# you'd also have to subclass Object::Meta::Plugin::Host to handle coderefs. Perhaps a dualvalue system could be useful.

our $VERSION = 0.02;

sub new {
	my $pkg = shift;
	my $plugin = shift;

	my $self = bless {
		plugin => $plugin,
		info => (ref $_[0] ? shift : Object::Meta::Plugin::ExportList::Info->new()),
	}, $pkg;

	my @methods = @_;

	if (@methods){
		my %list = map { $_, undef } $plugin->exports(); # used to cross out what's not exported
		$self->{methods} = [ grep { exists $list{$_} } @methods ]; # filter the method list to be only what works;
	} else {
		$self->{methods} = [ $plugin->exports() ]; # everything unless otherwise stated
	}

	$self;
}

sub plugin {
	my $self = shift;
	$self->{plugin};
}

sub exists {
	my $self = shift;

	$self->{index} = { map { $_, undef } @{ $self->{methods} } } unless (exists $self->{index});

	if (wantarray){ # return a grepped list
		return grep { exists $self->{index}{$_} } @_;
	} else { # return a true or false
		return exists $self->{index}{$_[0]};
	}
}

sub list { # list all under plugin
	my $self = shift;

	return @{ $self->{methods} };
}

sub merge { # or another exoprt list into this one
	my $self = shift;
	my $x = shift;

	my %uniq;
	@{ $self->{methods} } = grep { not $uniq{$_}++ } @{ $self->{methods} }, $x->list();

	$self;
}

sub unmerge { # and (not|complement) another export list into this one
	my $self = shift;
	my $x = shift;

	my %seen = map { $_, undef } $x->list();
	@{ $self->{methods} } = grep { not exists $seen{$_} } @{ $self->{methods} };
}

sub info {
	my $self = shift;

	$self->{info} = shift if (@_);

	$self->{info};
}

package Object::Meta::Plugin::ExportList::Info; # for now it's basically a method->hashkey translator

our $AUTOLOAD;

sub new {
	my $pkg = shift;
	bless {@_ ? @_ : qw/
		style	implicit
	/}, $pkg;
};

sub AUTOLOAD {
	my $self = shift;
	$AUTOLOAD =~ /.*::(.*)$/;
	my $method = $1;
	return if $method eq 'DESTROY';

	$self->{$method} = shift if (@_);

	$self->{$method};
}

1; # Keep your mother happy.

__END__