blog.nomadscafe.jp

はてなブックマークのコメント欄のようなものをParseするモジュールを組んでみた。

本家の完璧なエミュレートではないです。

package Text::HatenaBookmarkLike::Comment::Parser;

use strict;
use warnings;

sub new{
    bless {},shift;
}

sub parse{
    my $self = shift;
    my $string = shift;

    my @tags;
    while(length $string && $string =~ m!^\s*\[([^\]]+)\]!){
        my $tag = $1;
        $string =~ s!^\s*\[([^\]]+)\]!!;
        next unless length $tag;
        push(@tags,$tag);
    }
    
    return Text::HatenaBookmarkLike::Comment::Parser::Result->new({
        tags=>\@tags,
        comment=>$string
    });
}

1;

package Text::HatenaBookmarkLike::Comment::Parser::Result;

use strict;
use warnings;
use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_ro_accessors(qw(tags comment));

sub tags{
    my $self = shift;
    return wantarray ? @{$self->{tags}||[]} : $self->{tags};
}

sub uniq_tags{
    my $self = shift;
    my %seen;
    my @tags = grep {!$seen{$_}++} $self->tags;
    return wantarray ? @tags : \@tags;
}

1;

使い方は、

my $ret = Text::HatenaBookmarkLike::Comment::Parser->parse("[foo][bar][baz][foo]適当です");
print join(",",$ret->tags),"\n";
print join(",",$ret->uniq_tags),"\n";#ユニークなTagだけ
print $ret->comment,"\n";

今分かっている本家と違うところは、

• Tagの数、コメントの文字数に制限がない
• ? / % [ ] などの記号が使える

あたりが違う。

use strict;
use Benchmark;

my $str="[foo][bar][baz][foo]適当です";

Benchmark::timethese(300000, {
        'USE_G' =>\&use_g,
        'USE_S' => \&use_s,
});

sub use_g{
	my $str = shift;
	my @tags;
	while($str =~ /\G\s*\[([^\]]+)\]/gc){
		my $tag = $1;
		push(@tags,$tag) if length $tag;
	}
	$str =~ /\G\s*(.*)/g;
	my $comment = $1;
}

sub use_s{
	my $str = shift;
	my @tags;
	while($str =~ /^\s*\[([^\]]+)\]/){
		my $tag = $1;
		push(@tags,$tag) if length $tag;
		$str =~ s/^\s*\[([^\]]+)\]//i;
	}
	my $comment = $str;
}

$ perl tag_seprate.pl 
Benchmark: timing 300000 iterations of USE_G, USE_S...
     USE_G:  2 wallclock secs ( 1.49 usr +  0.01 sys =  1.50 CPU) @ 200000.00/s (n=300000)
     USE_S:  1 wallclock secs ( 0.47 usr +  0.00 sys =  0.47 CPU) @ 638297.87/s (n=300000)