Added gui_basic example

experiments/gui_basic/.gitignore

@@ -0,0 +1,5 @@
+/database.db
+/web/webperl.js
+/web/emperl.*
+/gui_basic
+/gui_basic.exe

experiments/gui_basic/README.md

@@ -0,0 +1,50 @@
+
+WebPerl Basic GUI Example
+=========================
+
+This is a demo of a very basic GUI using WebPerl. It consists of a
+local web server, which includes code to access an SQLite database,
+and this web server also serves up WebPerl code to a browser, where
+the GUI is implemented as HTML with Perl.
+
+To get this to work, you will need to copy the `webperl.js` and three
+`emperl.*` files from the main `web` directory to the `web`
+subdirectory in this project.
+
+Note that this should not be considered production-ready, as there
+are several key features missing, such as HTTPS or access control.
+
+Also, a limitation is that the server does not know when the browser
+window is closed, so it must be stopped manually.
+
+You can pack this application into a single executable using:
+
+	DOING_PAR_PACKER=1 pp -o gui_basic -z 9 -x -a gui_basic_app.psgi -a web gui_basic.pl
+
+Note: I'm not yet sure why, but sometimes this fails with errors such
+as *"error extracting info from -c/-x file"*, in that case just try
+the above command again.
+
+
+Author, Copyright, and License
+==============================
+
+**WebPerl - <http://webperl.zero-g.net>**
+
+Copyright (c) 2019 Hauke Daempfling (haukex@zero-g.net)
+at the Leibniz Institute of Freshwater Ecology and Inland Fisheries (IGB),
+Berlin, Germany, <http://www.igb-berlin.de>
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl 5 itself: either the GNU General Public
+License as published by the Free Software Foundation (either version 1,
+or, at your option, any later version), or the "Artistic License" which
+comes with Perl 5.
+
+This program is distributed in the hope that it will be useful, but
+**WITHOUT ANY WARRANTY**; without even the implied warranty of
+**MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE**.
+See the licenses for details.
+
+You should have received a copy of the licenses along with this program.
+If not, see <http://perldoc.perl.org/index-licence.html>.

experiments/gui_basic/gui_basic.pl

@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+use warnings;
+use 5.018;
+use FindBin;
+use File::Spec::Functions qw/catdir/;
+use Plack::Runner ();
+use Starman ();
+use Browser::Open qw/open_browser/;
+
+# This just serves up gui_basic_app.psgi in the Starman web server.
+# You can also say "plackup gui_basic_app.psgi" instead.
+
+BEGIN {
+	my $dir = $ENV{PAR_TEMP} ? catdir($ENV{PAR_TEMP},'inc') : $FindBin::Bin;
+	chdir $dir or die "chdir $dir: $!";
+}
+
+my $SERV_PORT = 5000;
+my $THE_APP = 'gui_basic_app.psgi';
+
+# AFAICT, both Plack::Runner->new(@args) and ->parse_options(@argv) set
+# options, and these options are shared between "Starman::Server"
+# (documented in "starman") and "Plack::Runner" (documented in "plackup").
+my @args = (
+	server => 'Starman', loader => 'Delayed', env => 'development',
+	version_cb => sub { print "Starman $Starman::VERSION\n" } );
+my @argv = ( '--listen', "localhost:$SERV_PORT", $THE_APP );
+my $runner = Plack::Runner->new(@args);
+$runner->parse_options(@argv);
+$runner->set_options(argv => \@argv);
+die "loader shouldn't be Restarter" if $runner->{loader} eq 'Restarter';
+
+if ($ENV{DOING_PAR_PACKER}) {
+	require Plack::Util;
+	Plack::Util::load_psgi($THE_APP); # for dependency resolution
+	# arrange to have the server shut down in a few moments
+	my $procpid = $$;
+	my $pid = fork();
+	if (!defined $pid) { die "fork failed" }
+	elsif ($pid==0) { sleep 5; kill 'INT', $procpid; exit; } # child
+	print "====> Please wait a few seconds...\n";
+}
+else {
+	# There's a small chance here that the browser could open before the server
+	# starts up. In that case, a reload of the browser window is needed.
+	print "Attempting to open in browser: http://localhost:$SERV_PORT/\n";
+	open_browser("http://localhost:$SERV_PORT/");
+}
+
+$runner->run;

experiments/gui_basic/gui_basic_app.psgi

