0byt3m1n1

Path: /data/config/fileman/lib/ [ Home ]
File: bases.pm
# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   bases
#   Author: Scott Beck
#   CVS Info :                          
#   $Id: bases.pm,v 1.9 2004/01/13 01:35:15 jagerman Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================

package bases;

use strict 'subs', 'vars';

sub import {
    my $class = shift;
    my $pkg = caller;
    my $hsh = {@_};
    my @indices = map { $_[$_ * 2] } 0 .. $#_ * 0.5;
    foreach my $base (@indices) {
        next if $pkg->isa($base);
        push @{"$pkg\::ISA"}, $base;
        my $args = '';
        if (my $ref = ref $hsh->{$base}) {
            require GT::Dumper;
            if ($ref eq 'ARRAY') {
                $args = '(@{' . GT::Dumper->dump_structure($hsh->{$base}) . '})';
            }
            else {
                $args = '(' . GT::Dumper->dump_structure($hsh->{$base}) . ')';
            }
        }
        elsif (defined $hsh->{$base}) {
            $args = $hsh->{$base} eq '' ? '()' : "qw($hsh->{$base})";
        }
        my $dcl = qq|
            package $pkg;
            use $base $args;
        |;
        eval $dcl;
        die "$@: $dcl" if $@ && $@ !~ /^Can't locate .*? at \(eval /;
        # WEB: Fixed deprecated syntax (defined() on aggregates)
        unless (%{"$base\::"}) {
            require Carp;
            Carp::croak(
qq|Base class package "$base" is empty.
String:
$dcl
\t(Perhaps you need to 'use' the module which defines that package first.)|
            );
        }
    }
}

1;

__END__

=head1 NAME

base - Establish IS-A relationship with base class at compile time.

=head1 SYNOPSIS

    package Baz;
    use bases
        Foo  => ':all',
        Bar  => ''
        Bat  => undef;

=head1 DESCRIPTION

Roughly similar in effect to

    package Baz;
    use Foo qw(:all);
    use Bar();
    use Bat;
    BEGIN { @ISA = qw(Foo Bar Bat) }

This is very similar to C<base> pragma except %FIELDS is not
supported and you are able to pass parameters to import on the
module that is used in this way.

If the value specified is undef, the module being used import method
will be called if it exists. If the value is an empty string, import
will not be called.

When strict 'vars' is in scope I<bases> also let you assign to @ISA
without having to declare @ISA with the 'vars' pragma first.

If any of the base classes are not loaded yet, I<bases> silently
C<use>s them.  Whether to C<use> a base class package is
determined by the absence of a global $VERSION in the base package.
If $VERSION is not detected even after loading it, <base> will
define $VERSION in the base package, setting it to the string
C<-1, set by bases.pm>.

=head1 COPYRIGHT

Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
http://www.gossamer-threads.com/

=head1 VERSION

Revision: $Id: bases.pm,v 1.9 2004/01/13 01:35:15 jagerman Exp $

=cut