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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Thu Dec 12 02:47:51 2002 UTC (21 years, 10 months ago) by joko
Branch: MAIN
+ initial check-in

1 joko 1.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_isa( $mixin, $pkg, $with );
92    
93     unshift @{$caller.'::ISA'}, $pkg;
94     }
95    
96    
97     my %Thieved = ();
98     sub _thieve_public_methods {
99     my($mixin, $pkg) = @_;
100    
101     return if $Thieved{$mixin}++;
102    
103     local *glob;
104     while( my($sym, $glob) = each %{$mixin.'::'}) {
105     next if $sym =~ /^_/;
106     next unless defined $glob;
107     *glob = *$glob;
108     *{$pkg.'::'.$sym} = *glob{CODE} if *glob{CODE};
109     }
110    
111     return 1;
112     }
113    
114     sub _thieve_isa {
115     my($mixin, $pkg, $with) = @_;
116    
117     @{$pkg.'::ISA'} = grep $_ ne $with, @{$mixin.'::ISA'};
118    
119     return 1;
120     }
121    
122    
123     sub _croak {
124     require Carp;
125     goto &Carp::croak;
126     }
127    
128     sub _carp {
129     require Carp;
130     goto &Carp::carp;
131     }
132    
133    
134     =head1 AUTHOR
135    
136     Michael G Schwern E<lt>schwern@pobox.comE<gt>
137    
138     =cut
139    
140     1;

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