| #!/usr/bin/env perl |
| # |
| # Licensed to the Apache Software Foundation (ASF) under one |
| # or more contributor license agreements. See the NOTICE file |
| # distributed with this work for additional information |
| # regarding copyright ownership. The ASF licenses this file |
| # to you under the Apache License, Version 2.0 (the |
| # "License"); you may not use this file except in compliance |
| # with the License. You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, |
| # software distributed under the License is distributed on an |
| # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| # KIND, either express or implied. See the License for the |
| # specific language governing permissions and limitations |
| # under the License. |
| # |
| # |
| # $Header$ |
| # |
| # Licensed to the Apache Software Foundation (ASF) under one |
| # or more contributor license agreements. See the NOTICE file |
| # distributed with this work for additional information |
| # regarding copyright ownership. The ASF licenses this file |
| # to you under the Apache License, Version 2.0 (the |
| # "License"); you may not use this file except in compliance |
| # with the License. You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, |
| # software distributed under the License is distributed on an |
| # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| # KIND, either express or implied. See the License for the |
| # specific language governing permissions and limitations |
| # under the License. |
| # |
| use Pod::Usage; |
| use Getopt::Long; |
| use Data::Dumper; |
| use strict; |
| use warnings; |
| |
| =head1 NAME |
| |
| B<upg2_wizard.pl> - wizard to fix upg2 test |
| |
| =head1 SYNOPSIS |
| |
| B<upg2_wizard.pl> [options] |
| |
| Options: |
| |
| -help brief help message |
| -man full documentation |
| -connect psql connect parameters |
| -tablename LIKE expression describing new tables |
| -indexname LIKE expression describing new indexes |
| -preview show data file updates, but don't modify the files |
| |
| =head1 OPTIONS |
| |
| =over 8 |
| |
| =item B<-help> |
| |
| Print a brief help message and exits. |
| |
| =item B<-man> |
| |
| Prints the manual page and exits. |
| |
| =item B<-connect> |
| |
| psql connect string, e.g: |
| |
| -connect '-p 11000 template1' |
| |
| =item B<-tablename> |
| |
| LIKE expression describing new catalog table, eg: |
| |
| -tablename foo |
| |
| or |
| |
| -tablename foo%bar |
| |
| To specify multiple tables, use multiple tablename arguments, eg: |
| |
| -tablename foo -tablename bar -tablename baz |
| |
| =item B<-indexname> |
| |
| LIKE expression describing new catalog indices, eg: |
| |
| -indexname foo |
| |
| or |
| |
| -indexname foo%bar |
| |
| To specify multiple indices, use multiple indexname arguments, eg: |
| |
| -indexname foo -indexname bar -indexname baz |
| |
| =item B<-preview> |
| |
| Show data file updates, but don't modify the files. |
| |
| =back |
| |
| =head1 DESCRIPTION |
| |
| The upg2_wizard is used to modify the data files for the upg2 |
| regression test in accordance with the UPG2_README guidelines. |
| |
| =head1 AUTHORS |
| |
| Apache HAWQ |
| |
| Address bug reports and comments to: dev@hawq.apache.org |
| |
| =cut |
| |
| my $glob_id = ""; |
| my $glob_connect; |
| my $glob_tname; |
| my $glob_iname; |
| my $glob_preview; |
| |
| BEGIN { |
| my $man = 0; |
| my $help = 0; |
| my $conn; |
| my @tname; |
| my @iname; |
| my $preview = 0; |
| |
| GetOptions( |
| 'help|?' => \$help, man => \$man, |
| "connect=s" => \$conn, |
| "tablename:s" => \@tname, |
| "indexname:s" => \@iname, |
| "preview|pretend" => \$preview |
| ) |
| or pod2usage(2); |
| |
| |
| pod2usage(-msg => $glob_id, -exitstatus => 1) if $help; |
| pod2usage(-msg => $glob_id, -exitstatus => 0, -verbose => 2) if $man; |
| |
| $glob_preview = $preview; |
| $glob_connect = $conn; |
| |
| $glob_connect = '-p 11000 template1' |
| unless (defined($glob_connect)); |
| |
| $glob_tname = []; |
| push @{$glob_tname}, @tname if (scalar(@tname)); |
| |
| $glob_iname = []; |
| push @{$glob_iname}, @iname if (scalar(@iname)); |
| |
| |
| } |
| |
| # convert a postgresql psql formatted table into an array of hashes |
| sub tablelizer |
| { |
| my $ini = shift; |
| |
| # first, split into separate lines, the find all the column headings |
| |
| my @lines = split(/\n/, $ini); |
| |
| return undef |
| unless (scalar(@lines)); |
| |
| my $line1 = shift @lines; |
| |
| # look for <space>|<space> |
| my @colheads = split(/\s+\|\s+/, $line1); |
| |
| # fixup first, last column head (remove leading,trailing spaces) |
| |
| $colheads[0] =~ s/^\s+//; |
| $colheads[0] =~ s/\s+$//; |
| $colheads[-1] =~ s/^\s+//; |
| $colheads[-1] =~ s/\s+$//; |
| |
| return undef |
| unless (scalar(@lines)); |
| |
| shift @lines; # skip dashed separator |
| |
| my @rows; |
| |
| for my $lin (@lines) |
| { |
| my @cols = split(/\|/, $lin, scalar(@colheads)); |
| last |
| unless (scalar(@cols) == scalar(@colheads)); |
| |
| my $rowh = {}; |
| |
| for my $colhd (@colheads) |
| { |
| my $rawcol = shift @cols; |
| |
| $rawcol =~ s/^\s+//; |
| $rawcol =~ s/\s+$//; |
| |
| $rowh->{$colhd} = $rawcol; |
| } |
| push @rows, $rowh; |
| } |
| |
| return \@rows; |
| } |
| |
| |
| # file fixer: general routine to merge new catalog objects into the |
| # existing data files |
| # |
| # args: hash of new relids |
| # sql query to find rows associated with new catalog objects |
| # formatted string of relids (for substitution into sql query) |
| # name of the column which is a relid foreign key |
| # data file name |
| # position of the relid key col in the row (0-based) |
| # formatted string of column names (vertical bar separator, in order) |
| sub file_fixer |
| { |
| my ($all_relid, $sql_str, $relid_list, $relid_colname, |
| $file_name, $relid_pos, $col_list_str) = @_; |
| |
| my $psql_str = "psql "; |
| |
| $psql_str .= $glob_connect |
| if (defined($glob_connect)); |
| |
| $sql_str =~ s/\*RELID_LIST\*/$relid_list/g; |
| |
| $psql_str .= ' -c " ' . $sql_str . '"'; |
| |
| print $psql_str, "\n"; |
| |
| my $tabdef = `$psql_str`; |
| |
| print $tabdef; |
| |
| my $rowarr = tablelizer($tabdef); |
| |
| my @all_newrows; |
| |
| # find all the new rows (matching the relids of the new catalog objects) |
| for my $rr (@{$rowarr}) |
| { |
| # print Data::Dumper->Dump([$rr]); |
| |
| for my $kk (keys %{$rr}) |
| { |
| # fix NULLs |
| $rr->{$kk} = '\N' |
| unless (length($rr->{$kk})); |
| } |
| |
| push @all_newrows, $rr; |
| # if (exists($all_relid->{$rr->{$relid_colname}})); |
| } |
| |
| goto L_previewo if $glob_preview; |
| |
| # must be read and writeable |
| die ("bad file: $file_name") |
| unless (-r $file_name && -w $file_name); |
| |
| my $cp2 = "cp $file_name $file_name" . ".old"; |
| |
| `$cp2`; |
| |
| my @all_oldrows; |
| |
| |
| open my $file_in, "< $file_name" or die "cannot open $file_name: $!"; |
| |
| # get the dataset for existing catalog updates and filter out rows |
| # which might match the "new" rows... |
| for my $ini (<$file_in>) |
| { |
| next if ($ini =~ m/^\\\./); |
| |
| my @foo = split(/\|/, $ini); |
| |
| # print Data::Dumper->Dump(\@foo); |
| |
| next |
| if (exists($all_relid->{$foo[$relid_pos]})); |
| |
| push @all_oldrows, $ini; |
| } |
| |
| close $file_in; |
| |
| |
| L_previewo: |
| |
| my $file_out; |
| |
| if ($glob_preview) |
| { |
| open $file_out, ">&STDOUT" or die "Can't dup STDOUT: $!"; |
| |
| print "\n\n"; |
| } |
| else |
| { |
| open $file_out, "> $file_name" |
| or die "cannot open $file_name: $!"; |
| } |
| |
| # save the rows again |
| for my $outi (@all_oldrows) |
| { |
| |
| print $file_out $outi; |
| } |
| |
| my @col_list = split(/\|/, $col_list_str); |
| |
| my $col1 = shift @col_list; |
| |
| # add any new rows |
| for my $a1 (@all_newrows) |
| { |
| print $file_out $a1->{$col1}; |
| for my $cname (@col_list) |
| { |
| print $file_out "|", $a1->{$cname}; |
| } |
| print $file_out "\n"; |
| } |
| |
| print $file_out "\\.\n"; |
| |
| print "\n\n" if ($glob_preview); |
| |
| close $file_out; |
| |
| |
| } # end file fixer |
| |
| if (1) |
| { |
| my $exe = $0; |
| |
| # assume current file is in src/test/resgress... |
| my $xdir = $exe; |
| $xdir =~ s/\/upg2\_wizard\.pl$//; |
| |
| my $class_file = "$xdir/data/upgrade34/upg2_pg_class_toadd33.data.in"; |
| my $attr_file = "$xdir/data/upgrade34/upg2_pg_attribute_toadd33.data.in"; |
| my $depend_file = "$xdir/data/upgrade34/upg2_pg_depend_toadd33.data"; |
| my $index_file = "$xdir/data/upgrade34/upg2_pg_index_toadd33.data.in"; |
| my $type_file = "$xdir/data/upgrade34/upg2_pg_type_toadd33.data.in"; |
| |
| |
| my $psql_str = "psql "; |
| |
| $psql_str .= $glob_connect |
| if (defined($glob_connect)); |
| |
| my $sql_str = "select oid, * from pg_class where "; |
| |
| my @all_name; |
| |
| push @all_name, @{$glob_tname}; |
| push @all_name, @{$glob_iname}; |
| |
| my @all_like; |
| |
| for my $nam (@all_name) |
| { |
| push @all_like, " relname like \'". $nam . "\' "; |
| } |
| |
| unless (scalar(@all_like)) |
| { |
| die("no table or index names"); |
| exit(1); |
| } |
| |
| $sql_str .= join(" or ", @all_like) . " ;" ; |
| |
| $psql_str .= ' -c " ' . $sql_str . '"'; |
| |
| print $psql_str, "\n"; |
| |
| my $tabdef = `$psql_str`; |
| |
| print $tabdef; |
| |
| my $rowarr = tablelizer($tabdef); |
| |
| my %reg_tabs; |
| |
| my $who_me = `whoami`; |
| |
| chomp $who_me; |
| |
| my %all_relid; |
| my %all_tab; |
| |
| for my $rr (@{$rowarr}) |
| { |
| $rr->{relacl} =~ s/$who_me/\@gpcurusername\@/g; |
| |
| $rr->{relacl} = '\N' |
| unless (length($rr->{relacl})); |
| $rr->{reloptions} = '\N' |
| unless (length($rr->{reloptions})); |
| |
| # print Data::Dumper->Dump([$rr]); |
| |
| $all_tab{$rr->{relname}} = $rr; |
| $all_relid{$rr->{oid}} = $rr->{relname}; |
| } |
| |
| # print Data::Dumper->Dump([%all_relid]); |
| |
| # print $class_file, "\n"; |
| |
| goto L_previewoo if $glob_preview; |
| |
| die ("bad file") |
| unless (-r $class_file && -w $class_file); |
| |
| my $cp1 = "cp $class_file $class_file" . ".old"; |
| |
| `$cp1`; |
| |
| my @all_class; |
| |
| open my $class_in, "< $class_file" or die "cannot open $class_file: $!"; |
| |
| for my $ini (<$class_in>) |
| { |
| next if ($ini =~ m/^\\\./); |
| |
| my @foo = split(/\|/, $ini, 2); |
| |
| # print Data::Dumper->Dump(\@foo); |
| |
| next |
| if (exists($all_relid{$foo[0]})); |
| |
| push @all_class, $ini; |
| } |
| |
| close $class_in; |
| |
| L_previewoo: |
| |
| my $file_out; |
| |
| if ($glob_preview) |
| { |
| open $file_out, ">&STDOUT" or die "Can't dup STDOUT: $!"; |
| |
| print "\n\n"; |
| } |
| else |
| { |
| open my $file_out, "> $class_file" |
| or die "cannot open $class_file: $!"; |
| } |
| |
| for my $outi (@all_class) |
| { |
| |
| print $file_out $outi; |
| } |
| |
| my @class_col_list = split(/\|/, |
| "relname|relnamespace|reltype|relowner|relam|relfilenode|reltablespace|relpages|reltuples|reltoastrelid|reltoastidxid|relaosegrelid|relaosegidxid|relhasindex|relisshared|relkind|relstorage|relnatts|relchecks|reltriggers|relukeys|relfkeys|relrefs|relhasoids|relhaspkey|relhasrules|relhassubclass|relfrozenxid|relacl|reloptions" |
| ) ; |
| |
| for my $oid (sort {$a <=> $b} keys (%all_relid)) |
| { |
| print $file_out $oid; |
| for my $cname (@class_col_list) |
| { |
| print $file_out "|", $all_tab{$all_relid{$oid}}->{$cname}; |
| } |
| print $file_out "\n"; |
| } |
| |
| print $file_out "\\.\n"; |
| |
| print "\n\n" if ($glob_preview); |
| |
| close $file_out; |
| |
| my $relid_list_str = join(",", (sort {$a <=> $b} keys (%all_relid))); |
| |
| file_fixer(\%all_relid, |
| "select * from pg_attribute where attrelid in " . |
| "( *RELID_LIST* ) order by attrelid, attnum;", |
| $relid_list_str, |
| "attrelid", |
| $attr_file, 0, |
| "attrelid|attname|atttypid|attstattarget|attlen|attnum|attndims|attcacheoff|atttypmod|attbyval|attstorage|attalign|attnotnull|atthasdef|attisdropped|attislocal|attinhcount" |
| ); |
| |
| # depend |
| |
| file_fixer(\%all_relid, |
| "select * from pg_depend where refobjid in " . |
| "( *RELID_LIST* ) " . |
| " or refobjid in (select oid from pg_type where typrelid in " . |
| "( *RELID_LIST* ) ) " . |
| "order by classid, objid, refobjid;", |
| $relid_list_str, |
| "refobjid", |
| $depend_file, 4, |
| "classid|objid|objsubid|refclassid|refobjid|refobjsubid|deptype" |
| ); |
| |
| # index |
| |
| file_fixer(\%all_relid, |
| "select * from pg_index where indexrelid in " . |
| "( *RELID_LIST* ) order by indexrelid, indrelid;", |
| $relid_list_str, |
| "indexrelid", |
| $index_file, 0, |
| "indexrelid|indrelid|indnatts|indisunique|indisprimary|indisclustered|indisvalid|indkey|indclass|indexprs|indpred" |
| ); |
| |
| # type |
| |
| file_fixer(\%all_relid, |
| "select oid,* from pg_type where typrelid in " . |
| "( *RELID_LIST* ) order by oid, typname, typrelid;", |
| $relid_list_str, |
| "typrelid", |
| $type_file, 9, |
| "oid|typname|typnamespace|typowner|typlen|typbyval|typtype|typisdefined|typdelim|typrelid|typelem|typinput|typoutput|typreceive|typsend|typanalyze|typalign|typstorage|typnotnull|typbasetype|typtypmod|typndims|typdefaultbin|typdefault" |
| ); |
| |
| } |
| |
| |
| exit(); |