#!/usr/bin/perl
use strict;
# Simple store for key/value pairs. Useful to save away often needed
# URLs and other information for use in support channels etc.
#                                   Public Domain <mfranz # kde : org>
#
# For each of the commands "list", "set", "unset", "get", and "post"
# define a command alias that puts it as argument to the store script:
#
#   list   -> /exec store list
#   set    -> /exec store set
#   unset  -> /exec store unset
#   get    -> /exec store get
#   post   -> /exec store post
#
# Then use these commands like so:
#
#   /list  [<regex>]     ... list all entries [that match the regex]
#   /set   <key>=<value> ... store key/value pair
#   /unset <key>         ... remove key/value pair
#   /get   <key>         ... display value for key (but don't send)
#   /post  <key>         ... send value for key
#
# key/value pairs are stored in this file:
#
my $file = $ENV{HOME} . "/.irc-store";

my $dcopid = shift;		#  konversation
my $server = shift;		#  irc.server.org
my $channel = shift;		#  #channel
my $cmd = shift || "list";	#  list|set|unset|get|post


sub dcop(@) {
	my @cmd = ("dcop", $dcopid, "irc");
	push @cmd, @_;
	system @cmd;
}


sub say($) { &dcop("say", $server, $channel, $_[0]) }
sub info($) { &dcop("info", $_[0]) }
sub error($) { &dcop("error", $_[0]) }
sub die($) { &error($_[0]); die $_[0] }
sub debug($) { &dcop("debug", $_[0]) }
sub line { &dcop("insertRememberLine") }


sub read_store() {
	my %h;
	return %h unless -f $file;
	open STORE, "<", $file || &die("$0: can't open $file: $!");
	foreach (<STORE>) {
		chomp;
		if (/^(\S+?)\s*=\s*(.*)/) {
			$h{$1} = $2;
		} else {
			&error("invalid entry: [$_]");
		}
	}
	close STORE || &die("$0: can't close $file: $!");
	return %h;
}


sub write_store($) {
	my $data = shift;
	open STORE, ">", $file . "~" || &die("$0: can't open $file~: $!");
	foreach (sort keys %$data) {
		print STORE "$_ = $$data{$_}\n";
	}
	close STORE || &die("$0: can't close $file~: $!");
	rename $file . "~", $file;
}


sub print_store($$) {
	my $data = shift;
	my $pattern = shift;
	foreach (sort keys %$data) {
		if (/$pattern/ or $$data{$_} =~ /$pattern/) {
			&info($_ . " = " . $$data{$_});
		}
	}
}


my %data = &read_store;

if ($cmd eq "list") {
	&line;
	&print_store(\%data, shift || ".*");
	&line;

} elsif ($cmd eq "set") {
	my $expr = join " ", @ARGV;
	my ($key, $value);

	if ($expr =~ /^([^\s=]+)\s*=\s*(.*)/ or $expr =~ /^(\S+)\s+(.*)/) {
		($key, $value) = ($1, $2);
	} else {
		&die("invalid set format");
	}

	if (exists $data{$key} and $value ne $data{$key}) {
		&info("set $key = $value  (was: $data{$key})");
	} else {
		&info("set $key = $value");
	}
	$data{$key} = $value;
	&write_store(\%data);

} elsif ($cmd eq "unset") {
	my $key = shift;
	&info("unset $key  (was: $data{$key})");
	delete $data{$key};
	&write_store(\%data);

} elsif ($cmd eq "get") {
	my $which = shift;
	&info($data{$which}) if exists $data{$which};

} elsif ($cmd eq "post") {
	my $which = shift;
	&say("$data{$which}") if exists $data{$which};

} else {
	&error("no such command: $cmd");
}

