/usr/local/CPAN/Foorum/Foorum/ResultSet/FilterWord.pm
package Foorum::ResultSet::FilterWord;
use strict;
use warnings;
our $VERSION = '1.001000';
use base 'DBIx::Class::ResultSet';
sub get_data {
my ( $self, $type ) = @_;
return unless ($type);
my $schema = $self->result_source->schema;
my $cache = $schema->cache();
my $cache_key = "filter_word|type=$type";
my $cache_value = $cache->get($cache_key);
return wantarray ? @{ $cache_value->{value} } : $cache_value->{value}
if ($cache_value);
my @value;
my @rs = $self->search( { type => $type } )->all;
push @value, $_->word foreach (@rs);
$cache_value = { value => \@value };
$cache->set( $cache_key, $cache_value, 3600 ); # 1 hour
return wantarray ? @value : \@value;
}
# for offensive word, we just convert part of the word into '*' by default
# for bad word, return 1 when matched
sub has_bad_word {
my ( $self, $text ) = @_;
my @bad_words = $self->get_data('bad_word');
foreach my $word (@bad_words) {
if ( $text =~ /$word/is ) {
return $word;
}
}
return 0;
}
sub convert_offensive_word {
my ( $self, $text ) = @_;
my @offensive_words = $self->get_data('offensive_word');
foreach my $word (@offensive_words) {
if ( $text =~ /$word/is ) {
my $asterisk_word = $word;
my $converted_chars = 0;
foreach my $offset ( 2 .. length($word) ) {
next
if ( int( rand(10) ) % 2 == 1 )
; # randomly skip some chars
substr( $asterisk_word, $offset - 1, 1 ) = '*';
$converted_chars++;
last if ( $converted_chars == 2 ); # that's enough
}
substr( $asterisk_word, 1, 1 ) = '*'
unless ( $asterisk_word =~ /\*/is );
$text =~ s/\b$word\b/$asterisk_word/isg;
}
}
return $text;
}
1;