#!/usr/bin/perl
# Filename:	vidb
# Author:	David Ljung Madison <DaveSource.com>
# See License:	http://MarginalHacks.com/License
# Description:	Edits a database like a text file
use strict;
use BerkeleyDB;

my $PROGNAME = $0;
$PROGNAME =~ s|.*/||;

my $EDITOR = $ENV{EDITOR} || "vi";

my $TMP = "/tmp/$PROGNAME.$$";

##################################################
# Usage
##################################################
sub usage {
	foreach my $msg (@_) { print STDERR "ERROR:  $msg\n"; }
	print STDERR "\n";
	print STDERR "Usage:\t$PROGNAME [-l] [-d] <db>\n";
	print STDERR "\tEdits a database like a text file\n";
	print STDERR "\t-l\tJust list the database contents\n";
	print STDERR "\t-n\tCreate db if not existing\n";
	print STDERR "\n";
	print STDERR "\t-d\tSet debug mode\n";
	print STDERR "\n";
	exit -1;
}

sub parse_args {
	my ($list,@files);
	while (my $arg=shift(@ARGV)) {
		if ($arg =~ /^-h$/) { usage(); }
		if ($arg =~ /^-d$/) { $MAIN::DEBUG=1; next; }
		if ($arg =~ /^-l$/) { $list=1; next; }
		if ($arg =~ /^-n$/) { $MAIN::CREATE=1; next; }
		if ($arg =~ /^-/) { usage("Unknown option: $arg"); }
		push(@files,$arg);
	}
	usage("No database specified") unless @files;
	
	($list,@files);
}

sub debug {
	return unless $MAIN::DEBUG;
	foreach my $msg (@_) { print STDERR "[$PROGNAME] $msg\n"; }
}

##################################################
# Code
##################################################
sub from_db {
	my ($str) = @_;
	$str =~ s/([%\t\n])/"%".sprintf("%0.2x",ord($1))/eg;
	$str;
}
sub to_db {
	my ($str) = @_;
	$str =~ s/%([0-9a-f]{2})/chr(hex($1))/eig;
	$str;
}

sub get_db {
	my ($file) = @_;
	my %db;
	return \%db if (!-e $file && $MAIN::CREATE);
	tie %db, 'BerkeleyDB::Hash',
			-Filename	=> $file,
			-Flags		=> DB_RDONLY,
		or die("Can't read db [$file]");
	my %copy = %db;
	untie %db;
	\%copy;
}

sub list_db {
	my ($file) = @_;
	my $db = get_db($file);
	foreach my $k ( sort keys %$db ) {
		print "$k\t-> $db->{$k}\n";
	}
}

sub edit_db {
	my ($file) = @_;

	# Get the database
	#   Saves a copy (so we know which keys are deleted)
	#   (any keys changed by another process while we are editing are lost)
	my $db = get_db($file);

	# Setup the tmp file
	open(TMP,">$TMP") || die("Couldn't write [$TMP]\n");
	foreach my $k ( sort keys %$db ) {
		print TMP from_db($k),"\t",from_db($db->{$k}),"\n";
		debug("Read: $k\t-> $db->{$k}\n");
	}
	close TMP;

  	my $done=0;
	my %new;
	while (!$done) {
		# Edit the tmp file
		my $mod = -M $TMP;
		system("$EDITOR $TMP");
		return unlink($TMP) unless -M $TMP != $mod;

		# Read in the edits
		$done = 1;
		open(TMP,"<$TMP") || die("Couldn't read [$TMP]\n");
		while(<TMP>) {
			chomp;
			next unless /\S/;
			if (/^([^\t]+)(\t(.+)?)?$/) {
				my ($k,$v) = (to_db($1),to_db($3));
				$new{$k} = $v;
				debug("Wrote: $k->$v\n");
			} else {
# I don't actually think we can ever see errors by the REGEXP above...
				print STDERR "Can't parse database line [$.]:\n  $_";
				$done = 0;
			}
		}
		close TMP;

		# Errors?
		unless ($done) {
			print STDERR "\nE)dit it again, F)orget it?  e";
			# Char mode
			my $ttyname=`/usr/bin/tty`;
			system "/bin/stty -icanon -echo min 1 < $ttyname " if (! $?);
			my $ans;
			read(STDIN,$ans,1);
			# Line mode
			`/usr/bin/tty -s`;
			system "/bin/stty icanon echo < $ttyname " if (! $? ); 
			print "$ans\n";
			return unlink($TMP) if ($ans =~ /F/i);
		}
	}
    unlink($TMP);

	# Write the database
	my %write;
	my $flags = $MAIN::CREATE ? DB_CREATE : 0;
	tie %write, 'BerkeleyDB::Hash',
			-Filename	=> $file,
			-Flags		=> $flags,
		or die("Can't write db [$file]");

	# All the changes/values
	foreach my $k ( keys %new ) {
		$write{$k} = $new{$k};
	}
	# And all the deletions
	foreach my $k ( keys %$db ) {
		delete $write{$k} if $db->{$k} && !defined $new{$k};
	}
}

##################################################
# Main code
##################################################
sub main {
  my ($list,@files) = parse_args();

  foreach my $file ( @files ) {
    $list ? list_db($file) : edit_db($file);
  }
}
main();