- 追加された行はこの色です。
- 削除された行はこの色です。
RIGHT:&tag(検索,コード); package main; use Smart::Comments; { my @elements; @elements = (Element::URI->new('http://1.com/3rd'), Element::URI->new('http://3.com/2nd/'), Element::URI->new('http://2.com/1st/')); ### not sorted, not filtered: my $page = Page->new(@elements); print $page->out(); print "\n--------\n"; ### sorted: my $page2 = Page->new(Element::Sort->new(@elements)); print $page2->out(); print "\n--------\n"; ### sorted by label: my $page3 = Page->new(Element::Sort->new(Element::Filter->new(@elements))); print $page3->out(); print "\n"; } package Page; sub new { my $class = shift; bless { element => [@_] }, $class; } sub contents { my $self = shift; map { $_->contents() } @{$self->{element}}; } sub out { my $self = shift; join "\n", map { $_->out() } $self->contents(); } sub raw { my $self = shift; join '', map { $_->raw() } $self->contents(); } package Element::Sort; sub new { my $class = shift; bless { element => [@_] }, $class; } sub contents { my $self = shift; my @r; foreach (@{$self->{element}}){ push @r, $_->contents(); } sort { $a->raw() cmp $b->raw() } @r; } sub out { my $self = shift; map { $_->out() } $self->contents(); } sub raw { my $self = shift; join '', map { $_->raw() } $self->contents(); } package Element::Filter; sub new { my $class = shift; bless { element => [@_] }, $class; } sub contents { my $self = shift; my @r; foreach (@{$self->{element}}){ push @r, map { ### assert: $_->can('label') $_->label() =~ m%http://[^/]*/([^/]*)%; ref($_)->new($_->uri(), $1); } grep { $_->isa('Element::URI'); } $_->contents(); } @r; } sub out { my $self = shift; map { $_->out() } $self->contents(); } sub raw { my $self = shift; join '', map { $_->raw() } $self->contents(); } package Element::URI; sub new { my $class = shift; my($uri, $label) = @_; $label = $label ? $label : $uri; bless { uri => $uri, label => $label }, $class; } sub contents { shift; } sub out { my $self = shift; '<a href="'.$self->{uri}.'">'.$self->{label}.'</a>'; } sub raw { my $self = shift; $self->{label}; } sub uri { my $self = shift; $self->{uri}; } sub label { my $self = shift; $self->{label}; }