1 2package Class::Interfaces; 3 4use strict; 5use warnings; 6 7our $VERSION = '0.04'; 8 9sub import { 10 my $class = shift; 11 my %interfaces = @_; 12 foreach my $interface (keys %interfaces) { 13 # build the interface 14 my (@methods, @subclasses); 15 if (ref($interfaces{$interface}) eq 'HASH') { 16 my $interface_spec = $interfaces{$interface}; 17 # if we have an isa 18 if (exists ${$interface_spec}{isa}) { 19 # if is an array (multiple inheritance) 20 if (ref($interface_spec->{isa}) eq 'ARRAY') { 21 @subclasses = @{$interface_spec->{isa}}; 22 } 23 else { 24 # if its another kind of ref, its an error 25 (!ref($interface_spec->{isa})) 26 || $class->_error_handler("Interface ($interface) isa list must be an array reference"); 27 # otherwise its just a single item 28 @subclasses = $interface_spec->{isa}; 29 } 30 } 31 if (exists ${$interface_spec}{methods}) { 32 (ref($interface_spec->{methods}) eq 'ARRAY') 33 || $class->_error_handler("Method list for Interface ($interface) must be an array reference"); 34 @methods = @{$interface_spec->{methods}}; 35 } 36 } 37 elsif (ref($interfaces{$interface}) eq 'ARRAY') { 38 @methods = @{$interfaces{$interface}}; 39 } 40 elsif (!defined($interfaces{$interface})) { 41 # allow undefined here, this indicates an empty 42 # interface, sometimes called a marker interface 43 ; 44 } 45 else { 46 $class->_error_handler("Cannot use a " . $interfaces{$interface} . " to build an interface"); 47 } 48 # now create the interfaces 49 my $package = $class->_build_interface_package($interface, @subclasses); 50 eval $package; 51 $class->_error_handler("Could not create Interface ($interface) because", $@) if $@; 52 eval { 53 my $method_stub = $class->can('_method_stub'); 54 no strict 'refs'; 55 # without at least this VERSION declaration 56 # a Marker interface will not work with 57 # 'use base' basically it would complain 58 # that the package is empty. 59 # we only assign this if the VERSION is already 60 # empty too, so we don't step on any customizations 61 # done in subclasses. 62 ${"${interface}::"}{VERSION} ||= -1; 63 # now we create all our methods :) 64 foreach my $method (@methods) { 65 ($method !~ /^(BEGIN|INIT|CHECK|END|DESTORY|AUTOLOAD|import|bootstrap)$/) 66 || $class->_error_handler("Cannot create an interface using reserved perl methods"); 67 *{"${interface}::${method}"} = $method_stub; 68 } 69 }; 70 $class->_error_handler("Could not create sub methods for Interface ($interface) because", $@) if $@; 71 } 72} 73 74sub _build_interface_package { 75 my ($class, $interface, @subclasses) = @_; 76 my $package = "package $interface;"; 77 $package .= "\@${interface}::ISA = qw(" . (join " " => @subclasses) . ");" if @subclasses; 78 return $package; 79} 80 81sub _error_handler { 82 my ($class, $message, $sub_exception) = @_; 83 die "$message : $sub_exception" if $sub_exception; 84 die "$message"; 85} 86 87sub _method_stub { die "Method Not Implemented" } 88 891; 90 91__END__ 92 93=head1 NAME 94 95Class::Interfaces - A module for defining interface classes inline 96 97=head1 SYNOPSIS 98 99 # define some simple interfaces 100 use Class::Interfaces ( 101 Serializable => [ 'pack', 'unpack' ], 102 Printable => [ 'toString' ], 103 Iterable => [ 'iterator' ], 104 Iterator => [ 'hasNext', 'next' ] 105 ); 106 107 # or some more complex ones ... 108 109 # interface can also inherit from 110 # other interfaces using this form 111 use Class::Interfaces ( 112 BiDirectionalIterator => { 113 isa => 'Iterator', 114 methods => [ 'hasPrev', 'prev' ] 115 }, 116 ResetableIterator => { 117 isa => 'Iterator', 118 methods => [ 'reset' ] 119 }, 120 # we even support multiple inheritance 121 ResetableBiDirectionalIterator => { 122 isa => [ 'ResetableIterator', 'BiDirectionalIterator' ] 123 } 124 ); 125 126 # it is also possible to create an 127 # empty interface, sometimes called 128 # a marker interface 129 use Class::Interfaces ( 130 JustAMarker => undef 131 ); 132 133=head1 DESCRIPTION 134 135This module provides a simple means to define abstract class interfaces, which can be used to program using the concepts of interface polymorphism. 136 137=head2 Interface Polymorphism 138 139Interface polymorphism is a very powerful concept in object oriented programming. The concept is that if a class I<implements> a given interface it is expected to follow the guidelines set down by that interface. This in essence is a contract between the implementing class an all other classes, which says that it will provide correct implementations of the interface's abstract methods. Through this, it then becomes possible to treat an instance of an implementing class according to the interface and not need to know much of anything about the actual class itself. This can lead to highly generic code which is able to work with a wide range of virtually arbitrary classes just by using the methods of the certain interface which the class implements. Here is an example, using the interfaces from the L<SYNOPSIS> section: 140 141 eval { 142 my $list = get_list(); 143 $list->isa('Iterable') || die "Unable to process $list : is not an Iterable object"; 144 my $iterator = $list->iterator(); 145 $iterator->isa('Iterator') || die "Unrecognized iterator type : $iterator"; 146 while ($iterator->hasNext()) { 147 my $current = $iterator->next(); 148 if ($current->isa('Serializable')) { 149 store_into_database($current->pack()); 150 } 151 elsif ($current->isa('Printable')) { 152 store_into_database($current->toString()); 153 } 154 else { 155 die "Unable to store $current into database : unrecognized object type"; 156 } 157 } 158 }; 159 if ($@) { 160 # ... do something with the exception 161 } 162 163Now, this may seem like there is a lot of manual type checking, branching and error handling, this is due to perl's object type system. Some say that perl is a strongly typed langugage because a SCALAR cannot be converted (cast) as an ARRAY, and conversions to a HASH can only be done in limited circumstances. Perl enforces these rules at both compile and run time. However, this strong typing breaks down when it comes to perl's object system. If we could enforce object types in the same way we can enforce SCALAR, ARRAY and HASH types, then the above code would need less manual type checking and therefore less branching and error handling. For instance, below is a java-esque example of the same code, showing how type checking would simplify things. 164 165 Iterable list = get_list(); 166 Iterator iterator = list.iterator(); 167 while (iterator.hasNext()) { 168 try { 169 store_into_database(iterator.next()); 170 } 171 catch (Exception e) { 172 // ... do something with the exception 173 } 174 } 175 176 void store_into_database (Serializable current) { ... } 177 void store_into_database (Printable current) { ... } 178 179While the java-esque example is much shorter, it is really doing the same thing, just all the type checking and error handling is performed by the language itself. But the power of the concept of interface polymorphism is not lost. 180 181=head2 Subclassing Class::Interfaces 182 183For the most part, you will never need to subclass Class::Interfaces since it's default behavior will most likley be sufficient for most class stub generating needs. However, it is now possible (as of 0.02) to subclass Class::Interfaces and customize some of it's behavior. Below in the L<CLASS METHODS> section, you will find a list of methods which you can override in your Class::Interfaces subclass and therefore customize how your interfaces are built. 184 185=head1 INTERFACE 186 187Class::Interfaces is interacted with through the C<use> interface. It expects a hash of interface descriptors in the following formats. 188 189=over 4 190 191=item E<lt>I<interface name>E<gt> =E<gt> [ E<lt>list of method namesE<gt> ] 192 193An interface can be simply described as either an ARRAY reference containing method labels as strings, or as C<undef> for empty (marker) interfaces. 194 195=item E<lt>I<interface name>E<gt> =E<gt> { E<lt>interface descriptionE<gt> } 196 197Another option is to use the HASH reference, which can support the following key value pair formats. 198 199=over 4 200 201=item isa =E<gt> E<lt>super interfaceE<gt> 202 203An interface can inherit from another interface by assigning an interface name (as a string) as the value of the C<isa> key. 204 205=item isa =E<gt> [ E<lt>list of super interfacesE<gt> ] 206 207Or an interface can inherit from multiple interfaces by assigning an ARRAY reference of interface names (as strings) as the value of the C<isa> key. 208 209=item methods =E<gt> [ E<lt>list of method namesE<gt> ] 210 211An interface can define it's method labels as an ARRAY reference containing string as the value of the C<methods> key. 212 213=back 214 215Obviously only one form of the C<isa> key can be used at a time (as the second would cancel first out), but you can use any other combination of C<isa> and C<methods> with this format. 216 217=back 218 219=head1 CLASS METHODS 220 221The following methods are class methods, which if you like, can be overriden by a subclass of Class::Interfaces. This can be used to customize the building of interfaces for your specific needs. 222 223=over 224 225=item B<_build_interface_package ($class, $interface, @subclasses)> 226 227This method is used to construct a the interface package itself, it just creates and returns a string which Class::Interfaces will then C<eval> into being. 228 229This method can be customized to do any number of things, such as; add a specified namespace prefix onto the C<$interface> name, add additional classes into the C<@subclasses> list, basically preprocess any of the arguments in any number of ways. 230 231=item B<_error_handler ($class, $message, $sub_exception)> 232 233All errors which might happen during class generation are sent through this routine. The main use of this is if your application is excepting object-based exceptions and not just string-based exceptions, you can customize this to do that for you. 234 235=item B<_method_stub ($class)> 236 237When a method is created in the interface, it is given a default implementation (or stub). This usually will die with the string "Method Not Implemented", however, this may not always be what you want it to do. 238 239This can be used much like C<_error_handler> in that you can make it throw an object-based exception if that is what you application expects. But it can also be used to log missing methods, or to not do anything and just allow things to fail silently too. It is all dependent upon your needs. 240 241=back 242 243=head1 TO DO 244 245The documentation needs some work. 246 247=head1 BUGS 248 249None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. 250 251=head1 CODE COVERAGE 252 253I use B<Devel::Cover> to test the code coverage of my tests, below is the B<Devel::Cover> report on this module test suite. 254 255 ---------------------------- ------ ------ ------ ------ ------ ------ ------ 256 File stmt branch cond sub pod time total 257 ---------------------------- ------ ------ ------ ------ ------ ------ ------ 258 Class/Interfaces.pm 100.0 100.0 50.0 100.0 n/a 100.0 98.9 259 ---------------------------- ------ ------ ------ ------ ------ ------ ------ 260 Total 100.0 100.0 50.0 100.0 n/a 100.0 98.9 261 ---------------------------- ------ ------ ------ ------ ------ ------ ------ 262 263=head1 SEE ALSO 264 265=over 4 266 267=item L<Object::Interface> 268 269=item L<interface> 270 271=back 272 273=head1 ACKNOWLEDGEMENTS 274 275=over 4 276 277=item Thanks for Matthew Simon Cavalletto for pointing out a problem with a reg-exp and for suggestions on the documentation. 278 279=back 280 281=head1 AUTHOR 282 283stevan little, E<lt>stevan@iinteractive.comE<gt> 284 285=head1 COPYRIGHT AND LICENSE 286 287Copyright 2004 by Infinity Interactive, Inc. 288 289L<http://www.iinteractive.com> 290 291This library is free software; you can redistribute it and/or modify 292it under the same terms as Perl itself. 293 294=cut 295 296