読者です 読者をやめる 読者になる 読者になる

プログラムdeタマゴ

nodamushiの著作物は、文章、画像、プログラムにかかわらず全てUnlicenseです

Perlでオブジェクト指向プログラム触ってみた

あ〜、プログラマーのバイトしたい。自宅プログラマじゃなくてちゃんとしたところで。

けど、時間がねぇええええ。

色々探してみてるけど、大体9:30〜18:30で実働4時間以上で週3日以上、土日祝日は休みというのが学生向けで相場っぽい。

私の場合水金以外は午後最後まで基本授業が詰まってるからどう考えても無理だぜ〜。土日働かせろ!大体金曜は最後までないって言っても3時までは入ってるからな〜。無理だぁ〜。

開始時刻が8:30分からで4時間なら月曜も可能なんだがなぁ〜。

 

 

 

さて、今日は何となくPerlを久しぶりに触ってみた。

全然覚えてねぇええええ。

JAVAに慣れてしまっているから、まず配列の要素数を取り出す時点で苦労し、無名配列と普通の配列の作り方が違うことではまり、$を書き忘れ、いや〜全くもう分からなくなってら。

 

で、せっかく私がOOPが出来る様になったので、Perlでもちょっちやってみようと。

 

感想としては、まぁPerlでやるのはしんどいなぁと。

そもそも、Perl自体にオブジェクト指向言語の構文が用意されていません。Perl6まで待たないとね。なので、本物のオブジェクトなんて存在せずにオブジェクトに見える物は実はただのリファレンス。そのせいでちょっと手続きが多くて煩わしさを感じるよね。

 

ただ、JAVAやScalaとかには無いPerl独特のトリッキーな物が作れたりして面白いところもあります。

例えば、Perlって関数に引数を一つの配列として渡すから、引数の個数にそもそも制限とかない。

それを利用すれば関数一個でsetterとgetterが作れるんだよね。

 

 

全く知らない人はpackageがJAVAとかでいうclassの代わりで、use base qw()がextendsの事だと思って下さい。

bless 〜は定石だと信じて下さい。なんか、リファレンスに自分が与えられた名前のオブジェクトに属することを教えるそうだけど、内部的に何やってるのかはサパーリ分かりません。

 

use strict;

{
package Object;
sub new{
my $class = shift;
my $self ={};
return bless $self,$class;
}
}
{
package A;
use base qw(Object);

sub new{
my $class = shift;
my $self =new Object;
$self ->{name}=shift;
return bless $self,$class;
}
sub call{
my $self = shift;
print "name ".$self->{name}."\n";
}
}

{
package B;
use base qw(A);
sub new{
my ($class,$name,$sex) = @_;
my $self = new A($name);
$self->{sex} = $sex;
return bless $self;
}
sub call{
my $self = shift;
$self->SUPER::call;
print " sex:".$self->{sex}."\n";
}
}

my $b = new B "田中太郎","男";
$b->call;
if( ref($b) && $b -> isa("Object") ){
print "ok\n";
}

結果は

name 田中太郎

  sex:男

ok

 

となります。とりあえず、継承とか、あるクラスを継承しているかどうか調べることは出来るけど、やたら$self->を書くのが面倒なのと、instanceofがないからref($b) && $b->isa(“Object”)なんて書き方になる。(本当はここはevalで囲わないといけないらしい。)

 

まぁ、これでとりあえず何か簡単な物を作ってみた。

追記にとりあえず、ソースコード載せておいてみるよ。

 

というわけで、ぐっばい。

 

 

 

 

Dom.pn
package Dom;
use strict;

sub new{
my $class = shift;
my $tag = shift;
my $name = shift;
my $id = shift;
my $domclass = shift;
my $self = {tag => $tag,name => $name, id => $id, class => $domclass ,children=>[],text=>"",nextchild=>0};
return bless $self,$class;
}

sub clone{
my $self = shift;
my %h = %$self;
my $clon = \%h;
return bless $clon,ref $self;
}

sub createElement{
return new Dom shift;
}

sub tag{
my $self = shift;
return $self -> {tag};
}

sub id{
my $self = shift;
my $val = shift;
if($val){
if($val =~ /^[a-zA-Z].*/){
$self -> {id} = $val;
}
}
return $self -> {id};
}

sub name{
my $self = shift;
my $val = shift;
if($val){
if($val =~ /^[a-zA-Z].*/){
$self -> {name} = $val;
}
}
return $self -> {name};
}

