This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Changing the test count is a good idea.
[perl5.git] / lib / base.pm
CommitLineData
fb73857a
PP
1=head1 NAME
2
3base - Establish IS-A relationship with base class at compile time
4
5=head1 SYNOPSIS
6
7 package Baz;
fb73857a
PP
8 use base qw(Foo Bar);
9
10=head1 DESCRIPTION
11
12Roughly similar in effect to
13
14 BEGIN {
67edfcd9
JH
15 require Foo;
16 require Bar;
17 push @ISA, qw(Foo Bar);
fb73857a
PP
18 }
19
67edfcd9
JH
20Will also initialize the %FIELDS hash if one of the base classes has
21it. Multiple inheritance of %FIELDS is not supported. The 'base'
22pragma will croak if multiple base classes have a %FIELDS hash. See
23L<fields> for a description of this feature.
f1192cee 24
bcbfb61f 25When strict 'vars' is in scope, I<base> also lets you assign to @ISA
f1192cee
GA
26without having to declare @ISA with the 'vars' pragma first.
27
b8bc843f 28If any of the base classes are not loaded yet, I<base> silently
bcbfb61f
RGS
29C<require>s them (but it won't call the C<import> method). Whether to
30C<require> a base class package is determined by the absence of a global
31$VERSION in the base package. If $VERSION is not detected even after
32loading it, I<base> will define $VERSION in the base package, setting it to
33the string C<-1, set by base.pm>.
b8bc843f
A
34
35=head1 HISTORY
36
fb73857a
PP
37This module was introduced with Perl 5.004_04.
38
67edfcd9
JH
39=head1 SEE ALSO
40
41L<fields>
fb73857a 42
67edfcd9 43=cut
fb73857a 44
67edfcd9 45package base;
17f410f9 46
67edfcd9
JH
47use 5.006_001;
48our $VERSION = "1.04";
fb73857a 49
67edfcd9
JH
50sub import {
51 my $class = shift;
52 my $fields_base;
53 my $pkg = caller(0);
fb73857a 54
67edfcd9
JH
55 foreach my $base (@_) {
56 next if $pkg->isa($base);
57 my $vglob;
58 if ($vglob = ${"$base\::"}{VERSION} and *$vglob{SCALAR}) {
59 $$vglob = "-1, set by base.pm" unless defined $$vglob;
60 } else {
61 eval "require $base";
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 /;
65 unless (%{"$base\::"}) {
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 }
71 ${"$base\::VERSION"} = "-1, set by base.pm" unless defined ${"$base\::VERSION"};
72 }
73 push @{"$pkg\::ISA"}, $base;
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 }
88 if ($fields_base) {
89 require fields;
90 fields::inherit($pkg, $fields_base);
91 }
92}
fb73857a 93
67edfcd9 941;