tasks a-s

Task/Polymorphism/Perl/polymorphism.pl

@@ -0,0 +1,86 @@
+{
+     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
+}