Initial commit.
This commit is contained in:
211
lib/x86_64/gdbmdump
Executable file
211
lib/x86_64/gdbmdump
Executable file
@@ -0,0 +1,211 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Filename: gdbmdump
|
||||
# Description: Perl script to load/dump the GDBM database
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# Date: 2006-05-12
|
||||
# Copyright: (c) 2006 imacat
|
||||
|
||||
use 5.6.0;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Data::Dumper qw();
|
||||
use Fcntl qw(:flock :seek);
|
||||
use File::Basename qw(basename);
|
||||
use GDBM_File qw(GDBM_READER GDBM_WRCREAT);
|
||||
use Getopt::Long qw(GetOptions);
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub parse_args();
|
||||
sub gdbmdump($$);
|
||||
sub gdbmload($$);
|
||||
sub xfread($);
|
||||
sub xfupdate($$);
|
||||
|
||||
use vars qw($THIS_FILE $VERSION $VERBOSE);
|
||||
$THIS_FILE = basename($0);
|
||||
$VERSION = "1.10";
|
||||
$VERBOSE = 1;
|
||||
|
||||
use vars qw($IS_DUMP $SOURCE $TARGET);
|
||||
|
||||
use vars qw($VERMSG $SHORTHELP $HELPMSG);
|
||||
$VERMSG = "$THIS_FILE v$VERSION by imacat <imacat\@mail.imacat.idv.tw>";
|
||||
$SHORTHELP = "Try `$THIS_FILE --help' for more information.";
|
||||
$HELPMSG = << "EOT";
|
||||
Usage: $THIS_FILE --dump|--load [options] source target
|
||||
Dump/load the GDBM database between different machine types.
|
||||
|
||||
--dump Dump the source GDBM file to the target Data::Dumper output.
|
||||
--load Load the source Data::Dumper output to the target GDBM file.
|
||||
-d,--debug Display debug messages. Multiple --debug to debug more.
|
||||
-q,--quiet Disable debug messages. An opposite that cancels the
|
||||
effect of --debug.
|
||||
-h,--help Display this help.
|
||||
-v,--version Display version number.
|
||||
source The source file.
|
||||
target The target file.
|
||||
|
||||
EOT
|
||||
|
||||
main;
|
||||
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
|
||||
# Parse the arguments
|
||||
parse_args;
|
||||
|
||||
if ($IS_DUMP) {
|
||||
gdbmdump $SOURCE, $TARGET;
|
||||
} else {
|
||||
gdbmload $SOURCE, $TARGET;
|
||||
}
|
||||
|
||||
print STDERR "Done. " . (time - $^T) . " seconds elapsed.\n"
|
||||
if $VERBOSE > 0;
|
||||
return;
|
||||
}
|
||||
|
||||
# parse_args: Parse the arguments
|
||||
sub parse_args() {
|
||||
local ($_, %_);
|
||||
|
||||
# Get the arguments ¨ú±o°Ñ¼Æ
|
||||
eval {
|
||||
local $SIG{__WARN__} = sub { die $_[0]; };
|
||||
Getopt::Long::Configure(qw(no_auto_abbrev bundling));
|
||||
GetOptions( "dump"=>sub { $IS_DUMP = 1; },
|
||||
"load"=>sub { $IS_DUMP = 0; },
|
||||
"debug|d+"=>\$VERBOSE,
|
||||
"quiet|q"=>sub { $VERBOSE-- if $VERBOSE > 0; },
|
||||
"help|h"=>sub { print $HELPMSG; exit 0; },
|
||||
"version|v"=>sub { print "$VERMSG\n"; exit 0; });
|
||||
};
|
||||
die "$THIS_FILE: $@$SHORTHELP\n" if $@ ne "";
|
||||
|
||||
# Show progress
|
||||
$| = 1 if $VERBOSE > 2;
|
||||
|
||||
# Check the action type
|
||||
die "$THIS_FILE: Please specify the action (--dump/--load)\n$SHORTHELP\n"
|
||||
unless defined $IS_DUMP;
|
||||
|
||||
# Set the source and target directory
|
||||
die "$THIS_FILE: Please specify the source file\n$SHORTHELP\n"
|
||||
if @ARGV == 0;
|
||||
$SOURCE = shift @ARGV;
|
||||
die "$THIS_FILE: Please specify the target file\n$SHORTHELP\n"
|
||||
if @ARGV == 0;
|
||||
$TARGET = shift @ARGV;
|
||||
|
||||
die "$THIS_FILE: Too many arguments: $ARGV[0]\n$SHORTHELP\n"
|
||||
if @ARGV > 0;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# gdbmdump: Dump a GDBM database to a Data::Dumper output
|
||||
sub gdbmdump($$) {
|
||||
local ($_, %_);
|
||||
my ($source, $target);
|
||||
($source, $target) = @_;
|
||||
|
||||
tie %_, "GDBM_File", $source, &GDBM_READER, 0444
|
||||
or die "$THIS_FILE: $source: $!";
|
||||
$_ = {%_};
|
||||
untie %_;
|
||||
|
||||
xfupdate $target, Data::Dumper->Dump([$_], [qw($_)]);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# gdbmload: Load a Data::Dumper output to a GDBM database
|
||||
sub gdbmload($$) {
|
||||
local ($_, %_);
|
||||
my ($source, $target);
|
||||
($source, $target) = @_;
|
||||
|
||||
eval xfread $source;
|
||||
|
||||
tie %_, "GDBM_File", $target, &GDBM_WRCREAT, 0444
|
||||
or die "$THIS_FILE: $source: $!";
|
||||
%_ = %$_;
|
||||
untie %_;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# xfread: Read from a file
|
||||
sub xfread($) {
|
||||
local ($_, %_);
|
||||
my ($FH, $file);
|
||||
$file = $_[0];
|
||||
|
||||
# Return as lines
|
||||
if (wantarray) {
|
||||
open $FH, $file or die "$THIS_FILE: $file: $!";
|
||||
flock $FH, LOCK_SH or die "$THIS_FILE: $file: $!";
|
||||
@_ = <$FH>;
|
||||
flock $FH, LOCK_UN or die "$THIS_FILE: $file: $!";
|
||||
close $FH or die "$THIS_FILE: $file: $!";
|
||||
return @_;
|
||||
|
||||
# A scalar file content
|
||||
} else {
|
||||
# Regular files
|
||||
if (-f $file) {
|
||||
my $size;
|
||||
@_ = stat $file or die "$THIS_FILE: $file: $!";
|
||||
$size = $_[7];
|
||||
return "" if $size == 0;
|
||||
open $FH, $file or die "$THIS_FILE: $file: $!";
|
||||
flock $FH, LOCK_SH or die "$THIS_FILE: $file: $!";
|
||||
read $FH, $_, $size or die "$THIS_FILE: $file: $!";
|
||||
flock $FH, LOCK_UN or die "$THIS_FILE: $file: $!";
|
||||
close $FH or die "$THIS_FILE: $file: $!";
|
||||
return $_;
|
||||
|
||||
# Special files
|
||||
} else {
|
||||
open $FH, $file or die "$THIS_FILE: $file: $!";
|
||||
flock $FH, LOCK_SH or die "$THIS_FILE: $file: $!";
|
||||
$_ = join "", <$FH>;
|
||||
flock $FH, LOCK_UN or die "$THIS_FILE: $file: $!";
|
||||
close $FH or die "$THIS_FILE: $file: $!";
|
||||
return $_;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# xfupdate: Update a file
|
||||
sub xfupdate($$) {
|
||||
local ($_, %_);
|
||||
my ($FH, $file, $content);
|
||||
($file, $content) = @_;
|
||||
|
||||
if (-e $file) {
|
||||
open $FH, "+<$file" or die "$THIS_FILE: $file: $!";
|
||||
flock $FH, LOCK_SH or die "$THIS_FILE: $file: $!";
|
||||
$_ = join "", <$FH>;
|
||||
if ($_ ne $content) {
|
||||
seek $FH, 0, SEEK_SET or die "$THIS_FILE: $file: $!";
|
||||
truncate $FH, 0 or die "$THIS_FILE: $file: $!";
|
||||
print $FH $content or die "$THIS_FILE: $file: $!";
|
||||
}
|
||||
flock $FH, LOCK_UN or die "$THIS_FILE: $file: $!";
|
||||
close $FH or die "$THIS_FILE: $file: $!";
|
||||
|
||||
} else {
|
||||
open $FH, ">$file" or die "$THIS_FILE: $file: $!";
|
||||
flock $FH, LOCK_EX or die "$THIS_FILE: $file: $!";
|
||||
print $FH $content or die "$THIS_FILE: $file: $!";
|
||||
flock $FH, LOCK_UN or die "$THIS_FILE: $file: $!";
|
||||
close $FH or die "$THIS_FILE: $file: $!";
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
__END__
|
||||
Reference in New Issue
Block a user