87 lines
1.9 KiB
Perl
87 lines
1.9 KiB
Perl
{
|
|
package Point;
|
|
use Class::Spiffy -base;
|
|
use Clone qw(clone);
|
|
|
|
sub _print {
|
|
my %self = %{shift()};
|
|
while (my ($k,$v) = each %self) {
|
|
print "$k: $v\n";
|
|
}
|
|
}
|
|
|
|
sub members {
|
|
no strict;
|
|
grep {
|
|
1 == length and defined *$_{CODE}
|
|
} keys %{*{__PACKAGE__."\::"}};
|
|
}
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my %param = @_;
|
|
$param{$_} = 0 for grep {!defined $param{$_}} members;
|
|
bless \%param, $class;
|
|
}
|
|
|
|
sub copy_constructor {
|
|
clone shift;
|
|
}
|
|
|
|
sub copy_assignment {
|
|
my $self = shift;
|
|
my $from = shift;
|
|
$self->$_($from->$_) for $from->members;
|
|
}
|
|
|
|
field 'x';
|
|
field 'y';
|
|
}
|
|
|
|
{
|
|
package Circle;
|
|
use base qw(Point);
|
|
field 'r';
|
|
}
|
|
|
|
{
|
|
package main;
|
|
$_->_print, print "\n" for (
|
|
Point->new,
|
|
Point->new(x => 2),
|
|
Point->new(y => 3),
|
|
Point->new(x => 8, y => -5),
|
|
);
|
|
my $p1 = Point->new(x => 8, y => -5);
|
|
|
|
my $p2 = $p1->copy_constructor;
|
|
print "we are really different objects, not just references ".
|
|
"to the same instance\n" unless \$p1 eq \$p2;
|
|
|
|
# accessors autogenerated
|
|
$p1->x(1);
|
|
$p1->y(2);
|
|
print $p1->x, "\n";
|
|
print $p1->y, "\n";
|
|
|
|
$p2->copy_assignment($p1);
|
|
print $p2->x, "\n";
|
|
print $p2->y, "\n";
|
|
print "we now have the same values, but we are still ".
|
|
"different objects\n" unless \$p1 eq \$p2;
|
|
|
|
$_->_print, print "\n" for (
|
|
Circle->new,
|
|
Circle->new(x => 1),
|
|
Circle->new(y => 2),
|
|
Circle->new(r => 3),
|
|
Circle->new(x => 4, y => 5),
|
|
Circle->new(x => 6, r => 7),
|
|
Circle->new(y => 8, r => 9),
|
|
Circle->new(x => 1, y => 2, r => 3),
|
|
);
|
|
|
|
my $c = Circle->new(r => 4);
|
|
print $c->r, "\n"; # accessor autogenerated
|
|
}
|