Commit | Line | Data |
---|---|---|
d3153aa4 YST |
1 | package parent; |
2 | use strict; | |
3 | use vars qw($VERSION); | |
4 | $VERSION = '0.221'; | |
5 | ||
6 | sub import { | |
7 | my $class = shift; | |
8 | ||
9 | my $inheritor = caller(0); | |
10 | ||
11 | if ( @_ and $_[0] eq '-norequire' ) { | |
12 | shift @_; | |
13 | } else { | |
14 | for ( my @filename = @_ ) { | |
15 | if ( $_ eq $inheritor ) { | |
16 | warn "Class '$inheritor' tried to inherit from itself\n"; | |
17 | }; | |
18 | ||
19 | s{::|'}{/}g; | |
20 | require "$_.pm"; # dies if the file is not found | |
21 | } | |
22 | } | |
23 | ||
24 | { | |
25 | no strict 'refs'; | |
26 | # This is more efficient than push for the new MRO | |
27 | # at least until the new MRO is fixed | |
28 | @{"$inheritor\::ISA"} = (@{"$inheritor\::ISA"} , @_); | |
29 | }; | |
30 | }; | |
31 | ||
32 | "All your base are belong to us" | |
33 | ||
34 | __END__ | |
35 | ||
36 | =head1 NAME | |
37 | ||
38 | parent - Establish an ISA relationship with base classes at compile time | |
39 | ||
40 | =head1 SYNOPSIS | |
41 | ||
42 | package Baz; | |
43 | use parent qw(Foo Bar); | |
44 | ||
45 | =head1 DESCRIPTION | |
46 | ||
47 | Allows you to both load one or more modules, while setting up inheritance from | |
48 | those modules at the same time. Mostly similar in effect to | |
49 | ||
50 | package Baz; | |
51 | BEGIN { | |
52 | require Foo; | |
53 | require Bar; | |
54 | push @ISA, qw(Foo Bar); | |
55 | } | |
56 | ||
57 | By default, every base class needs to live in a file of its own. | |
58 | If you want to have a subclass and its parent class in the same file, you | |
59 | can tell C<parent> not to load any modules by using the C<-norequire> switch: | |
60 | ||
61 | package Foo; | |
62 | sub exclaim { "I CAN HAS PERL" } | |
63 | ||
64 | package DoesNotLoadFooBar; | |
65 | use parent -norequire, 'Foo', 'Bar'; | |
66 | # will not go looking for Foo.pm or Bar.pm | |
67 | ||
68 | This is equivalent to the following code: | |
69 | ||
70 | package Foo; | |
71 | sub exclaim { "I CAN HAS PERL" } | |
72 | ||
73 | package DoesNotLoadFooBar; | |
74 | push @DoesNotLoadFooBar::ISA, 'Foo'; | |
75 | ||
76 | This is also helpful for the case where a package lives within | |
77 | a differently named file: | |
78 | ||
79 | package MyHash; | |
80 | use Tie::Hash; | |
81 | use parent -norequire, 'Tie::StdHash'; | |
82 | ||
83 | This is equivalent to the following code: | |
84 | ||
85 | package MyHash; | |
86 | require Tie::Hash; | |
87 | push @ISA, 'Tie::StdHash'; | |
88 | ||
89 | If you want to load a subclass from a file that C<require> would | |
90 | not consider an eligible filename (that is, it does not end in | |
91 | either C<.pm> or C<.pmc>), use the following code: | |
92 | ||
93 | package MySecondPlugin; | |
94 | require './plugins/custom.plugin'; # contains Plugin::Custom | |
95 | use parent -norequire, 'Plugin::Custom'; | |
96 | ||
97 | =head1 DIAGNOSTICS | |
98 | ||
99 | =over 4 | |
100 | ||
101 | =item Class 'Foo' tried to inherit from itself | |
102 | ||
103 | Attempting to inherit from yourself generates a warning. | |
104 | ||
105 | use Foo; | |
106 | use parent 'Foo'; | |
107 | ||
108 | =back | |
109 | ||
110 | =head1 HISTORY | |
111 | ||
112 | This module was forked from L<base> to remove the cruft | |
113 | that had accumulated in it. | |
114 | ||
115 | =head1 CAVEATS | |
116 | ||
117 | =head1 SEE ALSO | |
118 | ||
119 | L<base> | |
120 | ||
121 | =head1 AUTHORS AND CONTRIBUTORS | |
122 | ||
123 | Rafaƫl Garcia-Suarez, Bart Lateur, Max Maischein, Anno Siegel, Michael Schwern | |
124 | ||
125 | =head1 MAINTAINER | |
126 | ||
127 | Max Maischein C< corion@cpan.org > | |
128 | ||
129 | Copyright (c) 2007 Max Maischein C<< <corion@cpan.org> >> | |
130 | Based on the idea of C<base.pm>, which was introduced with Perl 5.004_04. | |
131 | ||
132 | =head1 LICENSE | |
133 | ||
134 | This module is released under the same terms as Perl itself. | |
135 | ||
136 | =cut |