view release on metacpan or  search on metacpan

lib/AmberDB/Base.pm  view on Meta::CPAN

package AmberDB::Base;

use 5.016;
use warnings;
use Encode qw(is_utf8 encode decode);
use Carp qw(croak cluck);
use File::Spec;
use Fcntl qw(:DEFAULT :flock);
use parent qw(AmberDB::Locale AmberDB::Array);

our $VERSION = '5.25.1';
my $CREATED = '2014-12-20';

# ------------------------------------------------
sub new {
    my $class = shift;
    my %args  = ( ref $_[0] eq 'HASH' ) ? %{ $_[0] } : @_;

    # Initialise the Language engine with the supplied language tag.
    # SUPER::new is AmberDB::Locale::new — it handles locale loading.
    my $self = $class->SUPER::new(%args);
    return $self;
}

# ============================================================================
# STRING UTILITIES (Trim & Whitespace Normalization)
# ============================================================================

# $adb->trim_space($string, [$flatten])
# Strips leading/trailing whitespace and normalizes internal spaces/newlines.
# ---------------------------------------------------------------------
sub trim_space {
    my ( $self, $string, $flatten ) = @_;

    return '' unless defined $string && length $string;

    $string =~ s/ / /g;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    $string =~ s/\r\n/\n/g;

    if ($flatten) {
        $string =~ s/[\r\n\t\s]+/ /g;
        $string =~ s/ *([,;]) */$1/g;
        $string =~ s/^\s+//;
        $string =~ s/\s+$//;
    }
    else {
        $string =~ s/\n/\\n/g;
        $string =~ s/\t/\\t/g;
        $string =~ s/\s+/ /g;
        $string =~ s/ *([,;]) */$1/g;
        $string =~ s/ *\\n */\n/g;
        $string =~ s/ *\\t */\t/g;
    }

    return $string;
}

# $data = $adb->set_charset($from, $to, $data);
# Converts between character encoding tables...
# ------------------------------------------------
sub set_charset {
    my ( $self, $from, $to, $data ) = @_;

    ( $from && $to && $data ) or return;

    return $data if ( $to eq "utf8" && utf8::is_utf8($data) );
    return encode( $to, decode( $from, $data ) );
}

# Extracts search words from string...
# my %words = $self->get_words($string);
# my %words = $self->get_words($string, $write, $table);
# ------------------------------------------------
sub get_words {
    my ( $self, $string, $action, $table ) = @_;

    $string or return;

    if ( ref($string) eq 'ARRAY' ) {
        $string = join " ", @$string;
    }

    my $is_write = ( $action && ( $action eq "write" || $action eq "1" ) ) ? 1 : 0;

    # 1. En basta kelimeleri split et
    my @tokens = split /\s+/, $string;
    return () unless @tokens;

    my %words;
    my ( $minchar, %jump, $has_meta );

    foreach my $str (@tokens) {
        next unless length $str;

        # 2. Kelime bazinda cache kontrolu: $self->get_cache('gw', $rawword) => islenmis
        my $str_val = $self->get_cache( 'gw', $str );

        if ( !defined $str_val ) {
            # Cache'in altina alinan minchar ve stop_word ayarlari
            if ( !$has_meta ) {
                if ($table) {
                    my $table_info = $self->table_info($table);
                    if ( $table_info && $table_info->{stop_word} ) {
                        my $stop_word = $self->to_ascii( $table_info->{stop_word} );
                        $stop_word = $self->trim_space($stop_word);
                        $stop_word = lc($stop_word);
                        %jump      = map { $_ => 1 } split /\s+/, $stop_word;
                    }
                    $minchar = ( $table_info && $table_info->{min_char} ) ? $table_info->{min_char} : 2;
                }
                else {
                    $minchar = 2;
                }
                $has_meta = 1;
            }

            # Eger kelime minchar'dan kisa ise bosluk olarak cachele
            if ( $minchar && length($str) < $minchar ) {
                $self->set_cache( 'gw', $str, '' );
                next;
            }

            $str_val = $self->normalize_word( $str, $is_write );

            # mincharlari islerken onlari da bosluk olarak cachele
            my @sub;