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