version 1.2, 2005/03/18 21:36:49
|
version 1.3, 2006/06/27 14:35:24
|
Line 32
|
Line 32
|
use strict; |
use strict; |
use Getopt::Long; |
use Getopt::Long; |
use GDBM_File; |
use GDBM_File; |
|
use lib '/home/httpd/lib/perl/'; |
|
use LONCAPA; |
|
|
# |
# |
# Options |
# Options |
Line 47 Specify the database filename on the com
|
Line 49 Specify the database filename on the com
|
And the Key to remove. |
And the Key to remove. |
Options: |
Options: |
--help Display this help. |
--help Display this help. |
--unescape Unescape the keys and values before printing them out. |
|
-u Same as --unescape |
|
-t Localize times when possible (human readable times) |
-t Localize times when possible (human readable times) |
Example: |
Example: |
dump_db.pl mydata.db "error:" |
dump_db.pl mydata.db "error:" |
Line 59 END
|
Line 59 END
|
my $fname = shift; |
my $fname = shift; |
my $key_to_remove = shift; |
my $key_to_remove = shift; |
|
|
my %db; |
my $dbref =&LONCAPA::locking_hash_tie($fname,&GDBM_WRCREAT()); |
if (! tie(%db,'GDBM_File',$fname,&GDBM_WRITER(),0640)) { |
|
warn "Unable to tie to $fname"; |
if (! $dbref) { |
|
warn("Unable to tie to $fname"); |
exit; |
exit; |
} |
} |
while (my ($key,$value) = each(%db)) { |
while (my ($key,$value) = each(%{$dbref})) { |
if ($key ne $key_to_remove) { next; } |
if ($key ne $key_to_remove) { next; } |
delete($db{$key}); |
delete($dbref->{$key}); |
if ($fname =~ m|/nohist_[^/]*.db|) { exit; } |
if ($fname =~ m|/nohist_[^/]*.db|) { exit; } |
my $hist=$fname; |
my $hist=$fname; |
$hist=~s/\.db$/.hist/; |
$hist=~s/\.db$/.hist/; |
open(HIST,">>$hist"); |
open(HIST,">>$hist"); |
print HIST "D:".time.":$key\n"; |
print HIST ("D:".time.":$key\n"); |
close(HIST); |
close(HIST); |
} |
} |
exit; |
exit; |