/[cvs]/nfo/perl/libs/mixin.pm
ViewVC logotype

Contents of /nfo/perl/libs/mixin.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Thu Dec 12 02:48:30 2002 UTC (21 years, 10 months ago) by joko
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +17 -1 lines
+ sub _thieve_private_methods

1 package mixin;
2
3 use strict;
4 no strict 'refs';
5 use vars qw($VERSION);
6 $VERSION = '0.04';
7
8
9 =head1 NAME
10
11 mixin - Mix-in inheritance, an alternative to multiple inheritance
12
13 =head1 SYNOPSIS
14
15 package Dog;
16 sub speak { print "Bark!\n" }
17 sub new { my $class = shift; bless {}, $class }
18
19 package Dog::Small;
20 use base 'Dog';
21 sub speak { print "Yip!\n"; }
22
23 package Dog::Retriever;
24 use mixin::with 'Dog';
25 sub fetch { print "Get your own stinking $_[1]\n" }
26
27 package Dog::Small::Retriever;
28 use base 'Dog::Small';
29 use mixin 'Dog::Retriever';
30
31 my $small_retriever = Dog::Small::Retriever->new;
32 $small_retriever->speak; # Yip!
33 $small_retriever->fetch('ball'); # Get your own stinking ball
34
35 =head1 DESCRIPTION
36
37 Mixin inheritance is an alternative to the usual multiple-inheritance
38 and solves the problem of knowing which parent will be called.
39 It also solves a number of tricky problems like diamond inheritence.
40
41 The idea is to solve the same sets of problems which MI solves without
42 the problems of MI.
43
44 =head2 Using a mixin class.
45
46 There are two steps to using a mixin-class.
47
48 First, make sure you are inherited from the class with which the
49 mixin-class is to be mixed.
50
51 package Dog::Small::Retriever;
52 use base 'Dog::Small';
53
54 Since Dog::Small isa Dog, that does it. Then simply mixin the new
55 functionality
56
57 use mixin 'Dog::Retriever';
58
59 and now you can use fetch().
60
61
62 =cut
63
64 sub import {
65 my($class, @mixins) = @_;
66 my $caller = caller;
67
68 foreach my $mixin (@mixins) {
69 # XXX This is lousy, but it will do for now.
70 unless( defined ${$mixin.'::VERSION'} ) {
71 eval qq{ require $mixin; };
72 }
73 _mixup($mixin, $caller);
74 }
75 }
76
77 sub _mixup {
78 my($mixin, $caller) = @_;
79
80 require mixin::with;
81 my($with, $pkg) = mixin::with->__mixers($mixin);
82
83 _croak("$mixin is not a mixin") unless $with;
84 _croak("$caller must be a subclass of $with")
85 unless $caller->isa($with);
86
87 # This has to happen here and not in mixin::with because "use
88 # mixin::with" typically runs *before* the rest of the mixin's
89 # subroutines are declared.
90 _thieve_public_methods( $mixin, $pkg );
91 _thieve_private_methods( $mixin, $pkg );
92 _thieve_isa( $mixin, $pkg, $with );
93
94 unshift @{$caller.'::ISA'}, $pkg;
95 }
96
97
98 my %Thieved = ();
99 sub _thieve_public_methods {
100 my($mixin, $pkg) = @_;
101
102 return if $Thieved{$mixin . '_public'}++;
103
104 local *glob;
105 while( my($sym, $glob) = each %{$mixin.'::'}) {
106 next if $sym =~ /^_/;
107 next unless defined $glob;
108 *glob = *$glob;
109 *{$pkg.'::'.$sym} = *glob{CODE} if *glob{CODE};
110 }
111
112 return 1;
113 }
114 sub _thieve_private_methods {
115 my($mixin, $pkg) = @_;
116
117 return if $Thieved{$mixin . '_private'}++;
118
119 local *glob;
120 while( my($sym, $glob) = each %{$mixin.'::'}) {
121 next if $sym !~ /^_/;
122 next unless defined $glob;
123 *glob = *$glob;
124 *{$pkg.'::'.$sym} = *glob{CODE} if *glob{CODE};
125 }
126
127 return 1;
128 }
129
130 sub _thieve_isa {
131 my($mixin, $pkg, $with) = @_;
132
133 @{$pkg.'::ISA'} = grep $_ ne $with, @{$mixin.'::ISA'};
134
135 return 1;
136 }
137
138
139 sub _croak {
140 require Carp;
141 goto &Carp::croak;
142 }
143
144 sub _carp {
145 require Carp;
146 goto &Carp::carp;
147 }
148
149
150 =head1 AUTHOR
151
152 Michael G Schwern E<lt>schwern@pobox.comE<gt>
153
154 =cut
155
156 1;

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed