view release on metacpan or  search on metacpan

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

    }

    # 2. Single scalar argument: getter -> $adb->table_attr($table, 'use_simple')
    if ( @args == 1 && !ref( $args[0] ) ) {
        return $self->{_table}->{$table}->{ $args[0] };
    }

    # 3. Setter: key-value list or hashref
    my %attrs = ( @args == 1 && ref( $args[0] ) eq "HASH" ) ? %{ $args[0] } : @args;
    my $needs_path_refresh = 0;

    foreach my $key ( keys %attrs ) {
        $self->{_table}->{$table}->{$key} = $attrs{$key};
        $needs_path_refresh = 1 if $key =~ /^(year|section|lang)$/;
    }

    # If use_simple is set to true on table, selectively remove columnar, indexing, and caching definitions
    if ( $self->{_table}->{$table}->{use_simple} ) {
        delete @{ $self->{_table}->{$table} }{
            qw(
              blocks match_block search_block view_block facet_block filter_block
              slug_block sort_block sort_fields use_facet facet_rules use_junk junk_rules
              record_index repeat_start repeat_ids field_rules use_cache cache_ttl
            )
        };
    }

    if ($needs_path_refresh) {
        delete $self->{_table}->{$table}->{_path};
        $self->table_path($table);
    }

    return $self;
}

# my $table_path = $adb->table_infset($table);
# ------------------------------------------------
sub table_infset {

    my ( $self, $table, $schema_data ) = @_;

    $self->config('simple') and return 1;
    if ( ref($schema_data) eq 'HASH' ) {
        $self->{_table}->{$table} = $schema_data;
    }
    my $tbl = $self->{_table}->{$table};
    ref($tbl) eq 'HASH' or return;

    my $table_path = "$table";
    $table_path =~ s/\\/\//g;
    $table_path =~ s/\//-/g;

    my $table_str = "";

    # Scalar keys
    my @scalar_keys = qw(
      name record_index keep_deleted log_owner parent_table
      use_menu use_simple force use_cache use_alias
      use_counter use_facet stop_word min_char
      use_junk cache_ttl repeat_ids repeat_start
      no_transact no_backup
    );
    foreach my $key (@scalar_keys) {
        next unless exists $tbl->{$key};
        next unless defined $tbl->{$key} && $tbl->{$key} ne "";
        ( my $val = $tbl->{$key} ) =~ s/"/\\"/g;
        $table_str .= "\t$key => \"$val\",\n";
    }

    # Array keys
    my @array_keys = qw(
      search_block match_block view_block facet_block
      filter_block slug_block reverse
    );
    foreach my $key (@array_keys) {
        next unless ref( $tbl->{$key} ) eq "ARRAY";
        my $array = join ", ", @{ $tbl->{$key} };
        next unless $array;
        $table_str .= "\t$key => [ $array ],\n";
    }

    # Serialize sort_block
    if ( ref( $tbl->{sort_block} ) eq 'ARRAY' && @{ $tbl->{sort_block} } ) {
        $table_str .= "\tsort_block => [\n";
        foreach my $sb ( @{ $tbl->{sort_block} } ) {
            if ( ref($sb) eq 'HASH' ) {
                $table_str .= "\t\t{ blk => $sb->{blk}, type => \"$sb->{type}\"" . ( $sb->{len} ? ", len => $sb->{len}" : "" ) . " },\n";
            }
            else {
                $table_str .= "\t\t$sb,\n";
            }
        }
        $table_str .= "\t],\n";
    }

    # Serialize facet_rules
    if ( ref( $tbl->{facet_rules} ) eq 'ARRAY' && @{ $tbl->{facet_rules} } ) {
        my $fa = $tbl->{facet_rules};
        my $fa_val;
        if ( ref( $fa->[0] ) eq 'ARRAY' ) {
            my @rules_str = map {
                "[" . join( ", ", map { $_ =~ /^\d+$/ ? $_ : "\"$_\"" } @$_ ) . "]"
            } @$fa;
            $fa_val = "[ " . join( ", ", @rules_str ) . " ]";
        }
        else {
            $fa_val = "[ " . join( ", ", map { $_ =~ /^\d+$/ ? $_ : "\"$_\"" } @$fa ) . " ]";
        }
        $table_str .= "\tfacet_rules => $fa_val,\n";
    }

    # Serialize junk_rules
    if ( ref( $tbl->{junk_rules} ) eq 'ARRAY' && @{ $tbl->{junk_rules} } ) {
        my $jr = $tbl->{junk_rules};
        my $jr_val;
        if ( ref( $jr->[0] ) eq 'ARRAY' ) {
            my @rules_str = map {
                "[" . join( ", ", map { $_ =~ /^\d+$/ ? $_ : "\"$_\"" } @$_ ) . "]"
            } @$jr;
            $jr_val = "[ " . join( ", ", @rules_str ) . " ]";
        }

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

                    " rdbm  => { table => \"$blok->{rdbm}{table}\", display => $disp },";
            }
            elsif ( defined $blok->{rdbm} && $blok->{rdbm} ne '' && !ref( $blok->{rdbm} ) ) {
                $table_str .= " rdbm  => \"$blok->{rdbm}\",";
            }
            if ( ref( $blok->{extend} ) eq 'HASH' && $blok->{extend}{table} ) {
                my $join_col = $blok->{extend}{join} || 'id';
                $table_str .= 
                    " extend => { table => \"$blok->{extend}{table}\", join => \"$join_col\" },";
            }
            $blok->{option} and
              $table_str .= " option => \"$blok->{option}\",";
            $table_str .= " },\n";
        }
        $table_str .= "\t],\n";
    }

    if ($table_str) {
        my $schema_dir = $self->path('schema_dir') || ( $self->path('dbase_dir') ? $self->path('dbase_dir') . "/schema" : "schema" );
        open my $YZ, ">:encoding(UTF-8)", "$schema_dir/$table_path.table"
          or do {
            cluck "[DB_SCHEMA] Could not write schema $schema_dir/$table_path.table: $!\n";
            return;
          };
        print $YZ "{\n";
        print $YZ $table_str;
        print $YZ "}\n";
        close $YZ;
    }

    return 1;
}

