Changes between Version 7 and Version 8 of Perl

Timestamp:

09/15/06 10:51:23 (19 years ago)

Author:

atzm

Comment:

--

Perl

@@ -290 +290 @@
 }}}
  * ([{a=>1, b=>2}, {a=>2, b=>3}, {a=>1, b=>3}], "a") が [{a=>1, b=>2}, {a=>2, b=>3}] で返る．
+
+== OOP 関連 ==
+=== 引数設定の自動化もどき ===
+ * 意味があるのかどうかは知らん．
+{{{
+#!perl
+use strict;
+use warnings;
+use diagnostics;
+use Carp;
+
+{
+  package Base;
+
+  sub new ($%) {
+    my ($class, %argv) = @_;
+    my $self = bless {__class__ => $class}, $class;
+    return $self->__init__(%argv);
+  }
+
+  sub __init__ ($%) {
+    my ($self, %argv) = @_;
+
+    while (my ($key, $val) = each(%argv)) {
+      $self->{$key} = $val;
+    }
+    return $self;
+  }
+
+  sub __class__ ($) {
+    my $self = shift;
+    return $self->{__class__};
+  }
+
+  sub __check__ ($@) {
+    my ($self, @requisite) = @_;
+    foreach (@requisite) {
+      Carp::confess $self->__class__(), " requires argument ", $_
+          unless (defined($self->{$_}));
+    }
+  }
+
+  1;
+}
+
+{
+  package Parent;
+
+  use base qw(Base);
+
+  sub __init__ ($%) {
+    my @requisite = qw(parentname);
+
+    my ($self, %argv) = @_;
+
+    $self->SUPER::__init__(%argv);
+    $self->SUPER::__check__(@requisite);
+
+    return $self;
+  }
+
+  sub parent ($) {
+    my $self = shift;
+    printf "parent is %s\n", $self->{parentname};
+  }
+
+  1;
+}
+
+{
+  package Child;
+
+  use base qw(Parent);
+
+  sub __init__ ($%) {
+    my @requisite = qw(childname);
+
+    my ($self, %argv) = @_;
+
+    $self->SUPER::__init__(%argv);
+    $self->SUPER::__check__(@requisite);
+
+    return $self;
+  }
+
+  sub child ($) {
+    my $self = shift;
+    printf "child is %s\n", $self->{childname};
+  }
+
+  1;
+}
+
+my $child = new Child(childname => "michael", parentname => "mike");
+$child->parent();
+$child->child();
+}}}