#/*
# *  Copyright 2007 hkrn <hikarin@users.sourceforge.jp>
# *
# *  Licensed under the Apache License, Version 2.0 (the "License");
# *  you may not use this file except in compliance with the License.
# *  You may obtain a copy of the License at
# *
# *      http://www.apache.org/licenses/LICENSE-2.0
# *
# *  Unless required by applicable law or agreed to in writing, software
# *  distributed under the License is distributed on an "AS IS" BASIS,
# *  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# *  See the License for the specific language governing permissions and
# *  limitations under the License.
# */
#
# $Id: RemoteHost.pm 451 2007-04-03 13:25:20Z hikarin $
#

package Zeromin::Filter::RemoteHost;

use strict;
use base qw(Img0ch::Filter::RemoteHost);

sub new {
    my ( $zClass, $iObject ) = @_;
    my $class = ref $iObject || '';
    my $zFRH;

    if ( $class eq 'Img0ch::BBS' ) {
        $zFRH             = $zClass->SUPER::new($iObject);
        $zFRH->{__bbs_id} = $iObject->get_id();
        $zFRH->{__kernel} = $iObject->get_kernel();
    }
    elsif ( $class eq 'Img0ch::Maple' ) {
        require Img0ch::BBS;
        my $iBBS = Img0ch::BBS->new( $iObject, { id => 0 } );
        $zFRH             = $zClass->SUPER::new($iBBS);
        $zFRH->{__bbs_id} = 0;
        $zFRH->{__kernel} = $iObject;
    }
    else {
        Img0ch::Kernel->throw_exception(
            'Img0ch::BBS or Img0ch::Maple not given');
    }

    $zFRH->{__buffer} = [];
    return $zFRH;
}

sub save {
    my ($zFRH) = @_;
    my $iRepos = $zFRH->{_rs};
    my $buffer = $zFRH->{__buffer};
    my $bbs    = $zFRH->{_bbs};
    my $count  = $iRepos->get_int("I:F:R.${bbs}._");
    my $stack  = [];

    $iRepos->remove("I:F:R.${bbs}.0");
    for ( my $i = 1; $i < $count; $i++ ) {
        my $regexp = $iRepos->remove("I:F:R.${bbs}.${i}");
        $regexp or next;
        push @$stack, $regexp;
    }

    my @assemble = ( @$stack, @$buffer );
    if (@assemble) {
        my $i    = 1;
        my $trie = Zeromin::Filter::RemoteHost::Regexp::Trie->new();
        for my $regexp ( @assemble ) {
            $iRepos->set( "I:F:R.${bbs}.${i}", $regexp );
            $trie->add($regexp);
            $i++;
        }
        $iRepos->set( "I:F:R.${bbs}.0", $trie->regexp() );
        $iRepos->set( "I:F:R.${bbs}._", $i );
    }
    else {
        $iRepos->remove("I:F:R.${bbs}.0");
        $iRepos->set( "I:F:R.${bbs}._", 0 );
    }

    @{ $zFRH->{__buffer} } = ();
    $iRepos->save();
    return 1;
}

sub count {
    my ($zFRH) = @_;
    my $bbs = $zFRH->{_bbs};
    return $zFRH->{_rs}->get_int("I:F:R.${bbs}._");
}

sub get {
    my ( $zFRH, $regex ) = @_;
    my $iRepos = $zFRH->{_rs};
    my $bbs    = $zFRH->{_bbs};
    my $count  = $zFRH->count();

    for ( my $i = 1; $i < $count; $i++ ) {
        my $regexp = $iRepos->get("I:F:R.${bbs}.${i}");
        $regex eq $regexp and return $regexp;
    }
    return '';
}

sub all {
    my ($zFRH) = @_;
    my $iRepos = $zFRH->{_rs};
    my $bbs    = $zFRH->{_bbs};
    my $count  = $zFRH->count();
    my $ret    = [];

    for ( my $i = 1; $i < $count; $i++ ) {
        my $regexp = $iRepos->get("I:F:R.${bbs}.${i}");
        $regexp or next;
        push @$ret, $regexp;
    }
    return $ret;
}

sub add {
    my ( $zFRH, $regex ) = @_;
    my $buffer = $zFRH->{__buffer};

    for my $one (@$buffer) {
        $one eq $regex and return 0;
    }
    push @$buffer, $regex;
    return 1;
}

sub remove {
    my ( $zFRH, $regex ) = @_;
    my $iRepos = $zFRH->{_rs};
    my $bbs    = $zFRH->{_bbs};
    my $count  = $zFRH->count();

    for ( my $i = 1; $i < $count; $i++ ) {
        my $regexp = $iRepos->get("I:F:R.${bbs}.${i}");
        if ( $regex eq $regexp ) {
            $iRepos->remove("I:F:R.${bbs}.${i}");
            return 1;
        }
    }
    return 0;
}

sub update {
    my ( $zFRH, $regexps ) = @_;
    my $iRepos = $zFRH->{_rs};
    my $bbs    = $zFRH->{_bbs};
    my $count  = $zFRH->count();

    for ( my $i = 1; $i < $count; $i++ ) {
        $iRepos->remove("I:F:R.${bbs}.${i}");
    }
    map { $zFRH->add($_) } @$regexps;

    return 1;
}

package Zeromin::Filter::RemoteHost::Regexp::Trie;

# import from Regexp::Trie by dan kogai
# for backward compatiblity

use strict;

sub new { bless {}, __PACKAGE__ }

sub add {
    my ( $this, $str ) = @_;
    my $ref = $this;
    for my $char ( split //, $str ) {
        $ref->{$char} ||= {};
        $ref = $ref->{$char};
    }
    $ref->{''} = 1;    # { '' => 1 } as terminator
    $this;
}

sub _regexp {
    my ($this) = @_;
    $this->{''} and scalar keys %$this == 1 and return;    # terminator

    my ( @alt, @cc );
    my $q = 0;
    for my $char ( sort keys %$this ) {
        my $qchar = quotemeta $char;
        if ( ref $this->{$char} ) {
            if ( defined( my $recurse = _regexp( $this->{$char} ) ) ) {
                push @alt, $qchar . $recurse;
            }
            else {
                push @cc, $qchar;
            }
        }
        else {
            $q = 1;
        }
    }

    my $cconly = !@alt;
    @cc and push @alt, @cc == 1 ? $cc[0] : '[' . join( '', @cc ) . ']';
    my $result = @alt == 1 ? $alt[0] : '(?:' . join( '|', @alt ) . ')';
    $q and $result = $cconly ? "$result?" : "(?:$result)?";

    return $result;
}

sub regexp { my $str = shift->_regexp(); return qr/$str/ }

1;
__END__
