This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pod2man outputs switched date and revision label (fix suggested by
[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'
22pragma will croak if multiple base classes has a %FIELDS hash. See
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
fb73857a 28This module was introduced with Perl 5.004_04.
29
f1192cee 30=head1 SEE ALSO
fb73857a 31
f1192cee 32L<fields>
fb73857a 33
34=cut
35
36package base;
37
38sub import {
39 my $class = shift;
f1192cee 40 my $fields_base;
fb73857a 41
42 foreach my $base (@_) {
43 unless (defined %{"$base\::"}) {
44 eval "require $base";
9b599b2a
GS
45 # Only ignore "Can't locate" errors from our eval require.
46 # Other fatal errors (syntax etc) must be reported.
47 die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
fb73857a 48 unless (defined %{"$base\::"}) {
49 require Carp;
50 Carp::croak("Base class package \"$base\" is empty.\n",
51 "\t(Perhaps you need to 'use' the module ",
52 "which defines that package first.)");
53 }
54 }
f1192cee
GA
55
56 # A simple test like (defined %{"$base\::FIELDS"}) will
57 # sometimes produce typo warnings because it would create
58 # the hash if it was not present before.
59 my $fglob;
60 if ($fglob = ${"$base\::"}{"FIELDS"} and *$fglob{HASH}) {
61 if ($fields_base) {
62 require Carp;
63 Carp::croak("Can't multiply inherit %FIELDS");
64 } else {
65 $fields_base = $base;
66 }
67 }
68 }
69 my $pkg = caller(0);
70 push @{"$pkg\::ISA"}, @_;
71 if ($fields_base) {
72 require fields;
73 fields::inherit($pkg, $fields_base);
fb73857a 74 }
fb73857a 75}
76
771;