Annotation of /trunk/script/wait_admin

#!/usr/bin/perl -w

=head1 NAME

wait_admin - perform administrative tasks on WAIT catalog and meta files

=head1 SYNOPSIS

B<wait_admin>
[B<-database> I<dbname>]
[B<-dir> I<directory>]
[B<-table> I<table name>]
[B<-verbose>]
[B<-debug>]

=head1 OPTIONS

=over 5

=item B<-database> I<dbname>

Specify database name. Default is F<DB>.

=item B<-dir> I<directory>

Alternate directory where databases are located. Default is the
directory specified during configuration of WAIT.

=item B<-table> I<table name>

Specify just one table to check. By default, all tables are checked.

=item B<-quiet>

Supress C<ok:> messages from output.

=item B<-verbose>

Output also informational messages prefixed by C<info:>.

=item B<-debug>

Very chatty output (mostly for debugging) to STDERR. Includes verbose
messages which will go to STDOUT.

=back

=head1 DESCRIPTION

This script will check your database catalog and meta files and interactivly
try to recover from following cases:

=over 5

=item * removing database directory without droping tables first

=item * out of sync catalog and meta file data

=back

This will be done performing following steps:

=over 5

=cut

BEGIN {require WAIT::Config;}

use strict;
use Getopt::Long;
use Data::Dumper;
use Storable qw(store retrieve dclone); # freeze thaw
use Text::Diff;
use Acme::Damn qw(unbless);
use Scalar::Util qw(blessed);   # Acme::Holly?
use IO::File;

my %OPT = (
        database => 'DB',
        dir => $WAIT::Config->{WAIT_home} || '/tmp',
        verbose => 0,
        debug => 0,     ## TODO change to 0 before release!
        quiet => 0,
        );

GetOptions(\%OPT,
           'database=s',
           'dir=s',
           'verbose!',
           'debug!',
           'quiet!',
);

my $catalog_file = "$OPT{dir}/$OPT{database}/catalog";
my $meta_file    = "$OPT{dir}/$OPT{database}/meta";

# logging functions
sub log_info {
        print "info: ",join("",@_),"\n" if ($OPT{'verbose'} || $OPT{'debug'});
}
sub log_ok {
        print "ok: ",join("",@_),"\n" if (!$OPT{'quiet'} || $OPT{'verbose'} || $OPT{'debug'});
}
sub log_warning {
        print "WARNING: ",join("",@_),"\n";
}
sub log_error {
        print "ERROR: ",join("",@_),"\n";
}
sub log_die {
        die "FATAL: ",join("",@_),"\n";
}
sub log_debug {
        print STDERR "debug: ",join("",@_),"\n" if ($OPT{'debug'});
}
# user interaction
sub ask {
        print join("",@_);
        my $ans = <STDIN>;
        chomp($ans);
        return $ans;
}
sub do_fix {
        my $ans = ask(( @_ , " [Y/n]: "));
        $ans ||= 'y';   # default
        if (lc($ans) =~ m/^y/) {
                return 1;
        }
        return 0;
}

# compress tabs to single space
sub compress_tabs {
        my ($p,$t) = @_;
        return $p.(" " x (length($t)/8));
}

sub compDumper {
        my $d = Dumper(shift);
        $d =~ s/^()(\s+)/compress_tabs($1,$2)/gem;
        return $d;
}
        

=item * check existence of catalog and meta files

=cut

if (-r $catalog_file) {
        log_info "using catalog '$catalog_file'";
} else {
        log_die "can't find catalog '$catalog_file': $!";
}

if (-r $meta_file) {
        log_info "using meta '$meta_file'";
} else {
        log_die "can't find meta '$meta_file': $!";
}

=item * read catalog and meta files

=cut

my ($catalog,$meta);

if ($catalog = retrieve($catalog_file)) {
        log_ok "catalog opened with Storable";
} else {
        log_die "catalog unreadable by Storable!";
}

if ($meta = do $meta_file) {
        log_ok "meta read with do";
} else {
        log_warning "do meta failed... trying with cat...";
        $meta = eval `cat $meta_file`;
        if ($meta) {
                log_ok "meta read with cat (why did do failed?)";
        } else {
                log_die "can't cat or do meta file!";
        }
}

