From a04bf84819469a5f1387ccf3f9ca7a6ea25d6a3b Mon Sep 17 00:00:00 2001
From: Martin Mares <mj@ucw.cz>
Date: Tue, 5 Jun 2007 00:55:23 +0200
Subject: [PATCH] Added a trivial testing utility for perl-gtk.

---
 submit/gtktest.pl | 73 +++++++++++++++++++++++++++++++++++++++++++++++
 submit/test.pl    | 36 ++++++-----------------
 2 files changed, 81 insertions(+), 28 deletions(-)
 create mode 100755 submit/gtktest.pl

diff --git a/submit/gtktest.pl b/submit/gtktest.pl
new file mode 100755
index 0000000..6347d0c
--- /dev/null
+++ b/submit/gtktest.pl
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Gtk2 -init;
+
+sub timer {
+	print STDERR "Brum!\n";
+	return 1;
+}
+Glib::Timeout->add(5000, \&timer);
+
+my $window = Gtk2::Window->new ('toplevel');
+
+my $b1 = Gtk2::Button->new ('Quit');
+$b1->signal_connect (clicked => sub { Gtk2->main_quit });
+my $b2 = Gtk2::Button->new ('Exit');
+$b2->signal_connect (clicked => sub { Gtk2->main_quit });
+my $b3 = Gtk2::Button->new ('Apage!');
+$b3->signal_connect (clicked => sub { Gtk2->main_quit });
+my $box = Gtk2::HBox->new();
+$box->pack_start_defaults($b1);
+$box->pack_start_defaults($b2);
+$box->pack_start_defaults($b3);
+
+my $bb = Gtk2::Button->new ('Brum!');
+$bb->signal_connect (clicked => sub {
+		my $dialog = Gtk2::MessageDialog->new($window, [qw/modal destroy-with-parent/], 'question', 'ok-cancel', "So what?");
+		$dialog->set_default_response("ok");
+		$dialog->signal_connect (response => sub { $_[0]->destroy });
+		$dialog->show_all;
+	});
+
+my $store = Gtk2::ListStore->new('Glib::Uint', 'Glib::String');
+for (my $i=0; $i<10; $i++) {
+	my $iter = $store->append;
+	$store->set($iter, 0, $i, 1, "Hey ($i)");
+}
+
+my $tree = Gtk2::TreeView->new($store);
+my $rend = Gtk2::CellRendererText->new;
+my $col = Gtk2::TreeViewColumn->new_with_attributes("Int", $rend, "text", 0);
+$tree->append_column($col);
+$col = Gtk2::TreeViewColumn->new_with_attributes("String", $rend, "text", 1);
+$tree->append_column($col);
+
+my $sel = $tree->get_selection;
+$sel->set_mode('single');
+$sel->signal_connect(changed => sub {
+	my $iter = $_[0]->get_selected;
+	my $val = $store->get($iter, 0);
+	print "Selected $val\n";
+	});
+
+my $lay = Gtk2::ScrolledWindow->new;
+$lay->set_policy("automatic", "automatic");
+$lay->add($tree);
+
+my $lab = Gtk2::Label->new;
+$lab->set_markup("<span size='x-large'>Welcome to the Cave</span>");
+
+my $bbox = Gtk2::VBox->new();
+$bbox->pack_start_defaults($lab);
+$bbox->pack_start_defaults($box);
+$bbox->pack_start_defaults($lay);
+$bbox->pack_start_defaults($bb);
+
+$window->signal_connect ("delete-event" => sub { Gtk2->main_quit });
+$window->set ("title" => "Brum");
+$window->add ($bbox);
+$window->show_all;
+Gtk2->main;
diff --git a/submit/test.pl b/submit/test.pl
index 677346c..ff36335 100755
--- a/submit/test.pl
+++ b/submit/test.pl
@@ -32,33 +32,6 @@ if ($z =~ /TLS/) {
 	) or die "Cannot establish TLS connection: " . IO::Socket::SSL::errstr() . "\n";
 }
 
-sub sendobj($) {
-	my ($h) = @_;
-	foreach my $x (keys %{$h}) {
-		print $sk $x, $h->{$x}, "\n";
-	}
-	print $sk "\n";
-	# FIXME: flush
-};
-
-sub recvobj() {
-	my $h = {};
-	while (<$sk>) {
-		chomp;
-		/^(.)(.*)$/ || last;
-		$h->{$1} = $2;
-	}
-	if (defined $h->{'-'}) { die "-" . $h->{'-'} . "\n"; }
-	return $h;
-}
-
-sub printobj($) {
-	my ($h) = @_;
-	foreach my $x (keys %{$h}) {
-		print $x, $h->{$x}, "\n";
-	}
-}
-
 sub req($) {
 	my $x = shift @_;
 	$x->write($sk);
@@ -80,10 +53,17 @@ $req->set("U" => "testuser");
 req($req);
 $reply = reply();
 
+#$req = new Sherlock::Object;
+#$req->set("!" => "SUBMIT", "T" => "plans", "X" => "pas", "S" => 100);
+#req($req);
+#$reply = reply();
+#print $sk "<..................................................................................................>";
+#$reply = reply();
+
 $req = new Sherlock::Object;
 $req->set("!" => "STATUS");
 req($req);
 $reply = reply();
-$reply->write(*STDOUT);
+$reply->write_indented(*STDOUT);
 
 close $sk;
-- 
2.39.2