view release on metacpan or  search on metacpan

lib/DBIx/UpdateTable/FromHoH.pm  view on Meta::CPAN

this code:

    my $res = update_table_from_hoh(
        dbh => $dbh,
        table => 't1',
        key_column => 'id',
        hoh => {
            1 => {col1=>'a', col2=>'b'},
            2 => {col1=>'c', col2=>'d'},
            4 => {col1=>'e', col2=>'f'},
        },
    );

will perform these SQL queries:

    UPDATE TABLE t1 SET col2='d' WHERE id='2';
    INSERT INTO t1 (id,col1,col2) VALUES (4,'e','f');
    DELETE FROM t1 WHERE id='3';

to make table `t1` become like this:

    id    col1    col2    col3
    --    ----    ----    ----
    1     a       b       foo
    2     c       d       bar
    4     e       f       qux

_
    args => {
        dbh => {
            schema => ['obj*'],
            req => 1,
        },
        table => {
            schema => 'str*',
            req => 1,
        },
        hoh => {
            schema => 'hoh*',
            req => 1,
        },
        key_column => {
            schema => 'str*',
            req => 1,
        },
        data_columns => {
            schema => ['array*', of=>'str*'],
        },
        use_tx => {
            schema => 'bool*',
            default => 1,
        },
        extra_insert_columns => {
            schema => ['hos*'], # XXX or code
        },
        extra_update_columns => {
            schema => ['hos*'], # XXX or code
        },
    },
};
sub update_table_from_hoh {
    my %args = @_;

    my $dbh = $args{dbh};
    my $table = $args{table};
    my $hoh = $args{hoh};
    my $key_column = $args{key_column};
    my $data_columns = $args{data_columns};
    my $use_tx = $args{use_tx} // 1;

    unless ($data_columns) {
        my %columns;
        for my $key (keys %$hoh) {
            my $row = $hoh->{$key};
            $columns{ $_ }++ for keys %$row;
        }
        $data_columns = [sort keys %columns];
    }

    my @columns = @$data_columns;
    push @columns, $key_column unless grep { $_ eq $key_column } @columns;
    my $columns_str = join(",", @columns);

    $dbh->begin_work if $use_tx;

    my $hoh_table = {};
  GET_ROWS: {
        my $sth = $dbh->prepare("SELECT $columns_str FROM $table");
        $sth->execute;
        while (my $row = $sth->fetchrow_hashref) {
            $hoh_table->{ $row->{$key_column} } = $row;
        }
    }
    my $num_rows_unchanged = keys %$hoh_table;

    my $num_rows_deleted = 0;
  DELETE: {
        for my $key (sort keys %$hoh_table) {
            unless (exists $hoh->{$key}) {
                $dbh->do("DELETE FROM $table WHERE $key_column=?", {}, $key);
                $num_rows_deleted++;
                $num_rows_unchanged--;
            }
        }
    }

    my $num_rows_updated = 0;
  UPDATE: {
        for my $key (sort keys %$hoh) {
            next unless exists $hoh_table->{$key};
            my @update_columns;
            my @values;
            for my $column (@columns) {
                next if $column eq $key_column;
                unless (_eq($hoh_table->{$key}{$column}, $hoh->{$key}{$column})) {
                    push @update_columns, $column;
                    push @values, $hoh->{$key}{$column};
                }
            }
            next unless @update_columns;