=item * compare content of meta and catalog files

Data might differ, depending on ordering of variables in Storable and
Data::Dumper structures and ability to store structure correctly (it seems that there is always difference in one variable).

If differences are found, you will be offered to select master copy (catalog
or meta). You can also accept default none which will skip synchronization
because of differences.

=cut

print STDERR compDumper($catalog,$meta) if ($OPT{'debug'});

my $cc = 0;     # number of changes in catalog

if (Dumper($catalog) ne Dumper($meta)) {
        log_warning "catalog and meta are different!";
        my $diff = diff(\Dumper($catalog),\Dumper($meta), { STYLE => "Unified" });
        $diff =~ s/^([\s\+\-])(\s+)/compress_tabs($1,$2)/gem;

        print STDERR "diff -u catalog meta\n$diff" if ($OPT{'debug'});

        foreach my $d (split(/@@ [+-]\d+,\d+ [+-]\d+,\d+ @@/, $diff)) {

                if ($d =~ m/^\-(.+)$/m && $d =~ m/^\+\Q$1\E/m) {
                        log_debug("false alarm! structure ordering different");
                } elsif ($d) {
                        log_info("here is diff between catalog and meta:\n",$d);
                }
        }

        if ($diff) {
                my $ans=ask("Select master repository to sync to [meta/catalog/NONE]: ");
                if ($ans =~ m/^c/i) {
                        $meta = $catalog;
                        log_info("copied catalog to meta");
                        $cc++;
                } elsif ($ans =~ m/^m/i) {
                        $catalog = $meta;
                        log_info("copied meta to catalog");
                        $cc++;
                } else {
                        log_info("meta and catalog still out of sync!");
                }
        }
} else {
        log_ok "meta and catalog are same\n";
}

# catalog and meta unblessed
my $c = dclone($catalog);
my $m = dclone($meta);

if (my $class = blessed $c) {
        if ($class eq "WAIT::Database") {
                log_ok "top class $class";
                unbless($c);
        } else {
                log_die "unknown top class $class";
        }
}

=item * check for existence of database directory

=cut

my $db_dir = $c->{'file'} ||
        log_die("no database directory in c!");
if (-d $db_dir) {
        log_ok("database directory: '$db_dir' (exists)");
} else {
        log_die("database directory '$db_dir' doesn't exist!");
}

=item * print info about database

This will check if database name and mode is defined, and
report if unique attributes restrction is in effect.

=cut

if ($c->{'name'}) {
        log_info("database name: ",$c->{'name'});
} else {
        log_error("database name is not defined");
}

if ($db_dir =~ m/\/$c->{'name'}$/) {
        log_ok("database directory contains database name");
}

if ($c->{'mode'}) {
        log_info("catalog mode: ",$c->{'mode'});
} else {
        log_error("catalog mode is not defined");
}

my $unique_att = $c->{'uniqueatt'} &&
        log_info("using unique attributes restriction");

=item * list tables in database and check them

If option B<-table> is used, just one table will be checked.

Varous tests on tables will be performed, including correct class blessing,
and testing for table directories.

=cut

my @tables = keys %{$c->{'tables'}};
@tables = qw/$OPT{table}/ if ($OPT{table});

foreach my $t (@tables) {
        log_info "checking table '$t'";
        my $tc = blessed $c->{'tables'}->{$t};
        if ($tc) {
                if ($tc eq "WAIT::Table") {
                        log_ok("table '$t' is $tc");

                        if (-d "$db_dir/$t") {
                                log_info("table directory exists");
                        } else {
                                log_error("can't find directory for table '$t', it should be '$db_dir/$t'");
                                if (do_fix("Do you want to remove table '$t' from database?")) {
                                        delete $catalog->{'tables'}->{$t} || die "can't delete table $t from catalog!";
                                        $cc++;
                                        log_info("table '$t' removed from database $OPT{database}");
                                }
                        }

                } else {
                        log_error("table '$t' should be blessed to WAIT::Table and not to $tc!");
                }
        } else {
                log_error("table '$t' isn't blessed");
        }
}