@@ -0,0 +1,67 @@
+#!/usr/bin/env perl
+use warnings;
+use 5.018;
+use Plack::MIME;
+use Plack::Builder qw/builder enable mount/;
+use Plack::Request ();
+use Plack::Response (); # declare compile-time dependency
+use Cpanel::JSON::XS qw/decode_json encode_json/;
+use DBI ();
+use DBD::SQLite (); # declare compile-time dependency
+use HTML::Tiny ();
+
+# This is the server-side code.
+
+# note we rely on gui_basic.pl to set the working directory correctly
+my $SERV_ROOT = 'web';
+my $DB_FILE = 'database.db';
+
+my $dbh = DBI->connect("DBI:SQLite:dbname=$DB_FILE",
+	undef, undef, { RaiseError=>1, AutoCommit=>1 });
+
+$dbh->do(q{ CREATE TABLE IF NOT EXISTS FooBar (
+	foo VARCHAR(255), bar VARCHAR(255) ) });
+
+# This sends HTML to the browser, but we could also send JSON
+# and build the HTML table dynamically in the browser.
+my $app_select = sub {
+	state $html = HTML::Tiny->new;
+	state $sth_select = $dbh->prepare(q{ SELECT rowid,foo,bar FROM FooBar });
+	$sth_select->execute;
+	my $data = $sth_select->fetchall_arrayref;
+	my $out = $html->table(
+		[ \'tr',
+			[ \'th', 'rowid', 'foo', 'bar' ],
+			map { [ \'td', @$_ ] } @$data
+		] );
+	return [ 200, [ "Content-Type"=>"text/html" ], [ $out ] ];
+};
+
+# This is an example of one way to communicate with JSON.
+my $app_insert = sub {
+	my $req = Plack::Request->new(shift);
+	state $sth_insert = $dbh->prepare(q{ INSERT INTO FooBar (foo,bar) VALUES (?,?) });
+	my $rv = eval { # catch errors and return as 500 Server Error
+		my $content = decode_json( $req->content );
+		$sth_insert->execute($content->{foo}, $content->{bar});
+		{ ok=>1 }; # return value from eval, sent to client as JSON
+	}; my $e = $@||'unknown error';
+	my $res = $req->new_response($rv ? 200 : 500);
+	$res->content_type($rv ? 'application/json' : 'text/plain');
+	$res->body($rv ? encode_json($rv) : 'Server Error: '.$e);
+	return $res->finalize;
+};
+
+Plack::MIME->add_type(".js"   => "application/javascript");
+Plack::MIME->add_type(".data" => "application/octet-stream");
+Plack::MIME->add_type(".mem"  => "application/octet-stream");
+Plack::MIME->add_type(".wasm" => "application/wasm");
+
+builder {
+	enable 'SimpleLogger';
+	enable 'Static',
+		path => sub { s#\A/\z#/index.html#; /\.(?:html?|js|css|data|mem|wasm|pl)\z/i },
+		root => $SERV_ROOT;
+	mount '/select' => $app_select;
+	mount '/insert' => $app_insert;
+}

experiments/gui_basic/web/index.html

@@ -0,0 +1,32 @@
+<!doctype html>
+<html lang="en-us">
+<head>
+	<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+	<title>WebPerl GUI Demo</title>
+	<script src="webperl.js"></script>
+	<script type="text/perl" src="web.pl"></script>
+</head>
+<body style="font-family:sans-serif;">
+<h1>WebPerl GUI Demo</h1>
+
+<div id="datatable"><i>No data loaded yet...</i></div>
+<div><button id="reload_data">Reload Data</button></div>
+
+<div style="margin-top:1em">
+	<div>
+		<label for="input_foo">foo</label>
+		<input type="text" id="input_foo">
+	</div>
+	<div>
+		<label for="input_bar">bar</label>
+		<input type="text" id="input_bar">
+	</div>
+	<div>
+		<button id="do_insert">Insert Data</button>
+	</div>
+</div>
+
+<p>Powered by <a href="http://webperl.zero-g.net" target="_blank">WebPerl</a> (beta)</p>
+
+</body>
+</html>

experiments/gui_basic/web/web.pl

@@ -0,0 +1,69 @@
+#!perl
+use warnings;
+use 5.028;
+use WebPerl qw/js js_new sub1 encode_json/;
+
+# This is the code that WebPerl runs in the browser. It is loaded by index.html.
+
+sub do_xhr {
+	my %args = @_;
+	die "must specify a url" unless $args{url};
+	$args{fail} ||= sub { js('window')->alert(shift) };
+	my $xhr = js_new('XMLHttpRequest');
+	$xhr->addEventListener("error", sub1 {
+			$args{fail}->("XHR Error on $args{url}: ".(shift->{textContent}||"unknown"));
+			return;
+		});
+	$xhr->addEventListener("load", sub1 {
+			if ($xhr->{status}==200) {
+				$args{done}->($xhr->{response}) if $args{done};
+			}
+			else {
+				$args{fail}->("XHR Error on $args{url}: ".$xhr->{status}." ".$xhr->{statusText});
+			}
+			return;
+		});
+	$xhr->addEventListener("loadend", sub1 {
+			$args{always}->() if $args{always};
+			return;
+		});
+	# when given data, default to POST (JSON), otherwise GET
+	if ($args{data}) {
+		$xhr->open($args{method}||'POST', $args{url});
+		$xhr->setRequestHeader('Content-Type', 'application/json');
+		$xhr->send(encode_json($args{data}));
+	}
+	else {
+		$xhr->open($args{method}||'GET', $args{url});
+		$xhr->send();
+	}
+	return;
+}
+
+my $document = js('document');
+
+my $btn_reload = $document->getElementById('reload_data');
+sub do_reload {
+	state $dtbl = $document->getElementById('datatable');
+	$btn_reload->{disabled} = 1;
+	do_xhr(url => 'select',
+		done   => sub { $dtbl->{innerHTML} = shift; },
+		always => sub { $btn_reload->{disabled} = 0; } );
+	return;
+}
+$btn_reload->addEventListener("click", \&do_reload);
+
+my $btn_insert = $document->getElementById('do_insert');
+sub do_insert {
+	state $txt_foo = $document->getElementById('input_foo');
+	state $txt_bar = $document->getElementById('input_bar');
+	$btn_insert->{disabled} = 1;
+	do_xhr(url => 'insert',
+		data => { foo=>$txt_foo->{value}, bar=>$txt_bar->{value} },
+		always => sub { $btn_insert->{disabled} = 0; do_reload; } );
+	return;
+}
+$btn_insert->addEventListener("click", \&do_insert);
+
+do_reload; # initial load
+