sub class{
my $self = shift;
my $val = shift;
if($val){
if($val =~ /^[a-zA-Z].*/){
$self -> {class} = $val;
}
}
return $self -> {class};
}

sub text{
my $self = shift;
my $val = shift;
if($val){
if($val =~ /^[a-zA-Z].*/){
$self -> {text} = $val;
}
}
return $self -> {text};
}

sub href{
my $self = shift;
my $val = shift;
if($val){
$self -> {href} = $val;
}
return $self -> {href};
}
sub src{
my $self = shift;
my $val = shift;
if($val){
$self -> {src} = $val;
}
return $self -> {src};
}
sub style{
my $self = shift;
my $val = shift;
if($val){
$self -> {style} = $val;
}
return $self -> {style};
}
sub firstChild{
my $self = shift;
my $ch = $self -> {children};
if(@$ch == 0){return undef;}
else{
$self -> {nextchild} = 1;
return $$ch[0];
};
}

sub nextChild{
my $self = shift;
my $ch = $self -> {children};
my $n = $self -> {nextchild};
if(@$ch <= $n){return undef;}
else{
$self -> {nextchild}=$self -> {nextchild}+1;
return $$ch[$n];
};
}

sub lastChild{
my $self = shift;
my $ch = $self -> {children};
if(@$ch ==0){return undef;}
else{
$self -> {nextchild} = 0;
return $$ch[@$ch-1];
};
}

sub appendChild{
my $self = shift;
my $dom = shift;
if(ref($dom) eq "Dom"){
my $childs = $self->{children};
push @$childs,$dom;
}
}


sub html{
my $self = shift;
my $tag = $self -> {tag};
my $children = $self -> {children};
my $text = $self->{text};
my $st = "<$tag";
my @key = %$self;
foreach (@key){
if($_ ne "tag" && $_ ne "children" && $_ ne "text"&& $_ ne "nextchild" ){
if($self->{$_} != undef || $self->{$_} ne ""){
$st .= " $_=\"".$self -> {$_}."\"";
}
}
}
$st .=">\n$text";
foreach (@$children){
$st .= $_->html();
}
$st .="\n";
return $st;
}


1;



HTMLObject.pm
package HTMLObject;
use Dom;
use strict;
sub new{
my $class = shift;
my $self ={header => undef,body=>new Dom "body"};
return bless $self,$class;
}


sub createElement{
return Dom::createElement shift;
}

sub appendChild{
my $self = shift;
my $element = shift;
$self->{body}->appendChild($element);
}

sub getElementById{
my $self = shift;
my $id = shift;
my @ret;
my $body = $self -> {body};
@ret = _GETELEMENTS_ ($body,sub{
my $element = shift;
return ($element->id() eq $id);
});
if($#ret == -1){return undef;}
else{ return $ret[0];}
}

sub getElementsByTagName{
my $self = shift;
my $tag = shift;
my @ret;
my $body = $self -> {body};
print $body->html;
@ret = _GETELEMENTS_ ($body,sub{
my $element = shift;
return $element->tag() eq $tag;
});
return @ret;
}

sub getElementsByName{
my $self = shift;
my $name = shift;
my @ret;
my $body = $self -> {body};
@ret = _GETELEMENTS_ ($body,sub{
my $element = shift;
return $element->name() eq $name;
});
return @ret;
}

sub getElementsByClass{
my $self = shift;
my $class = shift;
my @ret;
my $body = $self -> {body};
@ret = _GETELEMENTS_ ($body,sub{
my $element = shift;
return $element->class() eq $class;
});
return @ret;
}


sub _GETELEMENTS_{
my $dom = shift;
my $func = shift;
my @ret =();
my $element = $dom->firstChild;
while($element){
if($func->($element)){
push @ret,$element;
}
my @ele = _GETELEMENTS_($element,$func);
push @ret,@ele;
$element = $dom->nextChild;
}
return @ret;
}

1;



test.pl
 use Dom;
use HTMLObject;

$div = new Dom "div","test","id1","testclass";

$link = new Dom "a","test";
$link-> href("http://park21.wakwak.com/~tamashiro/");
$img = new Dom "img","image";
$img->src("http://park21.wakwak.com/~tamashiro/test.png");
$img->class("testclass");
$div->appendChild ($img);
$div->appendChild ($link);
$html = new HTMLObject;
$html->appendChild($div);
$id = $html->getElementById("id1");
@name = $html->getElementsByName("test");
@class = $html->getElementsByClass("testclass");
print $class[1]->html;