print STDERR compDumper($catalog) if ($OPT{'debug'});

if ($cc && do_fix("Commit $cc ",($cc == 1 ? "change" : "changes")," to catalog and meta?")) {
        eval { store($catalog, $catalog_file) } ||
                log_die("can't store new catalog in '$catalog_file': $!");
        
        my $fh = new IO::File "> $meta_file";
        if (! $fh) {
                log_error("can't open meta file '$meta_file' for writing: $!");
                log_die("you should probably re-run this tool to make catalog and meta in-sync!");
        }
        my $dd = new Data::Dumper [$catalog],['self'];
        $fh->print('my ');
        $fh->print($dd->Dumpxs) || log_die("problem dumping meta file: $1 (re-run this tool)");
        $fh->close;
}

$WAIT::Config = $WAIT::Config; # make perl -w happy

=head1 WARNING

This script doesn't use locks. So you beter don't run it on live database or
expect that your data might get trashed (so, think again do you want to copy
database first before running this script on it!).

=head1 TODO

Check various conditions and improve recovery.

=head1 AUTHOR

Dobrica Pavlinusic E<lt>F<dpavlin@rot13.org>E<gt>

=cut
1	dpavlin	99	#!/usr/bin/perl -w
2
3			=head1 NAME
4
5			wait_admin - perform administrative tasks on WAIT catalog and meta files
6
7			=head1 SYNOPSIS
8
9			B<wait_admin>
10			[B<-database> I<dbname>]
11			[B<-dir> I<directory>]
12			[B<-table> I<table name>]
13			[B<-verbose>]
14			[B<-debug>]
15
16			=head1 OPTIONS
17
18			=over 5
19
20			=item B<-database> I<dbname>
21
22			Specify database name. Default is F<DB>.
23
24			=item B<-dir> I<directory>
25
26			Alternate directory where databases are located. Default is the
27			directory specified during configuration of WAIT.
28
29			=item B<-table> I<table name>
30
31			Specify just one table to check. By default, all tables are checked.
32
33			=item B<-quiet>
34
35			Supress C<ok:> messages from output.
36
37			=item B<-verbose>
38
39			Output also informational messages prefixed by C<info:>.
40
41			=item B<-debug>
42
43			Very chatty output (mostly for debugging) to STDERR. Includes verbose
44			messages which will go to STDOUT.
45
46			=back
47
48			=head1 DESCRIPTION
49
50			This script will check your database catalog and meta files and interactivly
51			try to recover from following cases:
52
53			=over 5
54
55			=item * removing database directory without droping tables first
56
57			=item * out of sync catalog and meta file data
58
59			=back
60
61			This will be done performing following steps:
62
63			=over 5
64
65			=cut
66
67			BEGIN {require WAIT::Config;}
68
69			use strict;
70			use Getopt::Long;
71			use Data::Dumper;
72			use Storable qw(store retrieve dclone); # freeze thaw
73			use Text::Diff;
74			use Acme::Damn qw(unbless);
75			use Scalar::Util qw(blessed); # Acme::Holly?
76			use IO::File;
77
78			my %OPT = (
79			database => 'DB',
80			dir => $WAIT::Config->{WAIT_home} \|\| '/tmp',
81			verbose => 0,
82			debug => 0, ## TODO change to 0 before release!
83			quiet => 0,
84			);
85
86			GetOptions(\%OPT,
87			'database=s',
88			'dir=s',
89			'verbose!',
90			'debug!',
91			'quiet!',
92			);
93
94			my $catalog_file = "$OPT{dir}/$OPT{database}/catalog";
95			my $meta_file = "$OPT{dir}/$OPT{database}/meta";
96
97			# logging functions
98			sub log_info {
99			print "info: ",join("",@_),"\n" if ($OPT{'verbose'} \|\| $OPT{'debug'});
100			}
101			sub log_ok {
102			print "ok: ",join("",@_),"\n" if (!$OPT{'quiet'} \|\| $OPT{'verbose'} \|\| $OPT{'debug'});
103			}
104			sub log_warning {
105			print "WARNING: ",join("",@_),"\n";
106			}
107			sub log_error {
108			print "ERROR: ",join("",@_),"\n";
109			}
110			sub log_die {
111			die "FATAL: ",join("",@_),"\n";
112			}
113			sub log_debug {
114			print STDERR "debug: ",join("",@_),"\n" if ($OPT{'debug'});
115			}
116			# user interaction
117			sub ask {
118			print join("",@_);
119			my $ans = <STDIN>;
120			chomp($ans);
121			return $ans;
122			}
123			sub do_fix {
124			my $ans = ask(( @_ , " [Y/n]: "));
125			$ans \|\|= 'y'; # default
126			if (lc($ans) =~ m/^y/) {
127			return 1;
128			}
129			return 0;
130			}
131
132			# compress tabs to single space
133			sub compress_tabs {
134			my ($p,$t) = @_;
135			return $p.(" " x (length($t)/8));
136			}
137
138			sub compDumper {
139			my $d = Dumper(shift);
140			$d =~ s/^()(\s+)/compress_tabs($1,$2)/gem;
141			return $d;
142			}
143
144
145			=item * check existence of catalog and meta files
146
147			=cut
148
149			if (-r $catalog_file) {
150			log_info "using catalog '$catalog_file'";
151			} else {
152			log_die "can't find catalog '$catalog_file': $!";
153			}
154
155			if (-r $meta_file) {
156			log_info "using meta '$meta_file'";
157			} else {
158			log_die "can't find meta '$meta_file': $!";
159			}
160
161			=item * read catalog and meta files
162
163			=cut
164
165			my ($catalog,$meta);
166
167			if ($catalog = retrieve($catalog_file)) {
168			log_ok "catalog opened with Storable";
169			} else {
170			log_die "catalog unreadable by Storable!";
171			}
172
173			if ($meta = do $meta_file) {
174			log_ok "meta read with do";
175			} else {
176			log_warning "do meta failed... trying with cat...";
177			$meta = eval `cat $meta_file`;
178			if ($meta) {
179			log_ok "meta read with cat (why did do failed?)";
180			} else {
181			log_die "can't cat or do meta file!";
182			}
183			}
184
185			=item * compare content of meta and catalog files
186
187			Data might differ, depending on ordering of variables in Storable and
188			Data::Dumper structures and ability to store structure correctly (it seems that there is always difference in one variable).
189
190			If differences are found, you will be offered to select master copy (catalog
191			or meta). You can also accept default none which will skip synchronization
192			because of differences.
193
194			=cut
195
196			print STDERR compDumper($catalog,$meta) if ($OPT{'debug'});
197
198			my $cc = 0; # number of changes in catalog
199
200			if (Dumper($catalog) ne Dumper($meta)) {
201			log_warning "catalog and meta are different!";
202			my $diff = diff(\Dumper($catalog),\Dumper($meta), { STYLE => "Unified" });
203			$diff =~ s/^([\s\+\-])(\s+)/compress_tabs($1,$2)/gem;
204
205			print STDERR "diff -u catalog meta\n$diff" if ($OPT{'debug'});
206
207			foreach my $d (split(/@@ [+-]\d+,\d+ [+-]\d+,\d+ @@/, $diff)) {
208
209			if ($d =~ m/^\-(.+)$/m && $d =~ m/^\+\Q$1\E/m) {
210			log_debug("false alarm! structure ordering different");
211			} elsif ($d) {
212			log_info("here is diff between catalog and meta:\n",$d);
213			}
214			}
215
216			if ($diff) {
217			my $ans=ask("Select master repository to sync to [meta/catalog/NONE]: ");
218			if ($ans =~ m/^c/i) {
219			$meta = $catalog;
220			log_info("copied catalog to meta");
221			$cc++;
222			} elsif ($ans =~ m/^m/i) {
223			$catalog = $meta;
224			log_info("copied meta to catalog");
225			$cc++;
226			} else {
227			log_info("meta and catalog still out of sync!");
228			}
229			}
230			} else {
231			log_ok "meta and catalog are same\n";
232			}
233
234			# catalog and meta unblessed
235			my $c = dclone($catalog);
236			my $m = dclone($meta);
237
238			if (my $class = blessed $c) {
239			if ($class eq "WAIT::Database") {
240			log_ok "top class $class";
241			unbless($c);
242			} else {
243			log_die "unknown top class $class";
244			}
245			}
246
247			=item * check for existence of database directory
248
249			=cut
250
251			my $db_dir = $c->{'file'} \|\|
252			log_die("no database directory in c!");
253			if (-d $db_dir) {
254			log_ok("database directory: '$db_dir' (exists)");
255			} else {
256			log_die("database directory '$db_dir' doesn't exist!");
257			}
258
259			=item * print info about database
260
261			This will check if database name and mode is defined, and
262			report if unique attributes restrction is in effect.
263
264			=cut
265
266			if ($c->{'name'}) {
267			log_info("database name: ",$c->{'name'});
268			} else {
269			log_error("database name is not defined");
270			}
271
272			if ($db_dir =~ m/\/$c->{'name'}$/) {
273			log_ok("database directory contains database name");
274			}
275
276			if ($c->{'mode'}) {
277			log_info("catalog mode: ",$c->{'mode'});
278			} else {
279			log_error("catalog mode is not defined");
280			}
281
282			my $unique_att = $c->{'uniqueatt'} &&
283			log_info("using unique attributes restriction");
284
285			=item * list tables in database and check them
286
287			If option B<-table> is used, just one table will be checked.
288
289			Varous tests on tables will be performed, including correct class blessing,
290			and testing for table directories.
291
292			=cut
293
294			my @tables = keys %{$c->{'tables'}};
295			@tables = qw/$OPT{table}/ if ($OPT{table});
296
297			foreach my $t (@tables) {
298			log_info "checking table '$t'";
299			my $tc = blessed $c->{'tables'}->{$t};
300			if ($tc) {
301			if ($tc eq "WAIT::Table") {
302			log_ok("table '$t' is $tc");
303
304			if (-d "$db_dir/$t") {
305			log_info("table directory exists");
306			} else {
307			log_error("can't find directory for table '$t', it should be '$db_dir/$t'");
308			if (do_fix("Do you want to remove table '$t' from database?")) {
309			delete $catalog->{'tables'}->{$t} \|\| die "can't delete table $t from catalog!";
310			$cc++;
311			log_info("table '$t' removed from database $OPT{database}");
312			}
313			}
314
315			} else {
316			log_error("table '$t' should be blessed to WAIT::Table and not to $tc!");
317			}
318			} else {
319			log_error("table '$t' isn't blessed");
320			}
321			}
322
323			print STDERR compDumper($catalog) if ($OPT{'debug'});
324
325			if ($cc && do_fix("Commit $cc ",($cc == 1 ? "change" : "changes")," to catalog and meta?")) {
326			eval { store($catalog, $catalog_file) } \|\|
327			log_die("can't store new catalog in '$catalog_file': $!");
328
329			my $fh = new IO::File "> $meta_file";
330			if (! $fh) {
331			log_error("can't open meta file '$meta_file' for writing: $!");
332			log_die("you should probably re-run this tool to make catalog and meta in-sync!");
333			}
334			my $dd = new Data::Dumper [$catalog],['self'];
335			$fh->print('my ');
336			$fh->print($dd->Dumpxs) \|\| log_die("problem dumping meta file: $1 (re-run this tool)");
337			$fh->close;
338			}
339
340			$WAIT::Config = $WAIT::Config; # make perl -w happy
341
342			=head1 WARNING
343
344			This script doesn't use locks. So you beter don't run it on live database or
345			expect that your data might get trashed (so, think again do you want to copy
346			database first before running this script on it!).
347
348			=head1 TODO
349
350			Check various conditions and improve recovery.
351
352			=head1 AUTHOR
353
354			Dobrica Pavlinusic E<lt>F<dpavlin@rot13.org>E<gt>
355
356			=cut