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