• 追加された行はこの色です。
  • 削除された行はこの色です。
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};
 }