#! /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__