#/*
# *  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: Random774.pm 610 2007-05-09 14:49:15Z hikarin $
#

package Img0ch::Plugin::BBS::Random774;

use strict;

sub rewrite {
    my ($iApp)   = @_;
    my $iSetting = $iApp->setting();
    my $name     = $iApp->get_name();

    if ( $name eq $iSetting->get('BBS_NONAME_NAME') ) {
        $iApp->set_name( _process( $iApp, $name ) );
    }
    return 1;
}

sub _process {
    my ( $iApp, $name ) = @_;
    my $iKernel = $iApp->kernel();
    my $iConfig = $iKernel->get_config();
    my $path    = $iConfig->get('random774.data_file');
    -r $path or return $name;

    local ( *FH, $! );
    open *FH, "<${path}"    ## no critic
        or $iKernel->throw_io_exception($path);
    my @names = <FH>;
    close *FH or $iKernel->throw_io_exception($path);

    @names = grep { !/\A\s*(?:[#;].+)?\z/xms } @names;
    map {tr/\r\n//d} @names;    ## no critic
    $name = $names[ int( rand( scalar(@names) ) ) ];

    my $location_file = $iConfig->get('random774.location_file');
    if ( -r $location_file and !-z $location_file ) {
        local ( *FH, $! );
        open *FH, "<${location_file}"    ## no critic
            or $iKernel->throw_io_exception($location_file);
        my @buffer = <FH>;
        close *FH or $iKernel->throw_io_exception($location_file);

        my @regex_buffer = ();
        @buffer = grep { !/\A\s*(?:[#;].+)?\z/xms } @buffer;
        map {tr/\r\n//d} @buffer;        ## no critic

        my $format = shift @buffer;
        for my $line (@buffer) {
            my ( $regex, $locate ) = split '=', $line, 2;
            push @regex_buffer, [ qr/$regex/xms, $locate ];
        }

        require List::Util;
        my $host = $iApp->get_remote_host();
        my $location = List::Util::first( sub { $host =~ /$_->[0]/xms },
            @regex_buffer );
        $format =~ s/\{1\}/$name/gxms;
        $format =~ s/\{2\}/$location->[1]/gxms;
        $name = $format;
    }

    return "</b>${name}<b>";
}

1;
__END__
