Win32 pacifying from mjd.
[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, set 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.006_001;
48 our $VERSION = "1.02";
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         my $vglob;
59         unless (${*{"$base\::VERSION"}{SCALAR}}) {
60             eval "require $base";
61             # Only ignore "Can't locate" errors from our eval require.
62             # Other fatal errors (syntax etc) must be reported.
63             die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
64             unless (%{"$base\::"}) {
65                 require Carp;
66                 Carp::croak("Base class package \"$base\" is empty.\n",
67                             "\t(Perhaps you need to 'use' the module ",
68                             "which defines that package first.)");
69             }
70             ${"$base\::VERSION"} = "-1, set by base.pm"
71                 unless ${*{"$base\::VERSION"}{SCALAR}};
72         }
73
74         # A simple test like (defined %{"$base\::FIELDS"}) will
75         # sometimes produce typo warnings because it would create
76         # the hash if it was not present before.
77         my $fglob;
78         if ($fglob = ${"$base\::"}{"FIELDS"} and *$fglob{HASH}) {
79             if ($fields_base) {
80                 require Carp;
81                 Carp::croak("Can't multiply inherit %FIELDS");
82             } else {
83                 $fields_base = $base;
84             }
85         }
86     }
87     if ($fields_base) {
88         require fields;
89         fields::inherit($pkg, $fields_base);
90     }
91 }
92
93 1;