/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;