view release on metacpan or  search on metacpan

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

        $base_dir =~ s{\\}{/}g;
        $base_dir =~ s{/$}{};

        foreach my $sfx (@suffixes) {
            my $fpath = "$tpath.$sfx";
            if ( -e $fpath ) {
                open my $dfh, "<:raw", $fpath or next;
                local $/ = undef;
                my $dcontent = <$dfh>;
                close $dfh;

                my $norm_fpath = $fpath;
                $norm_fpath =~ s{\\}{/}g;
                my $arch_path = $norm_fpath;
                if ( $norm_fpath =~ m{^\Q$base_dir\E/(.+)$} ) {
                    $arch_path = $1;
                }
                else {
                    $arch_path = "table/$tid.$sfx";
                }

                $tar->add_data( $arch_path, $dcontent );
                push @{ $table_manifest->{files} }, $arch_path;

                my $sha256 = Digest::SHA::sha256_hex($dcontent);
                $table_manifest->{sha256}->{$arch_path} = $sha256;
            }
        }

        # D. Collect Authoritative String Dictionary (.unq)
        my @unq_files = -e "${tpath}.unq" ? ("${tpath}.unq") : ();
        foreach my $fpath (@unq_files) {
            next unless -e $fpath;
            open my $dfh, "<:raw", $fpath or next;
            local $/ = undef;
            my $dcontent = <$dfh>;
            close $dfh;

            my $norm_fpath = $fpath;
            $norm_fpath =~ s{\\}{/}g;
            my $arch_path = $norm_fpath;
            if ( $norm_fpath =~ m{^\Q$base_dir\E/(.+)$} ) {
                $arch_path = $1;
            }
            else {
                my ($fname) = $fpath =~ m{([^/\\]+)$};
                $arch_path = "table/$fname";
            }

            $tar->add_data( $arch_path, $dcontent );
            push @{ $table_manifest->{files} }, $arch_path;

            my $sha256 = Digest::SHA::sha256_hex($dcontent);
            $table_manifest->{sha256}->{$arch_path} = $sha256;
        }

        $manifest->{tables}->{$tid} = $table_manifest;
    }

    # Add manifest.json to archive
    my $json = JSON::PP->new->utf8->pretty->encode($manifest);
    $tar->add_data( "manifest.json", $json );

    # Write tar.gz archive
    unless ( $tar->write( $outfile, Archive::Tar::COMPRESS_GZIP() ) ) {
        cluck "[DB_BACKUP] Failed to write archive $outfile: " . $tar->error() . "\n";
        return;
    }

    $self->{say} .= "Archive successfully written to $outfile (" . ( -s $outfile ) . " bytes)\n";
    return wantarray ? ( $outfile, $manifest ) : $outfile;
}

# Restores a .amberdb archive into target database, validates checksums,
# and deterministically rebuilds all binary indexes via set_index.
# my $res = $tools->restore( file => 'backup.amberdb', [force => 1], [reindex => 1] );
# ---------------------------------------------------------------------
sub restore {
    my ( $self, %opts ) = @_;
    my $adb = $self->{_adb} or return;

    my $file = $opts{file} or do {
        cluck "[DB_RESTORE] Missing required parameter 'file'.\n";
        return;
    };
    return unless -e $file;

    require Archive::Tar;
    require Digest::SHA;
    require JSON::PP;
    require File::Spec;
    require File::Path;

    my $tar = Archive::Tar->new();
    unless ( $tar->read($file) ) {
        cluck "[DB_RESTORE] Cannot read archive $file: " . $tar->error() . "\n";
        return;
    }

    # 1. Read and parse manifest.json
    my $manifest_content = $tar->get_content("manifest.json");
    unless ($manifest_content) {
        cluck "[DB_RESTORE] Archive $file is missing manifest.json.\n";
        return;
    }

    my $manifest = eval { JSON::PP->new->utf8->decode($manifest_content) };
    if ( $@ || ref($manifest) ne 'HASH' ) {
        cluck "[DB_RESTORE] Corrupted manifest.json in $file: $@\n";
        return;
    }

    # 2. Check if target DB is empty or force is set
    my $schema_dir = $adb->path('schema_dir')
      || ( $adb->path('dbase_dir') ? $adb->path('dbase_dir') . "/schema" : "schema" );
    my $table_dir = $adb->path('table_dir')
      || ( $adb->path('dbase_dir') ? $adb->path('dbase_dir') . "/table" : "table" );

    my $force = $opts{force} || $opts{overwrite};
    unless ($force) {
        # Check if existing schema or data files exist.
        # NOTE: Avoid calling table_path() here because it triggers
        # table_info() -> dbase_info() which caches empty hashes for
        # schemas that don't exist yet on the target, poisoning the
        # cache for the rest of the restore operation.
        my $has_existing = 0;
        my $db_ext = $adb->{db_ext} || "db";
        foreach my $tid ( keys %{ $manifest->{tables} || {} } ) {
            if ( -e "$table_dir/$tid.$db_ext" || -e "$schema_dir/$tid.table" ) {
                $has_existing = 1;
                last;
            }
        }
        if ($has_existing) {
            cluck "[DB_RESTORE] Target database is not empty. Use 'force => 1' to overwrite existing tables.\n";
            return;
        }
    }

    # Ensure target directories exist
    $adb->make_path($schema_dir);
    $adb->make_path($table_dir);

    # Flush all active handles before restoring
    $adb->close_all();

    my @restored_tables;
    my %table_filter = $opts{tables} ? map { $_ => 1 } @{ $opts{tables} } : ();

    # 3. Extract .dbase database group schemas
    if ( ref( $manifest->{dbases} ) eq 'HASH' ) {
        foreach my $dbs ( sort keys %{ $manifest->{dbases} } ) {
            my $arch_path = $manifest->{dbases}->{$dbs};
            my $scontent = $tar->get_content($arch_path);
            if ( defined $scontent ) {
                my $target_dbase = "$schema_dir/$dbs.dbase";
                open my $dfh, ">:raw", $target_dbase or do {
                    cluck "[DB_RESTORE] Cannot write dbase schema $target_dbase: $!\n";
                    return;
                };
                print $dfh $scontent;
                close $dfh;
            }
        }
    }

    # 4. Extract table schemas and data files