This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PerlFAQ sync.
[perl5.git] / lib / base.pm
CommitLineData
fb73857a 1=head1 NAME
2
3base - Establish IS-A relationship with base class at compile time
4
5=head1 SYNOPSIS
6
7 package Baz;
fb73857a 8 use base qw(Foo Bar);
9
10=head1 DESCRIPTION
11
12Roughly similar in effect to
13
14 BEGIN {
15 require Foo;
16 require Bar;
17 push @ISA, qw(Foo Bar);
18 }
19
f1192cee
GA
20Will also initialize the %FIELDS hash if one of the base classes has
21it. Multiple inheritance of %FIELDS is not supported. The 'base'
b8bc843f 22pragma will croak if multiple base classes have a %FIELDS hash. See
f1192cee
GA
23L<fields> for a description of this feature.
24
25When strict 'vars' is in scope I<base> also let you assign to @ISA
26without having to declare @ISA with the 'vars' pragma first.
27
b8bc843f
A
28If any of the base classes are not loaded yet, I<base> silently
29C<require>s them. Whether to C<require> a base class package is
30determined by the absence of a global $VERSION in the base package.
31If $VERSION is not detected even after loading it, <base> will
32define $VERSION in the base package, setting it to the string
509eaf62 33C<-1, set by base.pm>.
b8bc843f
A
34
35=head1 HISTORY
36
fb73857a 37This module was introduced with Perl 5.004_04.
38
f1192cee 39=head1 SEE ALSO
fb73857a 40
f1192cee 41L<fields>
fb73857a 42
43=cut
44
45package base;
17f410f9 46
3b825e41 47use 5.006_001;
b94834e7 48our $VERSION = "1.03";
fb73857a 49
50sub import {
51 my $class = shift;
f1192cee 52 my $fields_base;
f30a1143 53 my $pkg = caller(0);
fb73857a 54
55 foreach my $base (@_) {
f30a1143 56 next if $pkg->isa($base);
2bc5db75 57 my $vglob;
b94834e7
A
58 if ($vglob = ${"$base\::"}{VERSION} and *$vglob{SCALAR}) {
59 $$vglob = "-1, set by base.pm" unless defined $$vglob;
60 } else {
fb73857a 61 eval "require $base";
9b599b2a
GS
62 # Only ignore "Can't locate" errors from our eval require.
63 # Other fatal errors (syntax etc) must be reported.
64 die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
c5be433b 65 unless (%{"$base\::"}) {
fb73857a 66 require Carp;
67 Carp::croak("Base class package \"$base\" is empty.\n",
68 "\t(Perhaps you need to 'use' the module ",
69 "which defines that package first.)");
70 }
b94834e7 71 ${"$base\::VERSION"} = "-1, set by base.pm" unless defined ${"$base\::VERSION"};
fb73857a 72 }
b94834e7 73 push @{"$pkg\::ISA"}, $base;
f1192cee
GA
74
75 # A simple test like (defined %{"$base\::FIELDS"}) will
76 # sometimes produce typo warnings because it would create
77 # the hash if it was not present before.
78 my $fglob;
79 if ($fglob = ${"$base\::"}{"FIELDS"} and *$fglob{HASH}) {
80 if ($fields_base) {
81 require Carp;
82 Carp::croak("Can't multiply inherit %FIELDS");
83 } else {
84 $fields_base = $base;
85 }
86 }
87 }
f1192cee
GA
88 if ($fields_base) {
89 require fields;
90 fields::inherit($pkg, $fields_base);
fb73857a 91 }
fb73857a 92}
93
941;