# Always sorts from highest to lowest (newest to oldest / desc).
# @liste = $self->db_sortid("_", @liste);       # if no table
# @liste = $self->db_sortid("table_id", @liste);
# ------------------------------------------------
sub db_sortid {

    my ( $self, $table, @records ) = @_;

    scalar @records or return ();

    my $is_simple = $table ? ( $self->table_attr( $table, 'use_simple' ) // $self->config('simple') ) : $self->config('simple');
    my $field     = ( ref( $records[0] ) eq "ARRAY" ) ? 0 : undef;
    my $sort_type = $is_simple ? 'ascii' : 'num';

    return $self->array_sort( $sort_type, 'desc', $field, @records );
}

# $self->set_datadir("/path/to/dbase")
# ------------------------------------------------
sub set_datadir {

    my ( $self, $dbase_dir ) = @_;

    $dbase_dir or return;

    # declarations
    my @dirs = qw(
      dbase_dir table_dir schema_dir backup_dir
      cache_dir table_cache schema_cache lock_cache buffer_dir txn_dir
    );
    foreach my $dir (@dirs) {
        $self->{_path}->{$dir} //= "";
    }

    $self->{_path}->{dbase_dir} = $dbase_dir;

    # db_ext tanımlı ve "db" değil ise simple moduna al
    if ( defined $self->config('db_ext') && $self->config('db_ext') ne "db" ) {
        $self->config( simple => 1 );
    }

    # do not proceed if simple mode (simple modunda dbstore alt dizinleri yoktur, tum yollar dbase_dir ile esitlenir)
    if ( $self->config('simple') ) {
        $self->{_path}->{table_dir}    = $dbase_dir;
        $self->{_path}->{schema_dir}   = $dbase_dir;
        $self->{_path}->{backup_dir}   = $dbase_dir;
        $self->{_path}->{buffer_dir}   = $dbase_dir;
        $self->{_path}->{txn_dir}      = $dbase_dir;
        $self->{_path}->{cache_dir}    = $dbase_dir;
        $self->{_path}->{table_cache}  = $dbase_dir;
        $self->{_path}->{schema_cache} = $dbase_dir;
        $self->{_path}->{lock_cache}   = $dbase_dir;
        return 1;
    }

    $self->{_path}->{txn_dir}      ||= "$dbase_dir/txn";
    $self->{_path}->{backup_dir}   ||= "$dbase_dir/backup";
    $self->{_path}->{buffer_dir}   ||= "$dbase_dir/buffer";
    $self->{_path}->{schema_dir}   ||= "$dbase_dir/schema";
    $self->{_path}->{table_dir}    ||= "$dbase_dir/tables";

    $self->{_path}->{cache_dir}    ||= "$dbase_dir/cache";
    $self->{_path}->{table_cache}  ||= "$self->{_path}->{cache_dir}/tables";
    $self->{_path}->{schema_cache} ||= "$self->{_path}->{cache_dir}/schema";
    $self->{_path}->{lock_cache}   ||= "$self->{_path}->{cache_dir}/lock";

    # Centralized directory creation: create required base directories at initialization
    # ONLY when not in test mode (cfg->{test}) and dbase_dir is a dedicated directory (not '.')
    unless ( $self->config('test') ) {
        if ( defined $dbase_dir && $dbase_dir ne "." && $dbase_dir ne "" ) {
            require File::Path;
            for my $dir (
                $self->{_path}->{dbase_dir},
                $self->{_path}->{table_dir},
                $self->{_path}->{schema_dir},
                $self->{_path}->{backup_dir},
                $self->{_path}->{buffer_dir},
                $self->{_path}->{cache_dir},
                $self->{_path}->{table_cache},
                $self->{_path}->{schema_cache},
                $self->{_path}->{lock_cache},
                $self->{_path}->{txn_dir},
            ) {
                if ( defined $dir && length($dir) && !$self->dir_exist($dir) ) {
                    eval { File::Path::make_path($dir) };
                }
            }
        }
    }

    return 1;
}

# my $cfg_val = $adb->config("language");
# my $all_cfg = $adb->config();
# $adb->config(language => "en", no_write => 1);
# $adb->config({ language => "en", no_write => 1 });
# ------------------------------------------------
sub config {

    my ( $self, @args ) = @_;

    # 1. No arguments: return shallow copy of all configuration
    if ( !@args ) {
        return { %{ $self->{_cfg} || {} } };
    }

    # 2. Single scalar argument: getter -> $adb->config('language')
    if ( @args == 1 && !ref( $args[0] ) ) {
        return $self->{_cfg}->{ $args[0] };
    }

    # 3. Setter: key-value list or hashref
    my %pairs = ( @args == 1 && ref( $args[0] ) eq 'HASH' ) ? %{ $args[0] } : @args;

    # Internal dispatch table for side-effects
    my $hooks = {
        language => sub {
            my $val = shift;
            $self->{_cfg}->{language} = $val;
            $self->_load_locale($val) if $self->can('_load_locale');
        },
        db_ext => sub {
            my $val = shift;
            $self->{_cfg}->{db_ext} = $val;
            $self->{db_ext} = $val;
            if ( defined $val && $val ne "db" ) {
                $self->{_cfg}->{simple} = 1;
            }
            $self->_invalidate_table_paths();
        },
        simple => sub {
            my $val = shift;
            $self->{_cfg}->{simple} = $val ? 1 : 0;
            $self->_invalidate_table_paths();
        },