Class-Interface

 view release on metacpan or  search on metacpan

lib/Class/Interface.pm  view on Meta::CPAN

use Carp;

# some default class vars
$Class::Interface::VERSION = "1.01";

# some class vars for changing behaviour
$Class::Interface::AUTO_CONSTRUCTOR = 0;
$Class::Interface::CONFESS = 0;

# define a contract
sub error(*);

=pod

=head2 &interface()

Turns the calling class into an interface.

=cut
sub interface() {
  my $caller = caller();

  return if !$caller || $caller eq "main";

  # interfaces should be usable.
  eval "use $caller";
  error $@ if $@;

  my @subs = inspectInterface($caller);

lib/Class/Interface.pm  view on Meta::CPAN

  };
}

=pod

=head2 &abstract()

Turns the calling class into an abstract.

=cut
sub abstract() {
  my $caller = caller();

  return if !$caller || $caller eq "main";

  # interfaces should be usable.
  eval "use $caller";
  error $@ if $@;

  my @subs = inspectInterface( $caller, 1 );

lib/Class/Interface.pm  view on Meta::CPAN

=head2 &implements()

Loads the given interfaces and checks the calling class for presence
of the wanted routines.

If all goes well pushes the name of the interface to the ISA array of
the class.

=cut
sub implements(@) {
  my $caller = caller;

  my %missing;
  foreach my $implements (@_) {
    eval "use $implements;";
    error
      "$caller tries to implement non existing interface $implements -- $@"
      if $@;

    unless ( defined ( &{ $implements . "::__get_interface_methods__" } ) ) {

lib/Class/Interface.pm  view on Meta::CPAN

=head2 &extends()

Loads the given abstract class and checks the calling class for presence
of the abstract routines.

If all goes well pushes the name of the abstract class to the ISA
array of the class.

=cut
sub extends(*) {
  my $caller = caller();

  my %missing;
  foreach my $extends (@_) {
    eval "use $extends;";
    error
      "$caller tries to implement non existing abstract class $extends -- $@"
      if $@;

    unless ( defined ( &{ $extends . "::__get_abstract_methods__" } ) ) {

lib/Class/Interface.pm  view on Meta::CPAN

      foreach my $field ( keys %value ) {
        $self->$field( $value{$field} ) if $self->can( $field )
      }

      return $self
    };
  }
}

# die
sub error(*) {
  my $strings = join("", @_);

  if ( $Class::Interface::CONFESS == 1 ) {
    confess $strings;
  } else {
    croak $strings;
  }
}

=pod