ch16.042_best

Perl Best Practices the source code

##############################################################################
##   Code fragment (Recommended) from Chapter 16 of "Perl Best Practices"   ##
##     Copyright (c) O'Reilly & Associates, 2005. All Rights Reserved.      ##
##  See: http://www.oreilly.com/pub/a/oreilly/ask_tim/2001/codepolicy.html  ##
##############################################################################


# Standard modules...
use strict;
use warnings;
use IO::Prompt;
use Carp;
use English qw( -no_match_vars );
use Data::Alias;
use Readonly;

BEGIN {

package Wax::Floor;
use Class::Std;
{
    my %name_of    :ATTR( init_arg => 'name');
    my %patent_of  :ATTR( init_arg => 'patent');

    sub describe :CUMULATIVE {
        my ($self) = @_;

        print "The floor wax $name_of{ident $self} ",
              "(patent: $patent_of{ident $self})\n";

        return;
    }
}

package Topping::Dessert;
use Class::Std;
{
    my %name_of     :ATTR( init_arg => 'name'    );
    my %flavour_of  :ATTR( init_arg => 'flavour' );

    sub describe :CUMULATIVE {
        my ($self) = @_;

        print "The dessert topping $name_of{ident $self} ",
              "with that great $flavour_of{ident $self} taste!\n";

        return;
    }
}

package Shimmer;
use base qw( Wax::Floor  Topping::Dessert );
use Class::Std;
{
    my %name_of    :ATTR( init_arg => 'name'   );
    my %patent_of  :ATTR( init_arg => 'patent' );

    sub describe :CUMULATIVE {
        my ($self) = @_;

        print "New $name_of{ident $self} (patent: $patent_of{ident $self})\n",
              "Combining...\n";

        return;
    }
}

}


my $product 
    = Shimmer->new({ name=>'Shimmer', patent=>1562516251, flavour=>'Vanilla' });
 
$product->describe();

print '_'x60, "\n";

my $wax 
    = Wax::Floor->new({ name=>'Shimmer ', patent=>1562516251 });
 
$wax->describe();