root/trunk/getddl/getddl.pl

Revision 35, 24.7 kB (checked in by robert, 5 years ago)

implement overloaded function to single file

Line 
1 #!/data/bin/perl
2 use strict;
3 use warnings;
4
5 # getddl, a script for managing postgresql schema via svn
6 # Copyright 2008, OmniTI, Inc. (http://www.omniti.com/)
7 # See complete license and copyright information at the bottom of this script 
8 # For newer versions of this script, please see:
9 # https://labs.omniti.com/trac/pgsoltools/wiki/getddl
10 # POD Documentation also available by issuing pod2text getddl.pl
11
12 use DBI;
13 use Data::Dumper;
14 use Getopt::Long;
15 use DirHandle;
16
17 package GetDDL::SuppList;
18 sub new {
19     my ($class, %args) = @_;
20     my $self = bless {}, $class;
21     $self->{data} = '';
22     $self->{suppress} = sub { 0 };
23     $self->load($args{filename}) if $args{filename};
24     return $self;
25 }
26 sub load {
27     my ($self, $fn) = @_;
28     my $fh = do { no warnings; local *FH };
29     open $fh, "< $fn" or die "couldn't read [$fn]: $!\n";
30     { local $/ = undef; $self->{data} = <$fh> }
31     close $fh;
32     my $evalme = 'sub {';
33     for my $line (split /[\r\n]+/, $self->{data}) {
34         if ($line =~ /^=~/) {
35             # reject if matches expression
36             $line =~ s/(?<!;)$/;/;
37             $evalme .= "return 1 if \$_[0] $line";
38         } else {
39             # reject if contains substring
40             $evalme .= "return 1 if index(\$_[0], '$line') >= 0;";
41         }
42     }
43     $evalme .= '0}';
44     $self->{codestr} = $evalme;
45     $self->{suppress} = eval $evalme;
46     return;
47 }
48 package main;
49
50 # no svn interaction by default, just write 'em out
51 my ($DO_SVN, $WRITE_DDL, $QUIET, $DDL_BASE) = (0, 1, 0, './');
52 my ($GET_DDL, $GET_PROCS) = (0, 0);
53 my ($tsfn, $fsfn) = (undef, undef);
54 my ($tso, $fso) = (undef, undef);
55 our (@hosts, @schemas) = ();
56 my $commit_msg = 'Pg ddl updates';
57 my $fn = '/var/tmp/'.(time).".$$";
58 my $default_fn = $fn;
59 my $svnuser = "--username postgres --password password";
60 my (@tables_found, @procs_found);
61 my $do_svn_del = 0;
62 my $svn = '/opt/omni/bin/svn';
63
64 die unless GetOptions(
65     'svn!' => \$DO_SVN,
66     'writeddl!' => \$WRITE_DDL,
67     'ddlbase=s' => \$DDL_BASE,
68     'host=s' => \@hosts,
69     'schema=s' => \@schemas,
70     'commitmsg=s' => \$commit_msg,
71     'quiet!' => \$QUIET,
72     'getprocs!' => \$GET_PROCS,
73     'getddl!' => \$GET_DDL,
74     'commitmsgfn' => \$fn,
75     'tsuppfn=s' => \$tsfn,
76     'fsuppfn=s' => \$fsfn,
77     'svndel' => \$do_svn_del,
78     'svndir=s' => \$svn,
79 );
80 exit if not $GET_DDL and not $GET_PROCS; # nothing to do
81 $DO_SVN = 0 if $WRITE_DDL == 0; # can't compare if we don't write to disk
82 $default_fn = 0 if $fn ne $default_fn;
83
84 $tso = GetDDL::SuppList->new();
85 $tso->load($tsfn) if $tsfn;
86 $fso = GetDDL::SuppList->new();
87 $fso->load($fsfn) if $fsfn;
88
89 my ($DSN, $username, $password, $destdir);
90 my $real_server_name=`hostname`;
91 my $curhost = chomp($real_server_name);
92 my $iters = scalar @hosts;
93 $curhost = shift @hosts if $iters;
94 if (not $iters) {
95     $iters=1;
96     print STDERR "host will default to core-0-3, continue? [y/n] (n): ";
97     exit if <STDIN> !~ /y/i;
98 }
99
100 my $start_time = time();
101
102 sub elapsed_time { return time() - $start_time; }
103
104    
105 my (@to_commit, @to_add);
106 my ($dbh,
107     $tables_h, $columns_h, $constraints_h, $indexes_h, $triggers_h,
108     $functions_h, $getnumargs_h, $funcargs_h);
109
110 # patterns to match names we don't care about
111 my @reject = ();
112 # (lowercase) strings to match the exact names we care about
113 my @only = ();
114
115 ## Fixme - this needs to account for the new data type specific directories. also i dont think it works against remote hosts, but could.
116 my $schema_check = sub {
117     my ($fqn) = @_;
118     if (not scalar @schemas) { return 1 }
119     my ($schema, $objname) = split /\./, $fqn;
120     my @hschemas = grep(/^$curhost\.$schema/ || !/\./, @schemas);
121     for my $s (@hschemas) {
122         return 1
123             if $schema eq $s or $schema eq substr($s, index($s, '.')+1);
124     }
125     return 0;
126 };
127
128 sub svn_check {
129     my (%args) = @_;
130     my $fn = "$args{destdir}/$args{fqn}.sql";
131     my $fh = do { no warnings; local *FH };
132
133     my $fm;
134     if ($args{to_append} == 1) {
135       $fm = ">>";
136     } else {
137       $fm = ">";
138     }
139     open $fh, $fm, $fn or (warn("couldn't create [$fn]: $!\n") && next);
140     print $fh $args{ddl};
141     print "\n";
142     close $fh;
143     chmod 0664, $fn;
144
145     print "  * comparing $args{fqn}\n" if not $QUIET;
146     # svn st, ? = add, m = commit
147     my $svnst = `$args{svn} st $svnuser $args{destdir}`;
148     for my $line (split "\n", $svnst) {
149         next if $line !~ /\.sql$/;
150         if ($line =~ /^\?\s+(\S+)$/) {
151             $fn = $1;
152             if (not $DO_SVN) {
153                 print("svn add $fn\n") if not $QUIET;
154             } else {
155                 push @{$args{to_add}}, $fn;
156             }
157         } elsif ($line =~ /^M\s+\Q$fn/) {
158            if (not $DO_SVN) {
159               print("svn commit $svnuser $fn\n") if not $QUIET;
160            } else {
161               push @{$args{to_commit}}, $fn;
162            }
163         }
164     }
165 }
166
167 # define the sql to pull all the information
168 # we need in order to recreate the ddl
169 my $tables = "
170     SELECT table_schema, table_name
171       FROM information_schema.tables
172      WHERE table_type = 'BASE TABLE'
173        AND table_schema NOT IN ('pg_catalog', 'information_schema')
174      ORDER BY table_schema, table_name
175 ";
176     my $columns = q"
177         SELECT column_name, data_type, column_default, is_nullable,
178                character_maximum_length, numeric_precision, datetime_precision
179           FROM information_schema.columns
180          WHERE table_schema = ? AND table_name = ?
181          ORDER BY ordinal_position
182     ";
183     my $constraints = q"
184         SELECT table_schema, table_name, column_name, constraint_name
185           FROM information_schema.constraint_column_usage
186          WHERE constraint_schema = ? AND constraint_name LIKE ? || '_%'
187          ORDER BY constraint_name
188     ";
189     my $indexes = q"
190         SELECT indexdef
191           FROM pg_indexes
192          WHERE schemaname = ? AND tablename = ? AND indexname NOT LIKE '%_key'
193          ORDER BY indexdef
194     ";
195     my $triggers = q"
196         SELECT trigger_schema, trigger_name, event_manipulation,
197                event_object_schema, event_object_table, action_order,
198                action_condition, action_statement, action_orientation,
199                condition_timing
200           FROM information_schema.triggers
201          WHERE event_object_schema = ? and event_object_table = ?
202          ORDER BY trigger_name
203     ";
204 # and to recreate the function definitions
205 my $functions = q"
206     SELECT
207         upper(l.lanname::text)::information_schema.character_data AS external_language,
208         CASE
209             WHEN t.typelem <> 0::oid AND t.typlen = (-1) THEN 'ARRAY'::text
210             WHEN nt.nspname = 'pg_catalog'::name THEN format_type(t.oid, NULL::integer)
211             ELSE 'USER-DEFINED'::text
212         END::information_schema.character_data AS data_type,
213         'FUNCTION'::character varying::information_schema.character_data AS routine_type,
214         nt.nspname::information_schema.sql_identifier AS type_udt_schema,
215         t.typname::information_schema.sql_identifier AS type_udt_name,
216         n.nspname::information_schema.sql_identifier AS routine_schema,
217         p.proname::information_schema.sql_identifier AS routine_name,
218         CASE
219             WHEN pg_has_role(p.proowner, 'USAGE'::text) THEN p.prosrc
220             ELSE NULL::text
221         END::information_schema.character_data AS routine_definition,
222         p.proargtypes as argident
223     FROM pg_namespace n, pg_proc p, pg_language l, pg_type t, pg_namespace nt
224     WHERE n.oid = p.pronamespace AND p.prolang = l.oid AND p.prorettype = t.oid AND t.typnamespace = nt.oid
225         AND (pg_has_role(p.proowner, 'USAGE'::text) OR has_function_privilege(p.oid, 'EXECUTE'::text))
226         AND n.nspname::information_schema.sql_identifier NOT IN ('pg_catalog', 'information_schema')
227     ORDER BY routine_schema, routine_name
228   ";
229
230     my $getnumargs = q"
231         SELECT
232                CASE WHEN p.proallargtypes IS NULL
233                THEN array_lower(p.proargtypes,1)+1
234                ELSE array_lower(p.proallargtypes,1) END as idx_min,
235                CASE WHEN p.proallargtypes IS NULL
236                THEN array_upper(p.proargtypes,1)+1
237                ELSE array_upper(p.proallargtypes,1) END as idx_max,
238                p.pronargs as n, p.proretset as retset
239           FROM pg_catalog.pg_proc p
240           JOIN pg_catalog.pg_namespace n
241             ON p.pronamespace = n.oid
242          WHERE p.proname = ? AND n.nspname = ? AND p.proargtypes = ?
243     ";
244     my $funcargs = q"
245         SELECT coalesce(pg_catalog.format_type(p.proallargtypes[i.idx], NULL),
246                         pg_catalog.format_type(p.proargtypes[i.idx-1], NULL)) as typename,
247                CASE
248                WHEN p.proallargtypes IS NULL THEN 'i'
249                ELSE p.proargmodes[i.idx] END as iomode,
250                p.proargnames[i.idx] as argname
251           FROM pg_catalog.pg_proc p
252           JOIN pg_catalog.pg_namespace n
253             ON p.pronamespace = n.oid,
254                (select $1::integer as idx) i
255          WHERE p.proname = $2::varchar AND n.nspname = $3::varchar AND p.proargtypes = $4
256     ";
257 # TODO: get user-defined types
258 for (1 .. $iters) {
259     if ($curhost =~ 'core-0-') {
260         $DSN = 'dbname=pagila;host=localhost;';
261         $username = 'postgres';
262         $password = 'password';
263         $destdir = "$DDL_BASE/$curhost";
264     } else {
265         # not understood
266         warn "server nickname '$curhost' not understood, skipping\n";
267         next;
268     }
269
270     # make sure directory exists
271     if ($destdir) {
272         if (!-e $destdir) {
273             mkdir $destdir or die "couldn't create directory target [$destdir]: $!\n";
274             print "created directory target [$destdir]\n";
275         } elsif (!-d $destdir) {
276             die "directory target [$destdir] conflicts with existing file!\n"
277         }
278     }
279
280     $dbh = DBI->connect("dbi:Pg:$DSN", $username, $password) or die "$DBI::errstr\n";
281     print "in $destdir\n" if not $QUIET;
282     goto GET_PROCS if not $GET_DDL;
283
284     # this is what we loop over
285     $tables_h = $dbh->prepare($tables) or die "died preparing: $DBI::errstr\n";
286     $tables_h->execute() or die "died executing: $DBI::errstr\n";
287
288     # these get executed for each table
289     $columns_h = $dbh->prepare($columns) or die "died preparing: $DBI::errstr\n";
290     $constraints_h = $dbh->prepare($constraints) or die "died preparing: $DBI::errstr\n";
291     $indexes_h = $dbh->prepare($indexes) or die "died preparing: $DBI::errstr\n";
292     $triggers_h = $dbh->prepare($triggers) or die "died preparing: $DBI::errstr\n";
293
294   TABLE_ROW:
295     while (my $table_row = $tables_h->fetchrow_hashref()) {
296         my $fqtn = "$table_row->{table_schema}.$table_row->{table_name}";
297
298         # Add the table to the list of tables found, even if we don't end up
299         # processing it.
300         push(@tables_found, $fqtn);
301
302         # hardcoded rejection
303         ($table_row->{table_name} =~ /$_/) && next TABLE_ROW for @reject;
304         # only get specific tables
305         # TODO: make inclusive filtering a cmd-line option
306         next TABLE_ROW if scalar(@only) and not (grep(lc $table_row->{table_name}, @only) and
307              grep(lc $fqtn, @only));
308         # only get host.schema specified on cmd-line
309         next TABLE_ROW if not $schema_check->($fqtn);
310         next if $tso->{suppress}->($fqtn);
311
312         # get the columns for this table
313         $columns_h->execute($table_row->{table_schema}, $table_row->{table_name})
314             or die "died executing columns: $DBI::errstr\n";
315         $table_row->{columns} = [];
316         while (my $column_row = $columns_h->fetchrow_hashref()) {
317             push @{$table_row->{columns}}, $column_row;
318         }
319         $columns_h->finish();
320
321         # get the constraints for this table
322         $constraints_h->execute($table_row->{table_schema}, $table_row->{table_name})
323             or die "died executing constraints: $DBI::errstr\n";
324         $table_row->{constraints} = [];
325         while (my $constraint_row = $constraints_h->fetchrow_hashref()) {
326             push @{$table_row->{constraints}}, $constraint_row;
327         }
328         $constraints_h->finish();
329
330         # get the indexes for this table
331         $indexes_h->execute($table_row->{table_schema}, $table_row->{table_name})
332             or die "died executing indexes: $DBI::errstr\n";
333         $table_row->{indexes} = [];
334         while (my $index_row = $indexes_h->fetchrow_hashref()) {
335             push @{$table_row->{indexes}}, $index_row;
336         }
337         $indexes_h->finish();
338
339         # get the triggers for this table
340         $triggers_h->execute($table_row->{table_schema}, $table_row->{table_name})
341             or die "died executing triggers: $DBI::errstr\n";
342         $table_row->{triggers} = [];
343         while (my $trigger_row = $triggers_h->fetchrow_hashref()) {
344             push @{$table_row->{triggers}}, $trigger_row;
345         }
346         $triggers_h->finish();
347
348
349         # build DDL from queries above
350         my $ddl = "CREATE TABLE $fqtn (\n";
351         for my $col (@{$table_row->{columns}}) {
352             my $vclen = $col->{data_type} =~ /^character/
353                 ? "($col->{character_maximum_length})"
354                 : '';
355             $col->{is_nullable} ||= 'NO'; # get rid of annoying uninit warnings
356             my $nil = $col->{is_nullable} eq 'YES' ? ' NULL' : ' NOT NULL';
357             if (defined $col->{column_default} and $col->{column_default} =~ /^nextval\(/) {
358                 if ($col->{data_type} eq 'integer') {
359                     $col->{data_type} = 'serial';
360                     $col->{column_default} = undef;
361                 } elsif ($col->{data_type} eq 'bigint') {
362                     $col->{data_type} = 'bigserial';
363                     $col->{column_default} = undef;
364                 } elsif ($col->{data_type} eq 'smallint') {
365                     # need to manually create the sequence this references
366                     $ddl = "CREATE SEQUENCE $fqtn\_$col->{column_name}_seq;\n".$ddl;
367                 }
368             }
369             my $default = $col->{column_default} ? " DEFAULT $col->{column_default}" : '';
370             $ddl .= "\t$col->{column_name} $col->{data_type}$vclen$nil$default,\n";
371         }
372         my @pkeys = grep $_->{constraint_name} =~ /_pkey$/, @{$table_row->{constraints}};
373         $ddl .= "\tPRIMARY KEY(".join(',', map($_->{column_name}, @pkeys)).")\n" if @pkeys;
374         $ddl =~ s/,(\s+)$/$1/; # get rid of possible last trailing comma
375         $ddl .= ");\n\n";
376         $ddl .= "$_->{indexdef};\n\n" for @{$table_row->{indexes}||[]};
377         my @fkeys = grep($_->{constraint_name} =~ /_fkey$/, @{$table_row->{constraints}});
378         my %fkeys;
379         for my $fkey (@fkeys) {
380             $fkeys{$fkey->{constraint_name}} ||= [];
381             push @{$fkeys{$fkey->{constraint_name}}}, $fkey;
382         }
383         for my $fkey_name (sort keys %fkeys) {
384             my $cols = join(',', map($_->{column_name}, @{$fkeys{$fkey_name}}));
385             my $row = $fkeys{$fkey_name}[0];
386             $ddl .= "ALTER TABLE $fqtn\n".
387                 "\tADD FOREIGN KEY ($cols) REFERENCES $row->{table_schema}.$row->{table_name}".
388                 "($cols);\n\n"
389         }
390         my %triggers;
391         for my $trigger (@{$table_row->{triggers}}) {
392             $triggers{$trigger->{trigger_name}} ||= [];
393             push @{$triggers{$trigger->{trigger_name}}}, $trigger;
394         }
395         for my $trigger_name (sort keys %triggers) {
396             my $events = join(' OR ', map($_->{event_manipulation}, @{$triggers{$trigger_name}}));
397             my $row = $triggers{$trigger_name}[0];
398             $ddl .= "CREATE TRIGGER $row->{trigger_name}\n".
399                 "$row->{condition_timing} $events ON $row->{event_object_schema}.$row->{event_object_table}\n".
400                 "FOR EACH $row->{action_orientation} $row->{action_statement};\n\n";
401         }
402
403         svn_check(
404             destdir   => $destdir.'/table',
405             fqn       => $fqtn,
406             ddl       => $ddl,
407             svn       => $svn,
408             to_add    => \@to_add,
409             to_commit => \@to_commit,
410             to_append    => 0,
411         );
412     }
413
414     goto CLEANUP if not $GET_PROCS;
415
416 print "Got the DDL after " . elapsed_time() . " seconds.\n";
417    
418   GET_PROCS:
419     $functions_h = $dbh->prepare($functions) or die "died preparing: $DBI::errstr\n";
420     $functions_h->execute() or die "died executing: $DBI::errstr\n";
421
422     $getnumargs_h = $dbh->prepare($getnumargs) or die "died preparing: $DBI::errstr\n";
423     $funcargs_h = $dbh->prepare($funcargs) or die "died preparing: $DBI::errstr\n";
424     my %iomodes = (i => '', io => 'INOUT ', o => 'OUT ');
425     my @functions_found;
426
427   PROC_ROW:
428
429     my $curfqfn=''; # we will use this to look for dupes
430
431     while (my $proc_row = $functions_h->fetchrow_hashref()) {
432         my ($rschema, $rname, $rargs) = ($proc_row->{routine_schema}, $proc_row->{routine_name}, $proc_row->{argident});
433         my $fqfn = "$rschema.$rname";
434
435         my $appendme;
436         if ($fqfn eq $curfqfn) {
437                 $appendme = 1;
438         } else {
439                 $appendme = 0;
440         }
441  
442         $curfqfn = $fqfn;
443
444         # Add the proc name to the procs found, even if we don't end up
445         # processing it.
446         push(@procs_found, $fqfn);
447
448         next PROC_ROW if not $schema_check->($fqfn);
449         next if $fso->{suppress}->($fqfn);
450         $getnumargs_h->execute($rname, $rschema, $rargs) or die "died executing: $DBI::errstr\n";
451         my $nums = $getnumargs_h->fetchrow_hashref();
452         $getnumargs_h->finish();
453         $proc_row->{args} = [];
454         my ($imin, $imax) = ($nums->{idx_min}, $nums->{idx_max});
455         if (defined $imax and $imax >= $imin) {
456             for my $i ($imin .. $imax) {
457                 $funcargs_h->execute($i, $rname, $rschema, $rargs);
458                 push @{$proc_row->{args}}, $funcargs_h->fetchrow_hashref();
459                 $funcargs_h->finish();
460             }
461         }
462
463         my $proc = "CREATE OR REPLACE $proc_row->{routine_type} $rschema.$rname(";
464         $proc .= join(
465             ',', map(
466                 "$iomodes{$_->{iomode}}".($_->{argname}?"$_->{argname} ":'').$_->{typename},
467                 @{$proc_row->{args}}
468             )
469         );
470         $proc .= ")\nRETURNS ".($nums->{retset}?'setof ':'');
471         $proc .= ($proc_row->{data_type} eq 'USER-DEFINED'
472                    ? "$proc_row->{type_udt_schema}.$proc_row->{type_udt_name}"
473                    : $proc_row->{data_type});
474         $proc .= " AS \$\$$proc_row->{routine_definition}\$\$";
475         $proc .= " LANGUAGE '$proc_row->{external_language}';\n";
476         svn_check(
477             destdir   => $destdir.'/function',
478             fqn       => $fqfn,
479             ddl       => $proc,
480             svn       => $svn,
481             to_add    => \@to_add,
482             to_commit => \@to_commit,
483             to_append => $appendme,
484         );
485     }
486
487 print "Got the procedures after " . elapsed_time() . " seconds.\n";
488
489   CLEANUP:
490     # all done, go away
491     print "finished with $curhost, cleaning up...\n" if not $QUIET;
492     $tables_h->finish() if $tables_h;
493     $functions_h->finish() if $functions_h;
494     $dbh->disconnect();
495     print "done.\n" if not $QUIET;
496     $curhost = shift @hosts;
497 }
498
499 if ($DO_SVN) {
500     # FIXME: long cmd lines might be a problem eventually
501     my ($add, $commit, $addcmd, $commitcmd);
502
503     # svn commit -F /path/to/file
504     # so don't have to worry about shell escaping the commit msg
505     if ($default_fn) {
506         open CM, "> $fn" or die "couldn't write [$fn]: $!\n";
507         print CM $commit_msg;
508         close CM;
509     }
510
511     if (scalar @to_commit or scalar @to_add) {
512         if (scalar @to_add) {
513             $addcmd = "$svn add ".join(' ', @to_add);
514             print "The add command is:\n$addcmd\n\n" unless $QUIET;
515             $add = `$addcmd`;
516             print $add if not $QUIET;
517         }
518         $commitcmd = "$svn commit -F $fn $svnuser ".join(' ', @to_commit, @to_add);
519         # print $commitcmd . "\n";
520         $commit = `$commitcmd`;
521         print $commit if not $QUIET;
522     }
523
524     if ($do_svn_del) {
525         if (scalar(@tables_found) > 0 && scalar(@procs_found) > 0) {
526             my @delfiles = files_to_delete();
527
528             if (scalar(@delfiles)==0) {
529                 print "There are no files to delete from the SVN archive.\n";
530             }
531             else {
532            
533                 my $deletecmd = "$svn del $svnuser " . join(" ", @delfiles);
534                 print "The delete command is:\n$deletecmd\n\n" unless $QUIET;
535                 my $delete = `$deletecmd`;
536                 print $delete unless $QUIET;
537
538                 my $commcmd = "$svn commit -F $fn $svnuser " . join(" ", @delfiles);
539                 print "The commit command is:\n$commcmd\n\n" unless $QUIET;
540                 $commit = `$commcmd`;
541                 print $commit unless $QUIET;
542             }
543         }
544         else {
545             print STDERR "The list of present tables and procedure is incomplete.  We don't know for sure what to delete.\n";
546         }
547     }
548     unlink $fn if (-f $fn);
549 }
550
551 print "Cleaned up and finished after " . elapsed_time() . " seconds.\n";
552
553 QUIT: if (0) { }
554
555 END {
556     $tables_h->finish() if $tables_h;
557     $functions_h->finish() if $functions_h;
558     $dbh->disconnect() if $dbh;
559 }
560
561
562 # Get a list of the files on disk to remove from the SVN repository.
563 # The files represent either tables or procedures. If there is a file that was
564 # not found in the scan of tables and procedure then the table or procedure
565 # has been removed and the file also has to go.
566 sub files_to_delete {
567     # Double check that both tables and procedure were scanned. If tables,
568     # f'rinstance, were not scanned then all tables file would be deleted from
569     # the filesystem. We don't want that.
570     if (scalar(@tables_found) == 0 || scalar(@procs_found) == 0) {
571         print STDERR "The list of present tables and procedure is incomplete.  We don't know for sure what to delete.\n";
572         return undef;
573     }
574
575     # Make a hash of all the files representing the tables or procs on disk.
576     my %file_list;
577     my $dirh = DirHandle->new($destdir);
578     while (defined(my $d = $dirh->read())) {
579         $file_list{"$d"} = 1 if (-f "$destdir/$d" && $d =~ m/\.sql$/o);
580     }
581
582     # Go through the list of tables and procs found in the database and
583     # remove the corresponding entry from the file_list.
584     foreach my $f (@tables_found) {
585         delete($file_list{"$f.sql"});
586     }
587     foreach my $f (@procs_found) {
588         delete($file_list{"$f.sql"});
589     }
590
591     # The files that are left in the %file_list are those for which the table
592     # or procedure that they represent has been removed.
593     my @files = map { "$destdir/$_" } keys(%file_list);
594     return @files;
595 }
596
597 =head1 NAME
598
599 getddl - a ddl to svn script for postgres
600
601 =head1 SYNOPSIS
602
603 A perl script to query a postgres database, write schema to file, and then check in said files.
604
605 =head1 VERSION
606
607 This document refers to version 0.5 of getddl, released January 23, 2009
608
609 =head1 USAGE
610
611 To use getddl, you need to configure several variables inside the script (mostly having to do with different connection options). Once configured, you call gettdll at the command line.
612
613 Example 1: grab ddl for both the tables and function and dump it to /db/schema/ridley, check-in any modifications or new objects, and remove any entries that no longer exist in svn.
614
615     perl /home/postgres/getddl.pl --host ridley  --ddlbase /db/schema/ --getddl --getprocs --svn --svndel >>  /home/postgres/logs/getddl.log
616
617 Example 2: grab ddl of only database functions and dump them to /db/schema/kraid/function.
618
619     perl /home/postgres/getddl.pl --host kraid --ddlbase /db/schema --getprocs
620
621
622 =head1 BUGS AND LIMITATIONS
623
624 Some actions may not work on older versions of Postgres (before 8.1).
625
626 Please report any problems to robert@omniti.com.
627
628 =head1 TODO
629
630 =over
631
632 =item * clean up / optimize iteration for items in svn lists
633
634 =item * clean-up default hosts directives
635
636 =item * validate config options vs. command line options
637
638 =item * add support for other rcs systems
639
640 =back
641
642 =head1 LICENSE AND COPYRIGHT
643
644 Copyright (c) 2008 OmniTI, Inc.
645
646 Redistribution and use in source and binary forms, with or without
647 modification, are permitted provided that the following conditions are met:
648
649   1. Redistributions of source code must retain the above copyright notice,
650      this list of conditions and the following disclaimer.
651   2. Redistributions in binary form must reproduce the above copyright notice,
652      this list of conditions and the following disclaimer in the documentation
653      and/or other materials provided with the distribution.
654
655 THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR IMPLIED
656 WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
657 MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
658 EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
659 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
660 OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
661 INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
662 CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
663 IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY
664 OF SUCH DAMAGE.
665
666 =cut
667
668 # vim:ts=4:sw=4:et:is:
669
Note: See TracBrowser for help on using the browser.