view release on metacpan or  search on metacpan

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

        $d = ( defined $d && $d =~ /^\d+$/ ) ? int($d) : ( defined $block->{display} && $block->{display} =~ /^\d+$/ ? int($block->{display}) : 1 );
        $block->{rdbm} = {
            table   => $t,
            display => $d,
        };
        return;
    }

    # Case B: String format like "catalog_category,2", "catalog_category;2", "catalog_category|2", "catalog_category:2"
    if ( !ref( $block->{rdbm} ) ) {
        my $raw = "$block->{rdbm}";
        $raw =~ s/^\s+|\s+$//g;
        if ( !length $raw ) {
            delete $block->{rdbm};
            return;
        }

        # Split on comma, semicolon, pipe, or colon (, ; | :)
        my ( $t, $d ) = split( /[,;:|]/, $raw, 2 );
        $t =~ s/^\s+|\s+$//g if defined $t;
        $d =~ s/^\s+|\s+$//g if defined $d;

        if ( defined $t && length $t ) {
            my $disp = ( defined $d && $d =~ /^\d+$/ )
              ? int($d)
              : ( defined $block->{display} && $block->{display} =~ /^\d+$/
                ? int( $block->{display} )
                : 1 );
            $block->{rdbm} = {
                table   => $t,
                display => $disp,
            };
        }
        else {
            delete $block->{rdbm};
        }
    }
}

# my $table_info = $adb->table_info($table_id);
# ------------------------------------------------
sub table_info {
    my ( $self, $arg ) = @_;

    return {} unless $arg;
    return {} if $self->config('simple');

    my ( $table, $table_path ) = $self->schema_arg( $arg, "table" );
    $table && $table_path or return {};

    if ( $self->{_table}->{$table} && %{ $self->{_table}->{$table} } ) {
        return { %{ $self->{_table}->{$table} } };
    }

    my ($dbase) = ( $table =~ /^([a-z0-9]+)_/i );
    $dbase //= "";

    my $ramdisk_schema = $self->path('schema_rdir');
    my $target_path    = $table_path;
    if ( $ramdisk_schema && -e "$ramdisk_schema/$table.table" ) {
        if ( -e $table_path && ( ( stat($table_path) )[9] > ( stat("$ramdisk_schema/$table.table") )[9] ) ) {
            require File::Copy;
            eval { File::Copy::copy( $table_path, "$ramdisk_schema/$table.table" ) };
        }
        $target_path = "$ramdisk_schema/$table.table";
    }

    if ( my $do_data = $self->do_schema($target_path) ) {
        $self->normalize_blocks( $table, $do_data );
        $self->{_table}->{$table} = $do_data;

        if ( $ramdisk_schema && !-e "$ramdisk_schema/$table.table" && $self->dir_exist($ramdisk_schema) ) {
            require File::Copy;
            eval { File::Copy::copy( $table_path, "$ramdisk_schema/$table.table" ) };
        }
        if ( $do_data->{use_ramdisk} ) {
            $do_data->{_ramdisk_ensured} = 1;
            $self->ramdisk_ensure($table);
        }
    }
    else {
        my $schema = $self->{_table}->{$table} ||= {};
        $self->normalize_blocks( $table, $schema );
        $self->{_table}->{$table} = $schema;
        if ( $schema->{use_ramdisk} && !$schema->{_ramdisk_ensured} ) {
            $schema->{_ramdisk_ensured} = 1;
            $self->ramdisk_ensure($table);
        }
    }

    if ( $self->{_table}->{$table} && %{ $self->{_table}->{$table} } ) {
        $self->{_table}->{$table}->{table} //= $table;
        $self->{_table}->{$table}->{dbase} //= $dbase if $dbase;

        $self->dbase_info($dbase) if $dbase;

        return { %{ $self->{_table}->{$table} } };
    }

    return {};
}

# Checks if a table has defined schema blocks (.table file with blocks).
# Pure O(1) in-memory cache lookup.
# ------------------------------------------------
sub has_schema {
    my ( $self, $tableid ) = @_;
    return 0 unless defined $tableid && length $tableid;

    $self->table_info($tableid);
    my $tbl_cache = $self->{_table}->{$tableid};

    return ( $tbl_cache && $tbl_cache->{_has_schema} ) ? 1 : 0;
}

# Checks if a given hash structure matches the schema defined in table_info.
# Returns 1 if table has a schema AND hash contains valid schema block keys.
# Returns 0 immediately if table has no schema OR if ANY key does not belong to schema.
# Short-circuits on the very first unmatched key with zero allocation.
# ------------------------------------------------
sub schema_matches_hash {