package foundation;

use strict;
no strict 'refs';
use vars qw($VERSION @ISA @EXPORT);
$VERSION = '0.03';

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(SUPER foundation);


=head1 NAME

foundation - Inheritance without objects


  package Foo;

  sub fooble { 42 }

  package Bar;

  sub mooble { 23 }
  sub hooble { 13 }

  package FooBar;
  use foundation;
  foundation(qw(Foo Bar));

  sub hooble { 31 }

  print fooble();       # prints 42
  print moodle();       # prints 23
  print hooble();       # prints 31 (FooBar overrides hooble() from Bar)
  print SUPER('hooble');     # prints 13 (Bar's hooble())


Haven't drunk the OO Kool-Aid yet?  Think object-oriented has
something to do with Ayn Rand?  Do you eat Java programmers for

If the answer to any of those is yes, than this is the module for you!
C<foundation> adds the power of inheritance without getting into a

Simply C<use foundation> and list which libraries symbols you wish to
"inherit".  It then sucks in all the symbols from those libraries into
the current one.

=head2 Functions

=over 4

=item B<foundation>


Declares what libraries you are founded on.  Similar to C<use base>.


sub foundation {
    my(@libraries) = @_;
    my $caller = caller;

    foreach my $library (@libraries) {
#        next if FOUNDED_ON($library, $caller);
        push @{$caller.'::__FOUNDATION'}, $library;

        eval "require $library";
        # only ignore "Can't locate" errors.
        die if $@ && $@ !~ /^Can't locate .*? at \(eval /; #'

        while( my($name, $stuff) = each %{$library.'::'} ) {
            my $call_glob = ${$caller.'::'}{$name};

            *{$caller.'::'.$name} = \&$stuff 
              unless defined &{$caller.'::'.$name};
            *{$caller.'::'.$name} = \$$stuff;
            *{$caller.'::'.$name} = \@$stuff;
            *{$caller.'::'.$name} = \%$stuff;

    *{$caller.'::SUPER'} = \&SUPER;


=item B<SUPER>

  my @results = SUPER($function, @args);

Calls the named $function of the current package's foundation with the
given @args.

Similar to C<$obj->SUPER::meth();>


sub SUPER {
    my($func) = shift;
    my($lib) = caller;

    my $super_func;

    # Fortunately, we can do a linear search.
    foreach my $foundation (@{$lib.'::__FOUNDATION'}) {
        if( defined &{$foundation.'::'.$func} ) {
            $super_func = \&{$foundation.'::'.$func};

    goto &$super_func;


=head1 BUGS

Plenty, I'm sure.  This is a quick proof-of-concept knock off.

=head1 AUTHOR

Michael G Schwern <>

=head1 SEE ALSO

L<Sex>, L<base>