#!/usr/local/bin/perl -w

use strict;
use Tie::Watch;
use vars '$do_tk';
BEGIN {
    $do_tk = 1;
    eval "use Tk";
    $do_tk = 0 if $@;
}

# Complete documentation on Watch is a pod in the module file.  Watch works on
# plain scalars, arrays, or hashes.  Do *NOT* Watch Tk widgets!  But Watch does
# work OK with Tk otherwise.

my $demos = 'saht';

my $foo;			# Watch variables
my @foo;
my %foo;

my %vinfo;			# variable Watch information
my $date;			# a changing time

my $w_scalar;			# Watch objects
my $w_array;
my $w_hash;

my $fetch_scalar = sub {
    my($self) = @_;
    $self->Fetch;
};

my $store_scalar = sub {
    my($self, $new_val) = @_;
    $self->Store(uc $new_val);
};

my $fetch = sub {
    my($self, $key) = @_;
    my $val = $self->Fetch($key);
    print "In fetch callback, key=$key, val=", $self->Say($val);
    my $args = $self->Args(-fetch);
    print ", args=('", join("', '",  @$args), "')" if $args;
    print ".\n";
    $val;
};

my $store = sub {
    my($self, $key, $new_val) = @_;
    my $val = $self->Fetch($key);
    $new_val = uc $new_val;
    $self->Store($key, $new_val);
    print "In store callback, key=$key, val=", $self->Say($val), 
      ", new_val=", $self->Say($new_val);
    my $args = $self->Args(-store);
    print ", args=('", join("', '",  @$args), "')" if $args;
    print ".\n";
    $new_val;
};

if ($demos =~ /s/) {
    chomp($date = `date`); $date = substr $date, 11, 8;
    $foo='frog';
    $w_scalar = Tie::Watch->new(
        -variable => \$foo,
	-fetch    => $fetch_scalar,
	-store    => $store_scalar,
	-destroy  => sub {print "Final value of \$foo=$foo.\n"},
	-debug    => 1,
    );
    $foo = "hello scalar";
    print "Final value: $foo\n";
    %vinfo = $w_scalar->Info;
    print "Watch info  :\n  ", join("\n  ", @{$vinfo{-legible}}), "\n";
    $w_scalar->Unwatch;
    sleep 1;
}

if ($demos =~ /a/) {
    print "\n********** Test Watch Array **********\n";
    chomp($date = `date`); $date = substr $date, 11, 8;
    $w_array = Tie::Watch->new(
        -variable => \@foo,
	-fetch    => $fetch,
	-store    => [$store, 'array write', $date],
    );
    @foo = ("hello", 'array');
    my($a, $b) = ($foo[0], $foo[1]);
    print "Final value: $a $b\n";
    %vinfo = $w_array->Info;
    print "Watch info  :\n  ", join("\n  ", @{$vinfo{-legible}}), "\n";
    $w_array->Unwatch;
    sleep 1;
}

if ($demos =~ /h/) {
    print "\n********** Test Watch Hash **********\n";
    chomp($date = `date`); $date = substr $date, 11, 8;
    $w_hash = Tie::Watch->new(
        -variable => \%foo,
	-fetch    => [$fetch, 'hash read', $date],
	-store    => $store,			  
    );
    %foo = ('k1' => "hello", 'k2' => 'hash ');
    my($a, $b) = ($foo{k1}, $foo{k2});
    print "Final value: $a $b\n";
    %vinfo = $w_hash->Info;
    print "Watch info  :\n  ", join("\n  ", @{$vinfo{-legible}}), "\n";
    foreach (keys %foo) {
	print "key=$_, value=$foo{$_}.\n";
    }
    if (exists $foo{k2}) {
	print "k2 does exist\n";
    } else {
	print "k2 does not exists\n";
    }
    delete $foo{k2};
    if (exists $foo{k2}) {
	print "k2 does exist\n";
    } else {
	print "k2 does not exist\n";
    }
    print "keys=", join(', ', keys %foo), ".\n";
    print "\n";
    $w_hash->Unwatch
}

print "For a Tk example, run tktie.\n";