Initial commit.

lib/x86_64/gdbmdump

@@ -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__