Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

{
my %book; # Not an attribute hash; shared storage for class
sub add_book {
my ($class, $title, $arg_ref) = @_;
$book{$title} = { Title=>$title, Publisher=>q{O'Reilly}, %{$arg_ref} };
}
# Book titles accumulate throughout the libraries...
sub titles :CUMULATIVE {
return map { "$_ (O'Reilly)"} keys %book;
}
# Treat every undefined method call as a request for books
# with titles containing the method name...
sub AUTOLOAD {
# Fully qualified name of the desired method
# is passed in the $AUTOLOAD package variable...
use vars qw( $AUTOLOAD ); # Placate 'use strict'
my ($book_title_keyword) = # Extract book title keyword
$AUTOLOAD =~ m/ .* :: (.*) /xms; # by extracting method name
# If that name matches any of the book titles, return those titles...
if (my @matches = grep { /$book_title_keyword/ixms } keys %book) {
return @book{@matches};
}
# Otherwise return no titles...
return;
}
}
{
my %book;
sub add_book {
my ($class, $title, $arg_ref) = @_;
$book{$title} = { Title=>$title, Publisher=>q{Manning}, %{$arg_ref} };
}
sub titles :CUMULATIVE {
return map { "$_ (Manning)"} keys %book;
}
# Treat every undefined method call as a request for books
# with titles containing the method name...
sub AUTOLOAD {
# Fully qualified name of the desired method
# is passed in the $AUTOLOAD package variable...
use vars qw( $AUTOLOAD ); # Placate 'use strict'
my ($book_title_keyword) = # Extract book title keyword
$AUTOLOAD =~ m/ .* :: (.*) /xms; # by extracting method name
# If that name matches any of the book titles, return those titles...
if (my @matches = grep { /$book_title_keyword/ixms } keys %book) {
return @book{@matches};
}
# Otherwise return no titles...
return;
}
}
package Library;
use base qw( Library::OReilly Library::Manning);
package main;
Library::OReilly->add_book(
'Programming Perl' => { ISBN=>596000278, year=>2000 }
);
Library::Manning->add_book(
'Object Oriented Perl' => { ISBN=>1884777791, year=>2000 }
);
# print join "\n", Library->titles();
print "\n-----------------\n";
use Data::Dumper 'Dumper';
print Dumper( Library->Perl() );
print "\n-----------------\n";