Added gui_sweet example
Hauke D
7 years ago
parent
1c268976bb
commit
993d24d38f
@ -0,0 +1,4 @@
|
||||
/public/webperl.js
|
||||
/public/emperl.*
|
||||
/gui_sweet
|
||||
/gui_sweet.exe
|
||||
@ -0,0 +1,44 @@
|
||||
|
||||
WebPerl Advanced GUI Example
|
||||
============================
|
||||
|
||||
Similar to the "WebPerl Basic GUI Example", this is a demo of a GUI
|
||||
using WebPerl, but using [Bootstrap](https://getbootstrap.com/)
|
||||
and [jQuery](https://jquery.com/) instead of plain JavaScript,
|
||||
and [Mojolicious](https://mojolicious.org/) instead of plain Plack.
|
||||
|
||||
To get this to work, you will need to copy the `webperl.js` and the
|
||||
three `emperl.*` files from the main `web` directory to the `public`
|
||||
subdirectory in this project.
|
||||
|
||||
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 `do_pp.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 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>.
|
||||
@ -0,0 +1,23 @@
|
||||
#!/usr/bin/env perl
|
||||
use warnings;
|
||||
use strict;
|
||||
use File::Basename qw/fileparse/;
|
||||
use File::Spec::Functions qw/catfile/;
|
||||
use File::Temp qw/tempfile/;
|
||||
|
||||
# this attempts to locate Mojo's default server.crt/server.key files
|
||||
chomp( my $dir = `perldoc -l Mojo::IOLoop::Server` );
|
||||
die "perldoc -l failed, \$?=$?" if $? || !-e $dir;
|
||||
(undef, $dir) = fileparse($dir);
|
||||
|
||||
# set up a file for pp's -A switch
|
||||
my ($tfh, $tfn) = tempfile(UNLINK=>1);
|
||||
print {$tfh} catfile($dir,'resources','server.crt'),";server.crt\n";
|
||||
print {$tfh} catfile($dir,'resources','server.key'),";server.key\n";
|
||||
close $tfh;
|
||||
|
||||
my @args = (qw/ -a public -a templates -A /, $tfn);
|
||||
|
||||
local $ENV{DOING_PAR_PACKER}=1;
|
||||
system(qw/ pp -o gui_sweet -z 9 -x /,@args,'gui_sweet.pl')==0
|
||||
or die "pp failed, \$?=$?";
|
||||
@ -0,0 +1,77 @@
|
||||
#!/usr/bin/env perl
|
||||
use Mojolicious::Lite;
|
||||
use Mojo::Util qw/md5_sum/;
|
||||
use FindBin;
|
||||
use File::Spec::Functions qw/catdir/;
|
||||
use Browser::Open qw/open_browser/;
|
||||
|
||||
# This is the server-side code.
|
||||
|
||||
my $SERV_PORT = 3000;
|
||||
|
||||
my ($SSLCERTS,$HOMEDIR);
|
||||
BEGIN {
|
||||
$HOMEDIR = $ENV{PAR_TEMP} ? catdir($ENV{PAR_TEMP},'inc') : $FindBin::Bin;
|
||||
chdir $HOMEDIR or die "chdir $HOMEDIR: $!";
|
||||
# do_pp.pl pulls the default Mojo SSL certs into the archive for us
|
||||
$SSLCERTS = $ENV{PAR_TEMP} ? '?cert=./server.crt&key=./server.key' : '';
|
||||
}
|
||||
|
||||
app->static->paths([catdir($HOMEDIR,'public')]);
|
||||
app->renderer->paths([catdir($HOMEDIR,'templates')]);
|
||||
app->secrets(['Hello, Perl World!']);
|
||||
app->types->type(js => "application/javascript");
|
||||
app->types->type(data => "application/octet-stream");
|
||||
app->types->type(mem => "application/octet-stream");
|
||||
app->types->type(wasm => "application/wasm");
|
||||
|
||||
# Authentication and browser-launching stuff (optional)
|
||||
my $TOKEN = md5_sum(rand(1e15).time);
|
||||
hook before_server_start => sub {
|
||||
my ($server, $app) = @_;
|
||||
my @urls = map {Mojo::URL->new($_)->query(token=>$TOKEN)} @{$server->listen};
|
||||
my $url = shift @urls or die "No urls?";
|
||||
if ($ENV{DOING_PAR_PACKER}) {
|
||||
# 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 'USR1', $procpid; exit; } # child
|
||||
print "====> Please wait a few seconds...\n";
|
||||
$SIG{USR1} = sub { $server->stop; exit };
|
||||
}
|
||||
else {
|
||||
print "Attempting to open in browser: $url\n";
|
||||
open_browser($url);
|
||||
}
|
||||
};
|
||||
under sub {
|
||||
my $c = shift;
|
||||
return 1 if ($c->param('token')//'') eq $TOKEN;
|
||||
$c->render(text => 'Bad token!', status => 403);
|
||||
return undef;
|
||||
};
|
||||
|
||||
get '/' => sub { shift->render } => 'index';
|
||||
|
||||
post '/example' => sub {
|
||||
my $c = shift;
|
||||
my $data = $c->req->json;
|
||||
# can do anything here, this is just an example
|
||||
$data->{string} = reverse $data->{string};
|
||||
$c->render(json => $data);
|
||||
};
|
||||
|
||||
app->start('daemon', '-l', "https://localhost:$SERV_PORT$SSLCERTS");
|
||||
|
||||
__DATA__
|
||||
|
||||
@@ index.html.ep
|
||||
% layout 'main', title => 'WebPerl GUI Demo';
|
||||
<main role="main" class="container">
|
||||
<div>
|
||||
<h1>WebPerl Advanced GUI Demo</h1>
|
||||
<p class="lead">Hello, Perl World!</p>
|
||||
<div id="buttons"></div>
|
||||
</div>
|
||||
</main>
|
||||
@ -0,0 +1,44 @@
|
||||
#!perl
|
||||
use warnings;
|
||||
use 5.028;
|
||||
use WebPerl qw/js sub1 encode_json/;
|
||||
|
||||
# This is the code that WebPerl runs in the browser. It is loaded by index.html.
|
||||
|
||||
my $window = js('window');
|
||||
my $document = js('document');
|
||||
my $jq = js('jQuery');
|
||||
|
||||
sub do_ajax {
|
||||
my %args = @_;
|
||||
die "must specify a url" unless $args{url};
|
||||
$args{fail} ||= sub { $window->alert(shift) };
|
||||
$jq->ajax( $args{url}, {
|
||||
$args{data} # when given data, default to POST (JSON), otherwise GET
|
||||
? ( method=>$args{method}||'POST',
|
||||
data=>encode_json($args{data}) )
|
||||
: ( method=>$args{method}||'GET' ),
|
||||
} )->done( sub1 {
|
||||
$args{done}->(shift) if $args{done};
|
||||
} )->fail( sub1 {
|
||||
my ($jqXHR, $textStatus, $errorThrown) = @_;
|
||||
$args{fail}->("AJAX Failed! ($errorThrown)");
|
||||
} )->always( sub1 {
|
||||
$args{always}->() if $args{always};
|
||||
} );
|
||||
return;
|
||||
}
|
||||
|
||||
# slightly hacky way to get the access token, but it works fine
|
||||
my ($token) = $window->{location}{search}=~/\btoken=([a-fA-F0-9]+)\b/;
|
||||
|
||||
my $btn = $jq->('<button>', { text=>"Click me!" } );
|
||||
$btn->click(sub {
|
||||
$btn->prop('disabled',1);
|
||||
do_ajax( url=>"/example?token=$token",
|
||||
data => { string=>"rekcaH lreP rehtonA tsuJ" },
|
||||
done => sub { $window->alert("The server says: ".shift->{string}) },
|
||||
always => sub { $btn->prop('disabled',0); } );
|
||||
} );
|
||||
$btn->appendTo( $jq->('#buttons') );
|
||||
|
||||
@ -0,0 +1,50 @@
|
||||
<!doctype html>
|
||||
<html lang="en-us">
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<title><%= title %></title>
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no">
|
||||
<link rel="stylesheet" href="https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css" integrity="sha384-ggOyR0iXCbMQv3Xipma34MD+dH/1fQ784/j6cY/iJTQUOhcWr7x9JvoRxT2MZw1T" crossorigin="anonymous">
|
||||
<style>
|
||||
body { padding-top: 5rem; }
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<nav class="navbar navbar-expand-md navbar-dark fixed-top bg-dark">
|
||||
<a class="navbar-brand" href="#"><%= title %></a>
|
||||
<button class="navbar-toggler" type="button" data-toggle="collapse" data-target="#navbarCollapse" aria-controls="navbarCollapse" aria-expanded="false" aria-label="Toggle navigation">
|
||||
<span class="navbar-toggler-icon"></span>
|
||||
</button>
|
||||
<div class="collapse navbar-collapse" id="navbarCollapse">
|
||||
<ul class="navbar-nav mr-auto">
|
||||
<li class="nav-item active">
|
||||
<a class="nav-link" href="#">Home <span class="sr-only">(current)</span></a>
|
||||
</li>
|
||||
<li class="nav-item">
|
||||
<a class="nav-link" href="#">Link</a>
|
||||
</li>
|
||||
<li class="nav-item">
|
||||
<a class="nav-link disabled" href="#" tabindex="-1" aria-disabled="true">Disabled</a>
|
||||
</li>
|
||||
<li class="nav-item dropdown">
|
||||
<a class="nav-link dropdown-toggle" href="#" id="dropdown01" data-toggle="dropdown" aria-haspopup="true" aria-expanded="false">Dropdown</a>
|
||||
<div class="dropdown-menu" aria-labelledby="dropdown01">
|
||||
<a class="dropdown-item" href="#">Action</a>
|
||||
<a class="dropdown-item" href="#">Another action</a>
|
||||
<a class="dropdown-item" href="#">Something else here</a>
|
||||
</div>
|
||||
</li>
|
||||
</ul>
|
||||
</div>
|
||||
</nav>
|
||||
|
||||
<%= content %>
|
||||
|
||||
<!-- Bootstrap wants its script tags at the end of the body element, so we'll put everything here: -->
|
||||
<script src="https://code.jquery.com/jquery-3.3.1.min.js" integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=" crossorigin="anonymous"></script>
|
||||
<script src="https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.14.7/umd/popper.min.js" integrity="sha384-UO2eT0CpHqdSJQ6hJty5KVphtPhzWj9WO1clHTMGa3JDZwrnQq4sF86dIHNDz0W1" crossorigin="anonymous"></script>
|
||||
<script src="https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/js/bootstrap.min.js" integrity="sha384-JjSmVgyd0p3pXB1rRibZUAYoIIy6OrQ6VrjIEaFf/nJGzIxFDsf4x0xIM+B07jRM" crossorigin="anonymous"></script>
|
||||
<script src="webperl.js"></script>
|
||||
<script type="text/perl" src="web.pl"></script>
|
||||
</body>
|
||||
</html>
|
||||
Loading…
Reference in New Issue