1package Library::OReilly; 2use Class::Std; 3{ 4 my %book; # Not an attribute hash; shared storage for class 5 6 sub add_book { 7 my ($class, $title, $arg_ref) = @_; 8 $book{$title} = { Title=>$title, Publisher=>q{O'Reilly}, %{$arg_ref} }; 9 } 10 11 # Book titles accumulate throughout the libraries... 12 sub titles :CUMULATIVE { 13 return map { "$_ (O'Reilly)"} keys %book; 14 } 15 16 # Treat every undefined method call as a request for books 17 # with titles containing the method name... 18 sub AUTOLOAD { 19 20 # Fully qualified name of the desired method 21 # is passed in the $AUTOLOAD package variable... 22 use vars qw( $AUTOLOAD ); # Placate 'use strict' 23 my ($book_title_keyword) = # Extract book title keyword 24 $AUTOLOAD =~ m/ .* :: (.*) /xms; # by extracting method name 25 26 # If that name matches any of the book titles, return those titles... 27 if (my @matches = grep { /$book_title_keyword/ixms } keys %book) { 28 return @book{@matches}; 29 } 30 31 # Otherwise return no titles... 32 return; 33 } 34 35} 36 37package Library::Manning; 38use Class::Std; 39{ 40 my %book; 41 42 sub add_book { 43 my ($class, $title, $arg_ref) = @_; 44 $book{$title} = { Title=>$title, Publisher=>q{Manning}, %{$arg_ref} }; 45 } 46 47 sub titles :CUMULATIVE { 48 return map { "$_ (Manning)"} keys %book; 49 } 50 51 # Treat every undefined method call as a request for books 52 # with titles containing the method name... 53 sub AUTOLOAD { 54 55 # Fully qualified name of the desired method 56 # is passed in the $AUTOLOAD package variable... 57 use vars qw( $AUTOLOAD ); # Placate 'use strict' 58 my ($book_title_keyword) = # Extract book title keyword 59 $AUTOLOAD =~ m/ .* :: (.*) /xms; # by extracting method name 60 61 # If that name matches any of the book titles, return those titles... 62 if (my @matches = grep { /$book_title_keyword/ixms } keys %book) { 63 return @book{@matches}; 64 } 65 66 # Otherwise return no titles... 67 return; 68 } 69} 70 71package Library; 72use base qw( Library::OReilly Library::Manning); 73 74package main; 75 76Library::OReilly->add_book( 77 'Programming Perl' => { ISBN=>596000278, year=>2000 } 78); 79 80Library::Manning->add_book( 81 'Object Oriented Perl' => { ISBN=>1884777791, year=>2000 } 82); 83 84# print join "\n", Library->titles(); 85 86print "\n-----------------\n"; 87 88use Data::Dumper 'Dumper'; 89print Dumper( Library->Perl() ); 90print "\n-----------------\n"; 91 92