File Coverage

blib/lib/MRP/Interface.pm

Criterion	Covered	Total	%
statement	12	45	26.6
branch	0	14	0.0
condition			n/a
subroutine	4	10	40.0
pod	4	4	100.0
total	20	73	27.4

package MRP::Interface;

use strict;
use Carp;

use MRP::Introspection;

use vars qw($AUTOLOAD %interfaces %implementers $VERSION);

$VERSION = 1.0;

sub AUTOLOAD {
  my ($name) = $AUTOLOAD =~ /([^:]+)$/;
  my $int = $interfaces{$name};
  $int or confess "Use of undefined interface: $name";
  return $int;
}

sub create {
  my $thingy = shift;
  my %interface = @_;

  my ($name, $definition);
  while (($name, $definition) = each %interface) {
    if(exists $interfaces{$name}) {
      confess "interface $name has already been defined\n";
    } else {
      my $description = $definition->{''}; delete $definition->{''};
      $interfaces{$name} = bless {name=>$name,
				  definition=>$definition,
				  implementors=>{},
				  description=>$description,
				 }, $thingy;
    }
  }
}

sub implementedBy {
  my ($interface,$thingy) = (shift,shift);
  if(my $package = ref($thingy)) {
    foreach (keys %{$interface->{implementors}}) {
      return 1 if $thingy->isa($_);
    }
    return;
  } else {
    return if(not $thingy);
    my @errors = map { $thingy->can($_)
			 ? () : "$_";
		     } keys %{$interface->{definition}};
    if(@errors) {
      confess
	"$thingy does not implement interface ",
	$interface->{name},
	". The following ", scalar(@errors), " functions must be defined:\n  ",
	  join("", map { $_."\n\t".$interface->{definition}->{$_}."\n" } @errors),
	"\n";
    }
    $interface->{implementors}->{$thingy} = 1;
  }
}

sub name {
  my $interface = shift;
  return $interface->{name};
}

sub functions {
  my $interface = shift;
  return keys %{$interface->{definition}};
}

sub DESTROY {}

$VERSION;

__END__