Compare commits
78 Commits
v0.07-beta
...
master
| Author | SHA1 | Date |
|---|---|---|
Hauke D
|
16bc09d89a | 6 years ago |
|
Hauke D
|
d1206e84fb | 6 years ago |
|
Hauke D
|
00e738560f | 6 years ago |
|
Hauke D
|
993d24d38f | 7 years ago |
|
Hauke D
|
1c268976bb | 7 years ago |
|
Hauke D
|
5306c3b819 | 7 years ago |
|
Hauke D
|
ac50d81bc2 | 7 years ago |
|
Hauke D
|
6f2173d29a | 7 years ago |
|
Hauke D
|
22b608c572 | 7 years ago |
|
Hauke D
|
32a3bbb8a1 | 7 years ago |
|
Hauke D
|
ad53548513 | 7 years ago |
|
Hauke D
|
6be93653bf | 7 years ago |
|
Hauke D
|
09bd3384e2 | 7 years ago |
|
Hauke D
|
fe8e030cdc | 7 years ago |
|
Hauke D
|
3e8acce5f3 | 7 years ago |
|
Hauke D
|
f7b5822176 | 7 years ago |
|
Hauke D
|
0f67a1cbfa | 7 years ago |
|
Hauke D
|
1c9a0c9dbf | 7 years ago |
|
Hauke D
|
7dd3d9fbe1 | 7 years ago |
|
Hauke D
|
25bc332853 | 7 years ago |
|
Hauke D
|
edde6ab854 | 7 years ago |
|
Hauke D
|
29023c59c5 | 7 years ago |
|
Hauke D
|
8de1094002 | 7 years ago |
|
Hauke D
|
a8f0ba120e | 7 years ago |
|
Hauke D
|
d856a1b817 | 7 years ago |
|
Hauke D
|
3d90c22fe7 | 7 years ago |
|
Hauke D
|
1381ced6fe | 7 years ago |
|
Hauke D
|
287e449c5e | 7 years ago |
|
Hauke D
|
be58e94d75 | 7 years ago |
|
Hauke D
|
0b00c652d7 | 7 years ago |
|
Hauke D
|
1b66b69563 | 7 years ago |
|
Hauke D
|
96a5016e22 | 7 years ago |
|
Hauke D
|
25a5ca99ad | 7 years ago |
|
Hauke D
|
b97040cccc | 7 years ago |
|
Hauke D
|
7577c5d6d7 | 7 years ago |
|
Hauke D
|
6d8fad9b1a | 7 years ago |
|
Hauke D
|
c3adf73863 | 7 years ago |
|
Hauke D
|
c0021d8214 | 7 years ago |
|
Hauke D
|
f03b6a93e6 | 7 years ago |
|
Hauke D
|
94d11c36e9 | 7 years ago |
|
Hauke D
|
de081b1d70 | 7 years ago |
|
Hauke D
|
e00b0a148b | 7 years ago |
|
Hauke D
|
9e5319bbfc | 7 years ago |
|
Hauke D
|
e79f03687e | 7 years ago |
|
Hauke D
|
93c3bf4e38 | 7 years ago |
|
Hauke D
|
32fafd2669 | 7 years ago |
|
Hauke D
|
93b73c04db | 7 years ago |
|
Hauke D
|
2ef4af02cb | 7 years ago |
|
Hauke D
|
f70e5a09f4 | 7 years ago |
|
Hauke D
|
aa2cf82a03 | 7 years ago |
|
Hauke D
|
457f54d5ad | 7 years ago |
|
Hauke D
|
226e65255f | 7 years ago |
|
Hauke D
|
b2e76c280d | 7 years ago |
|
Hauke D
|
2f4eff19a1 | 7 years ago |
|
Hauke D
|
310bb92b2c | 7 years ago |
|
Hauke D
|
bf660de3c5 | 7 years ago |
|
Hauke D
|
6aeddd3be9 | 7 years ago |
|
Hauke D
|
07f72bd8dd | 7 years ago |
|
Hauke D
|
e12f1aa25a | 7 years ago |
|
Hauke D
|
ab287a5f4c | 7 years ago |
|
Hauke D
|
2f695e9f31 | 7 years ago |
|
Hauke D
|
904fa53a05 | 7 years ago |
|
Hauke D
|
b04ac672d5 | 7 years ago |
|
Hauke D
|
4718404b50 | 7 years ago |
|
Hauke D
|
8f5c7b177b | 7 years ago |
|
Hauke D
|
fde975c853 | 7 years ago |
|
Hauke D
|
044c55394e | 7 years ago |
|
Hauke D
|
1784206275 | 7 years ago |
|
Hauke D
|
fd678a6d9f | 7 years ago |
|
Hauke D
|
4a7dd5709b | 7 years ago |
|
Hauke D
|
b87f932e93 | 7 years ago |
|
Hauke D
|
b5afdc6a4e | 7 years ago |
|
Hauke D
|
792b4ebd7d | 7 years ago |
|
Hauke D
|
afc877f6c4 | 7 years ago |
|
Hauke D
|
52271aeafe | 7 years ago |
|
Hauke D
|
1cac09ccf3 | 7 years ago |
|
Hauke D
|
d7d5541428 | 7 years ago |
|
Hauke D
|
c9deeccb0c | 7 years ago |
@ -0,0 +1,4 @@
|
|||||||
|
# See http://bitbucket.org/haukex/htools/src/HEAD/htmlrescache
|
||||||
|
# Set up via: htmlrescache -cweb/_cache init
|
||||||
|
/web/*.html filter=htmlrescache
|
||||||
|
/web/**/*.html filter=htmlrescache
|
||||||
@ -1,29 +0,0 @@
|
|||||||
|
|
||||||
WebPerl TODOs
|
|
||||||
=============
|
|
||||||
|
|
||||||
<http://webperl.zero-g.net>
|
|
||||||
|
|
||||||
1. Documentation (Website)
|
|
||||||
|
|
||||||
- Check if intra-page links work
|
|
||||||
|
|
||||||
2. Testing
|
|
||||||
|
|
||||||
- Continue work on `WebPerl.t`
|
|
||||||
- More tests for Unicode support (Perl/JS interface, Perl.eval(), plus Emscripten's virtual FS)
|
|
||||||
- Focus on getting the tests running in the browser instead of node.js
|
|
||||||
- How to best package tests?
|
|
||||||
- If possible, a separate bundle, so that it can be loaded optionally and we don't need to rebuild
|
|
||||||
- How does `make test` find and handle all the various modules' `t`s?
|
|
||||||
- How to best disable individual tests that we know won't work? (qx etc.)
|
|
||||||
- How to handle the many tests that call an external Perl?
|
|
||||||
- patching t/test.pl's runperl() seems easiest at the moment, and we can use the iframe method from the IDE
|
|
||||||
|
|
||||||
3. Misc
|
|
||||||
|
|
||||||
- Test if a CDN would work
|
|
||||||
- Perhaps create a CPAN Bundle:: module or similar for `build.pl` deps?
|
|
||||||
|
|
||||||
See also: "TODO" tags in code (use `findtodo.sh`)
|
|
||||||
|
|
||||||
@ -0,0 +1,15 @@
|
|||||||
|
|
||||||
|
# Install the dependencies for "build" via:
|
||||||
|
# $ cpanm --installdeps .
|
||||||
|
|
||||||
|
requires 'Data::Dump';
|
||||||
|
requires 'Path::Class';
|
||||||
|
requires 'IPC::Run3::Shell', '0.56';
|
||||||
|
requires 'URI';
|
||||||
|
requires 'Net::SSLeay', 1.49;
|
||||||
|
requires 'IO::Socket::SSL', '1.56';
|
||||||
|
requires 'Cpanel::JSON::XS';
|
||||||
|
requires 'File::Copy::Recursive';
|
||||||
|
requires 'File::Replace', '0.08';
|
||||||
|
requires 'Pod::Strip';
|
||||||
|
requires 'Archive::Zip';
|
||||||
@ -0,0 +1,20 @@
|
|||||||
|
--- library.js.orig 2019-03-02 16:08:24.404047130 +0100
|
||||||
|
+++ library.js 2019-03-02 16:19:30.588047130 +0100
|
||||||
|
@@ -291,7 +291,7 @@
|
||||||
|
// pid_t fork(void);
|
||||||
|
// http://pubs.opengroup.org/onlinepubs/000095399/functions/fork.html
|
||||||
|
// We don't support multiple processes.
|
||||||
|
- ___setErrNo({{{ cDefine('EAGAIN') }}});
|
||||||
|
+ ___setErrNo({{{ cDefine('ENOTSUP') }}});
|
||||||
|
return -1;
|
||||||
|
},
|
||||||
|
vfork: 'fork',
|
||||||
|
@@ -817,7 +817,7 @@
|
||||||
|
// int system(const char *command);
|
||||||
|
// http://pubs.opengroup.org/onlinepubs/000095399/functions/system.html
|
||||||
|
// Can't call external programs.
|
||||||
|
- ___setErrNo({{{ cDefine('EAGAIN') }}});
|
||||||
|
+ ___setErrNo({{{ cDefine('ENOTSUP') }}});
|
||||||
|
return -1;
|
||||||
|
},
|
||||||
|
|
||||||
@ -0,0 +1,19 @@
|
|||||||
|
--- library.js.orig 2020-05-18 17:14:18.682328912 +0200
|
||||||
|
+++ library.js 2020-05-18 17:14:48.366639562 +0200
|
||||||
|
@@ -271,7 +271,7 @@
|
||||||
|
// pid_t fork(void);
|
||||||
|
// http://pubs.opengroup.org/onlinepubs/000095399/functions/fork.html
|
||||||
|
// We don't support multiple processes.
|
||||||
|
- setErrNo({{{ cDefine('EAGAIN') }}});
|
||||||
|
+ setErrNo({{{ cDefine('ENOTSUP') }}});
|
||||||
|
return -1;
|
||||||
|
},
|
||||||
|
vfork: 'fork',
|
||||||
|
@@ -696,7 +696,7 @@
|
||||||
|
// http://pubs.opengroup.org/onlinepubs/000095399/functions/system.html
|
||||||
|
// Can't call external programs.
|
||||||
|
if (!command) return 0; // no shell available
|
||||||
|
- setErrNo({{{ cDefine('EAGAIN') }}});
|
||||||
|
+ setErrNo({{{ cDefine('ENOTSUP') }}});
|
||||||
|
return -1;
|
||||||
|
},
|
||||||
@ -0,0 +1,8 @@
|
|||||||
|
|
||||||
|
# Install the dependencies for "web" via:
|
||||||
|
# $ cpanm --installdeps .
|
||||||
|
|
||||||
|
requires 'Cpanel::JSON::XS';
|
||||||
|
requires 'Plack';
|
||||||
|
requires 'Plack::Middleware::CrossOrigin';
|
||||||
|
requires 'Plack::Middleware::Auth::Digest';
|
||||||
@ -0,0 +1,8 @@
|
|||||||
|
|
||||||
|
# Install the dependencies for "experiments" via:
|
||||||
|
# $ cpanm --installdeps .
|
||||||
|
|
||||||
|
requires 'Data::Dump';
|
||||||
|
requires 'Graph';
|
||||||
|
requires 'MetaCPAN::Client';
|
||||||
|
requires 'Path::Class';
|
||||||
@ -0,0 +1,5 @@
|
|||||||
|
/database.db
|
||||||
|
/web/webperl.js
|
||||||
|
/web/emperl.*
|
||||||
|
/gui_basic
|
||||||
|
/gui_basic.exe
|
||||||
@ -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 the
|
||||||
|
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>.
|
||||||
@ -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;
|
||||||
@ -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;
|
||||||
|
}
|
||||||
@ -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>
|
||||||
@ -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
|
||||||
|
|
||||||
@ -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>
|
||||||
@ -0,0 +1,50 @@
|
|||||||
|
<!doctype html>
|
||||||
|
<html lang="en-us">
|
||||||
|
<head>
|
||||||
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
|
||||||
|
<title>WebPerl Perl 6 Demos (Experimental)</title>
|
||||||
|
|
||||||
|
<script src="webperl.js"></script>
|
||||||
|
|
||||||
|
<!-- Please see the documentation at http://webperl.zero-g.net/perl6.html -->
|
||||||
|
|
||||||
|
<!-- Example 1: A really basic script -->
|
||||||
|
<script type="text/perl6">
|
||||||
|
print "Hello, Perl 6 World!\n";
|
||||||
|
</script>
|
||||||
|
|
||||||
|
<!-- Example 2: Accessing JavaScript -->
|
||||||
|
<script type="text/perl6">
|
||||||
|
my $document = EVAL(:lang<JavaScript>, 'return document');
|
||||||
|
$document.getElementById('my_button')
|
||||||
|
.addEventListener("click", -> $event {
|
||||||
|
print "You clicked 'Testing!'\n";
|
||||||
|
} );
|
||||||
|
</script>
|
||||||
|
|
||||||
|
<!-- Optional STDOUT/STDERR text area (if you don't use this, output goes to Javascript console) -->
|
||||||
|
<script>
|
||||||
|
window.addEventListener("load", function () {
|
||||||
|
document.getElementById('output')
|
||||||
|
.appendChild( Raku.makeOutputTextarea() );
|
||||||
|
});
|
||||||
|
</script>
|
||||||
|
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<p>This is a demo of the
|
||||||
|
<a href="http://webperl.zero-g.net/perl6.html" target="_blank">experimental
|
||||||
|
Perl 6 support</a> in
|
||||||
|
<a href="http://webperl.zero-g.net" target="_blank">WebPerl</a>!</p>
|
||||||
|
|
||||||
|
<p><em>Currently only works in Chrome (needs BigInt support) and
|
||||||
|
may take a few seconds to load.</em></p>
|
||||||
|
|
||||||
|
<div id="output"></div>
|
||||||
|
<div id="buttons">
|
||||||
|
<button id="my_button">Testing!</button>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
@ -0,0 +1,71 @@
|
|||||||
|
#!/usr/bin/env perl
|
||||||
|
use warnings;
|
||||||
|
use strict;
|
||||||
|
use FindBin;
|
||||||
|
use Path::Class qw/dir/;
|
||||||
|
use HTTP::Tiny;
|
||||||
|
use File::Copy qw/copy/;
|
||||||
|
$|++;
|
||||||
|
|
||||||
|
# Quick & dirty script to patch P6 into the "web" dir
|
||||||
|
|
||||||
|
# Note: To restore webperl.js to the original version:
|
||||||
|
# $ git checkout web/webperl.js
|
||||||
|
|
||||||
|
my $p6url = 'https://perl6.github.io/6pad/gen/eval_code.js';
|
||||||
|
|
||||||
|
my $mydir = dir($FindBin::Bin);
|
||||||
|
my $webdir = $mydir->parent->parent->subdir('web');
|
||||||
|
|
||||||
|
print "Patching experimental Perl 6 support into ",$webdir->relative,"...\n";
|
||||||
|
|
||||||
|
my $wpfile = $webdir->file('webperl.js');
|
||||||
|
die "File structure not as I expected" unless -e $wpfile;
|
||||||
|
|
||||||
|
my $http = HTTP::Tiny->new();
|
||||||
|
my $jsfile = $webdir->file('perl6.js');
|
||||||
|
print "$p6url: ";
|
||||||
|
my $resp = $http->mirror($p6url, "$jsfile");
|
||||||
|
print "$resp->{status} $resp->{reason}\n";
|
||||||
|
die unless $resp->{success};
|
||||||
|
print "-> mirrored to ",$jsfile->relative,"\n";
|
||||||
|
|
||||||
|
my $wp = $wpfile->slurp(iomode=>'<:raw:encoding(UTF-8)');
|
||||||
|
$wp =~ s{
|
||||||
|
^ \N* \bbegin_webperl6_patch\b \N* $
|
||||||
|
.*
|
||||||
|
^ \N* \bend_webperl6_patch\b \N* $
|
||||||
|
}{}msxi;
|
||||||
|
die "I thought I clobbered the webperl6.js patch, why is there still a reference to Raku?"
|
||||||
|
if $wp=~/\bRaku\./;
|
||||||
|
my $wp6file = $mydir->file('webperl6.js');
|
||||||
|
my $wp6 = $wp6file->slurp(iomode=>'<:raw:encoding(UTF-8)');
|
||||||
|
1 while chomp($wp6);
|
||||||
|
$wpfile->spew(iomode=>'>:raw:encoding(UTF-8)', $wp.$wp6);
|
||||||
|
print "Patched ",$wp6file->relative," into ",$wpfile->relative,"\n";
|
||||||
|
|
||||||
|
for my $f ($mydir->children) {
|
||||||
|
next unless $f->basename=~/(?:html?|css)\z/i;
|
||||||
|
link_or_copy($f, $webdir);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub link_or_copy {
|
||||||
|
my ($src,$dest) = @_;
|
||||||
|
die "Not a dir: $dest" unless -d $dest;
|
||||||
|
$dest = $dest->file( $src->basename );
|
||||||
|
if ( eval { symlink("",""); 1 } ) { # we have symlink support
|
||||||
|
if (!-l $dest) {
|
||||||
|
$dest->remove or die "$dest: $!" if -e $dest;
|
||||||
|
my $targ = $src->relative( $dest->dir );
|
||||||
|
symlink($targ,$dest) or die "symlink: $!";
|
||||||
|
print "Linked ",$dest->relative," to $targ\n";
|
||||||
|
}
|
||||||
|
else { print "Link ",$dest->relative," exists\n"; }
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$dest->remove or die "$dest: $!" if -e $dest;
|
||||||
|
copy($src,$dest) or die "copy: $!";
|
||||||
|
print "Copied ",$src->relative," to ",$dest->relative,"\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
@ -0,0 +1,72 @@
|
|||||||
|
<!doctype html>
|
||||||
|
<html lang="en-us">
|
||||||
|
<head>
|
||||||
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
|
||||||
|
<title>WebPerl Perl 6 Experiments</title>
|
||||||
|
|
||||||
|
<script src="webperl.js"></script>
|
||||||
|
|
||||||
|
<!--
|
||||||
|
The following is a demo of Perl 5 and Perl 6 calling each other via JavaScript.
|
||||||
|
-->
|
||||||
|
|
||||||
|
<script>
|
||||||
|
window.Foo = {
|
||||||
|
set: function (x,y) { window.Foo[x]=y }, // workaround, see P6 below
|
||||||
|
};
|
||||||
|
</script>
|
||||||
|
|
||||||
|
<script type="text/perl">
|
||||||
|
use warnings;
|
||||||
|
use 5.028;
|
||||||
|
|
||||||
|
sub hello {
|
||||||
|
my $x = shift;
|
||||||
|
say "Hello from Perl 5! You said '$x'";
|
||||||
|
}
|
||||||
|
|
||||||
|
my $Foo = js('window.Foo');
|
||||||
|
$Foo->{p5} = \&hello;
|
||||||
|
|
||||||
|
js('document')->getElementById('btn_p5')
|
||||||
|
->addEventListener("click", sub {
|
||||||
|
say "This is Perl 5, attempting to call Perl 6...";
|
||||||
|
$Foo->p6("I am Perl 5!");
|
||||||
|
} );
|
||||||
|
|
||||||
|
say "Perl 5 is ready.";
|
||||||
|
</script>
|
||||||
|
|
||||||
|
<script type="text/raku">
|
||||||
|
|
||||||
|
sub hello ($x) {
|
||||||
|
say "Hello from Perl 6! You said '$x'"
|
||||||
|
}
|
||||||
|
|
||||||
|
my $Foo = EVAL(:lang<JavaScript>, 'return window.Foo');
|
||||||
|
# I'm not yet sure why the following doesn't work, Foo.set is a workaround
|
||||||
|
#$Foo<p6> = &hello;
|
||||||
|
$Foo.set("p6", &hello);
|
||||||
|
|
||||||
|
my $document = EVAL(:lang<JavaScript>, 'return document');
|
||||||
|
$document.getElementById('btn_p6')
|
||||||
|
.addEventListener("click", -> $event {
|
||||||
|
say "This is Perl 6, attempting to call Perl 5...";
|
||||||
|
$Foo.p5("I am Perl 6!");
|
||||||
|
} );
|
||||||
|
|
||||||
|
say "Perl 6 is ready.";
|
||||||
|
</script>
|
||||||
|
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<p>See the JS console! Don't click the buttons until both languages are ready.</p>
|
||||||
|
|
||||||
|
<div id="buttons">
|
||||||
|
<button id="btn_p5">Perl 5</button>
|
||||||
|
<button id="btn_p6">Perl 6</button>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
@ -0,0 +1,148 @@
|
|||||||
|
"use strict"; /* DO NOT EDIT THIS LINE! begin_webperl6_patch */
|
||||||
|
|
||||||
|
/***** NOTICE: This is part of the experimental WebPerl Perl 6 support.
|
||||||
|
* This file (webperl6.js) is currently patched into webperl.js by 6init.pl.
|
||||||
|
* There is currently a fair amount of duplication between the following code
|
||||||
|
* and webperl.js that should probably be reduced.
|
||||||
|
* This file should eventually be merged permanently into webperl.js.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/** ***** WebPerl - http://webperl.zero-g.net *****
|
||||||
|
*
|
||||||
|
* Copyright (c) 2018 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
|
||||||
|
**/
|
||||||
|
|
||||||
|
// I'm using "Raku" because the Hamming distance from Perl <-> Perl6 is too small for me,
|
||||||
|
// it's too much of a risk for typos since webperl.js also provides the "Perl" object.
|
||||||
|
// But the following functions are currently available on both the Raku.* and Perl6.* objects:
|
||||||
|
// .init(), .eval(), .addStateChangeListener(), .makeOutputTextarea()
|
||||||
|
// but everything else, such as Raku.state or Raku.output, needs to go via the Raku object.
|
||||||
|
var Raku = {
|
||||||
|
state: "Uninitialized", // user may read (only!) this
|
||||||
|
// internal variables:
|
||||||
|
stdout_buf: "", stderr_buf: "", // for our default Raku.output implementation
|
||||||
|
};
|
||||||
|
var Perl6 = {};
|
||||||
|
|
||||||
|
Raku.changeState = function (newState) {
|
||||||
|
if (Raku.state==newState) return;
|
||||||
|
var oldState = Raku.state;
|
||||||
|
Raku.state = newState;
|
||||||
|
for( var i=0 ; i<Raku.stateChangeListeners.length ; i++ )
|
||||||
|
Raku.stateChangeListeners[i](oldState,newState);
|
||||||
|
};
|
||||||
|
Raku.stateChangeListeners = [ function (from,to) {
|
||||||
|
console.debug("Raku: state changed from "+from+" to "+to);
|
||||||
|
} ];
|
||||||
|
Raku.addStateChangeListener = Perl6.addStateChangeListener = function (handler) {
|
||||||
|
Raku.stateChangeListeners.push(handler);
|
||||||
|
};
|
||||||
|
|
||||||
|
// chan: 1=STDOUT, 2=STDERR
|
||||||
|
// implementations are free to ignore the "chan" argument if they want to merge the two streams
|
||||||
|
Raku.output = function (str,chan) { // can be overridden by the user
|
||||||
|
var buf = chan==2 ? 'stderr_buf' : 'stdout_buf';
|
||||||
|
Raku[buf] += str;
|
||||||
|
var pos = Raku[buf].indexOf("\n");
|
||||||
|
while (pos>-1) {
|
||||||
|
console.log( chan==2?"STDERR":"STDOUT", Raku[buf].slice(0,pos) );
|
||||||
|
Raku[buf] = Raku[buf].slice(pos+1);
|
||||||
|
pos = Raku[buf].indexOf("\n");
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
Raku.makeOutputTextarea = Perl6.makeOutputTextarea = function (id) {
|
||||||
|
var ta = document.createElement('textarea');
|
||||||
|
if (id) ta.id = id;
|
||||||
|
ta.rows = 24; ta.cols = 80;
|
||||||
|
ta.setAttribute("readonly",true);
|
||||||
|
Raku.output = function (str) {
|
||||||
|
ta.value = ta.value + str;
|
||||||
|
ta.scrollTop = ta.scrollHeight;
|
||||||
|
};
|
||||||
|
return ta;
|
||||||
|
};
|
||||||
|
|
||||||
|
Raku.init = Perl6.init = function (readyCallback) {
|
||||||
|
if (Raku.state != "Uninitialized")
|
||||||
|
throw "Raku: can't call init in state "+Raku.state;
|
||||||
|
Raku.changeState("Initializing");
|
||||||
|
var baseurl = Perl.Util.baseurl(getScriptURL()); // from webperl.js
|
||||||
|
|
||||||
|
// NOTE that NQP_STDOUT currently gets handed HTML,
|
||||||
|
// so we jump through some hoops to decode it here:
|
||||||
|
var decode_div = document.createElement('div');
|
||||||
|
window.NQP_STDOUT = function (str) {
|
||||||
|
str = str.replace(/[\<\>]/g,''); // declaw unexpected tags
|
||||||
|
decode_div.innerHTML = str;
|
||||||
|
str = decode_div.textContent;
|
||||||
|
decode_div.textContent = '';
|
||||||
|
Raku.output(str,1);
|
||||||
|
};
|
||||||
|
|
||||||
|
console.debug("Raku: Fetching Perl6...");
|
||||||
|
var script = document.createElement('script');
|
||||||
|
script.async = true; script.defer = true;
|
||||||
|
// Order is important here: 1. Add to DOM, 2. set onload, 3. set src
|
||||||
|
document.getElementsByTagName('head')[0].appendChild(script);
|
||||||
|
script.onload = function () {
|
||||||
|
Raku.eval = Perl6.eval = window.evalP6;
|
||||||
|
Raku.changeState("Ready");
|
||||||
|
if (readyCallback) readyCallback();
|
||||||
|
};
|
||||||
|
script.src = baseurl+"/perl6.js";
|
||||||
|
}
|
||||||
|
|
||||||
|
window.addEventListener("load", function () {
|
||||||
|
var scripts = [];
|
||||||
|
var script_src;
|
||||||
|
document.querySelectorAll("script[type='text/perl6'],script[type='text/raku']")
|
||||||
|
.forEach(function (el) {
|
||||||
|
if (el.src) {
|
||||||
|
if (script_src || scripts.length)
|
||||||
|
console.error('Only a single Perl6 script may be loaded via "script src=", ignoring others');
|
||||||
|
else
|
||||||
|
script_src = el.src;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
if (script_src)
|
||||||
|
console.error('Only a single Perl6 script may be loaded via "script src=", ignoring others');
|
||||||
|
else
|
||||||
|
scripts.push(el.innerHTML);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
if (script_src) {
|
||||||
|
console.debug("Raku: Found a script with src, fetching and running...", script_src);
|
||||||
|
var xhr = new XMLHttpRequest();
|
||||||
|
xhr.addEventListener("load", function () {
|
||||||
|
var code = this.responseText;
|
||||||
|
Raku.init(function () { Raku.eval(code); });
|
||||||
|
});
|
||||||
|
xhr.open("GET", script_src);
|
||||||
|
xhr.send();
|
||||||
|
}
|
||||||
|
else if (scripts.length) {
|
||||||
|
console.debug("Raku: Found",scripts.length,"embedded script(s), autorunning...");
|
||||||
|
var code = scripts.join(";\n");
|
||||||
|
Raku.init(function () { Raku.eval(code); });
|
||||||
|
}
|
||||||
|
else console.debug("Raku: No embedded scripts");
|
||||||
|
});
|
||||||
|
|
||||||
|
/* DO NOT EDIT THIS LINE! end_webperl6_patch */
|
||||||
@ -0,0 +1,42 @@
|
|||||||
|
<!doctype html>
|
||||||
|
<html lang="en-us">
|
||||||
|
<head>
|
||||||
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
|
||||||
|
<title>WebPerl XTerm.js Test</title>
|
||||||
|
|
||||||
|
<!--cacheable--><link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/xterm@3.7.0/dist/xterm.css" integrity="sha256-OSfRj4jMeYVFSwgcvVvKj4V0+mwqSP9YJjyEJe7dmK0=" crossorigin="anonymous" />
|
||||||
|
<!--cacheable--><script src="https://cdn.jsdelivr.net/npm/xterm@3.7.0/dist/xterm.js" integrity="sha256-gIILiZzLBFrmY1dzcKJC2Nmw4o9ISITTNsro2rf8svM=" crossorigin="anonymous"></script>
|
||||||
|
|
||||||
|
<script src="webperl.js"></script>
|
||||||
|
|
||||||
|
<script>
|
||||||
|
"use strict";
|
||||||
|
window.addEventListener('load', function () {
|
||||||
|
var term = new Terminal();
|
||||||
|
term.open(document.getElementById('terminal'));
|
||||||
|
Perl.output = function (str) { term.write(str) };
|
||||||
|
Module.preRun.push(function () { ENV.TERM = "xterm" });
|
||||||
|
});
|
||||||
|
</script>
|
||||||
|
|
||||||
|
<script type="text/perl">
|
||||||
|
use warnings;
|
||||||
|
use strict;
|
||||||
|
use Term::ANSIColor qw/colored/;
|
||||||
|
|
||||||
|
print colored("Hello, Color World!\n", 'black on_yellow');
|
||||||
|
|
||||||
|
# Possible To-Do for Later: can we accept input from XTerm?
|
||||||
|
# might not be so easy: https://github.com/xtermjs/xterm.js/issues/1546#issuecomment-402547923
|
||||||
|
# (keypresses are events, but reading from STDIN is normally blocking...)
|
||||||
|
|
||||||
|
</script>
|
||||||
|
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<div id="terminal"></div>
|
||||||
|
<p><a href="http://xtermjs.org/" target="_blank">xterm.js</a></p>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
@ -0,0 +1,208 @@
|
|||||||
|
<!doctype html>
|
||||||
|
<html lang="en-us">
|
||||||
|
<head>
|
||||||
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
|
||||||
|
<title>WebPerl Code Demo</title>
|
||||||
|
|
||||||
|
<!-- ##### WebPerl - http://webperl.zero-g.net #####
|
||||||
|
|
||||||
|
Copyright (c) 2018 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
|
||||||
|
##### -->
|
||||||
|
|
||||||
|
<style>
|
||||||
|
p {
|
||||||
|
font-family: Calibri, Ubuntu, "Droid Sans", Tahoma, Arial, Helvetica, sans-serif;
|
||||||
|
}
|
||||||
|
pre,textarea,code {
|
||||||
|
font-family: Consolas, "Ubuntu Mono", "Droid Sans Mono", "Lucida Console", "Courier New", Courier, monospace;
|
||||||
|
}
|
||||||
|
iframe.perleditor {
|
||||||
|
display: block;
|
||||||
|
border: 1px solid black;
|
||||||
|
width: 100%;
|
||||||
|
max-width: 50em;
|
||||||
|
margin: 0.2em 0;
|
||||||
|
}
|
||||||
|
</style>
|
||||||
|
<!-- Optional "IFrame Resizer": -->
|
||||||
|
<!--cacheable--><!--script src="https://cdnjs.cloudflare.com/ajax/libs/iframe-resizer/3.6.2/iframeResizer.min.js" integrity="sha256-aYf0FZGWqOuKNPJ4HkmnMZeODgj3DVslnYf+8dCN9/k=" crossorigin="anonymous"></script-->
|
||||||
|
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<p>
|
||||||
|
This page demonstrates the embeddable
|
||||||
|
<strong><a href="http://webperl.zero-g.net" target="_blank">WebPerl</a>
|
||||||
|
Code Demo Editor</strong> (beta), which can be embedded using <code><iframe></code> elements, including
|
||||||
|
<a href="https://developer.mozilla.org/en-US/docs/Web/HTML/Element/iframe#attr-sandbox" target="_blank">sandboxing</a>.
|
||||||
|
The documentation is contained in the source of this page, please use
|
||||||
|
the "View Source" function of your browser to view it, or have a look at
|
||||||
|
<a href="https://github.com/haukex/webperl/tree/master/web/democode"
|
||||||
|
target="_blank">the project sources on GitHub</a>.
|
||||||
|
</p>
|
||||||
|
|
||||||
|
<!-- Thank you to LanX from PerlMonks for the inspiration! :-)
|
||||||
|
https://www.perlmonks.org/?node_id=1223812 -->
|
||||||
|
|
||||||
|
<!-- First, you have to include the following hidden IFrame, which
|
||||||
|
loads the "Perl runner". This is (currently) necessary because this
|
||||||
|
IFrame needs to re-load itself in order to re-run Perl. This IFrame
|
||||||
|
*must* have the "name='perlrunner'" attribute and must be embedded at
|
||||||
|
the same level as the Perl editor IFrame(s). The frames communicate
|
||||||
|
via the "window.postMessage()" mechanism, which is safe for
|
||||||
|
cross-origin communications and sandboxing. Currently, in order to
|
||||||
|
conserve memory, a single runner serves multiple "clients", that is,
|
||||||
|
the "editor" IFrames below.
|
||||||
|
|
||||||
|
It is also possible to link to perleditor.html directly: if it
|
||||||
|
detects that it is not running in an IFrame, it will load the runner
|
||||||
|
on its own (after a very brief delay).
|
||||||
|
-->
|
||||||
|
|
||||||
|
<iframe name="perlrunner" sandbox="allow-scripts" src="perlrunner.html" style="display:none;"></iframe>
|
||||||
|
|
||||||
|
<p>This is a simple example of running a oneliner:</p>
|
||||||
|
|
||||||
|
<!-- The following is a basic example showing a single input file and
|
||||||
|
Perl oneliner.
|
||||||
|
|
||||||
|
All files are currently always encoded as UTF-8, which is why the
|
||||||
|
"-CSD" switch is used below. This is not strictly necessary when the
|
||||||
|
input files are pure ASCII, but it is important to remember that Perl
|
||||||
|
does *not* default to UTF-8. Reading/writing binary data via the
|
||||||
|
editor and runner is currently *not* supported.
|
||||||
|
|
||||||
|
Standard input/output redirection is currently not supported. It is
|
||||||
|
also currently not supported to supply STDIN directly to the script,
|
||||||
|
the workaround is to use input files, supply the filenames on the
|
||||||
|
command line, and use Perl's magic ARGV operator "<>". Support for
|
||||||
|
redirections may be added in a future version.
|
||||||
|
|
||||||
|
The JavaScript shown below is not strictly necessary, it is also
|
||||||
|
possible to specify a "src='...'" attribute directly in the IFrame
|
||||||
|
tag, for example using the "Copy Frame URL" link shown in the editor.
|
||||||
|
|
||||||
|
Note that implementing an automatic resize of the IFrame to fit its
|
||||||
|
contents is nontrivial when sandboxing is enabled, which is why a
|
||||||
|
fixed height is used below. However, see for example
|
||||||
|
http://davidjbradshaw.github.io/iframe-resizer/ - examples of how
|
||||||
|
to use this are included in the source files here.
|
||||||
|
-->
|
||||||
|
|
||||||
|
<iframe id="perl1" sandbox="allow-scripts" class="perleditor" style="height:20em;"></iframe>
|
||||||
|
<script>
|
||||||
|
document.getElementById('perl1').src =
|
||||||
|
"perleditor.html#" + encodeURIComponent(JSON.stringify( {
|
||||||
|
inputs: [ { fn:"in.txt", text:"Foo\nBar\nQuz" } ],
|
||||||
|
cmdline: "perl -CSD -pe 's/[aeiou]/_/g' in.txt",
|
||||||
|
} ));
|
||||||
|
// Example of how to use the Optional "IFrame Resizer":
|
||||||
|
//iFrameResize({checkOrigin:false}, document.getElementById('perl1'));
|
||||||
|
</script>
|
||||||
|
|
||||||
|
<p>This example includes several files:</p>
|
||||||
|
|
||||||
|
<!-- The following example demonstrates (almost) all of the possible
|
||||||
|
options that can be passed to the editor.
|
||||||
|
|
||||||
|
The "cmdline" option and the corresponding input box in the editor
|
||||||
|
only support very basic quoting constructs:
|
||||||
|
- Strings in double quotes may contain whitespace, \\, and/or \",
|
||||||
|
the latter two will be changed to \ and " respectively;
|
||||||
|
- strings in single quotes may contain whitespace, \\, and/or \',
|
||||||
|
the latter two will be changed to \ and ' respectively;
|
||||||
|
- other strings (without whitespace) will not be modified.
|
||||||
|
Note: As a consequence of these rules, inside of single or double
|
||||||
|
quotes, both \\n and \n resolve to \n (for any character "n" that
|
||||||
|
is not a backslash or single resp. double quote).
|
||||||
|
|
||||||
|
Instead of "cmdline", you may specify "argv" as an array ("cmdline"
|
||||||
|
overrides "argv"). This array should *not* include "perl" as the
|
||||||
|
first element; this is added automatically.
|
||||||
|
|
||||||
|
So that it can be displayed in the input box, the "argv" array
|
||||||
|
will be encoded into a single string - this means that if you want
|
||||||
|
full control over the formatting of the command line as it is
|
||||||
|
displayed to the user in the editor, use "cmdline" instead. The
|
||||||
|
"Copy JSON" data will include both "cmdline" and "argv" (so you
|
||||||
|
can choose to delete whichever one you don't need), while "Copy
|
||||||
|
URL" will include only "cmdline" (for brevity).
|
||||||
|
|
||||||
|
You may specify the text of a script via "script", or, alternatively,
|
||||||
|
a "script_url" from which the script is to be fetched - however, be
|
||||||
|
aware that cross-origin restrictions may limit your ability to fetch
|
||||||
|
URLs from other origins. You can specify the script's filename with
|
||||||
|
"script_fn".
|
||||||
|
|
||||||
|
Input files ("inputs") are specified as an array of objects; the
|
||||||
|
properties of the object are similar to the script: filenames are
|
||||||
|
specified with "fn", and the text of the file via "text", or
|
||||||
|
alternatively, you may specify a "url" from which the content is to
|
||||||
|
be fetched.
|
||||||
|
|
||||||
|
The output files ("outputs") are an array of filenames. After the
|
||||||
|
script finishes, the "Perl runner" will attempt to read these files
|
||||||
|
and display them to the user. It is also possible to specify output
|
||||||
|
files with the same name as an input file, for example if Perl's "-i"
|
||||||
|
option was used.
|
||||||
|
|
||||||
|
The current working directory of Perl defaults to the "home"
|
||||||
|
directory in Emscripten's virtual file system, currently
|
||||||
|
"/home/web_user", and all filenames are relative to this directory.
|
||||||
|
You may also specify absolute filenames such as "/tmp/foo.txt".
|
||||||
|
However, note that intermediate directories are currently not
|
||||||
|
automatically created, so if you specify files with nonexistent
|
||||||
|
directories like "/tmp/foo/bar.txt" or the relative "foo/bar.txt",
|
||||||
|
this will not work.
|
||||||
|
|
||||||
|
Additional options: Setting "mergeStdOutErr" to a true value causes
|
||||||
|
STDOUT and STDERR output to be output together, similar to the way
|
||||||
|
they would be on the console. *However,* note that WebPerl
|
||||||
|
currently doesn't think it's connected to a terminal, which means
|
||||||
|
that perl defaults to block instead of line buffering STDOUT, so
|
||||||
|
it may seem like you always see STDERR output before STDOUT. If you
|
||||||
|
want to truly intermix the two, turn on autoflush ("$|=1;").
|
||||||
|
|
||||||
|
If you set the "autorun" option, the editor will attempt to run the
|
||||||
|
script as soon as the runner is ready. *WARNING:* If you have
|
||||||
|
multiple editors embedded in the page, *do not* enable "autorun"
|
||||||
|
for more than one editor, as otherwise you will likely trigger a
|
||||||
|
race condition, resulting in an error being shown to the user.
|
||||||
|
-->
|
||||||
|
|
||||||
|
<iframe id="perl2" sandbox="allow-scripts" class="perleditor" style="height:42em;"></iframe>
|
||||||
|
<script>
|
||||||
|
document.getElementById('perl2').src =
|
||||||
|
"perleditor.html#" + encodeURIComponent(JSON.stringify( {
|
||||||
|
argv: ["devoweler.pl","mytext.txt","other.txt"],
|
||||||
|
script: "use warnings;\nuse strict;\n\nopen my $vfh, '>', 'vowels.txt' or die $!;\n"
|
||||||
|
+"while (<>) {\n\tprint $vfh $1 while s/([aeiou])/_/i;\n\tprint;\n}\nclose $vfh;",
|
||||||
|
script_fn: "devoweler.pl",
|
||||||
|
inputs: [
|
||||||
|
{ fn: "mytext.txt", text: "Foo\nBar\nQuz\n" },
|
||||||
|
{ fn: "other.txt", text: "Hello, World!" },
|
||||||
|
],
|
||||||
|
outputs: [ "vowels.txt" ],
|
||||||
|
autorun: true,
|
||||||
|
} ));
|
||||||
|
//iFrameResize({checkOrigin:false}, document.getElementById('perl2'));
|
||||||
|
</script>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
@ -0,0 +1,83 @@
|
|||||||
|
|
||||||
|
body {
|
||||||
|
margin: 0.4em;
|
||||||
|
}
|
||||||
|
.text {
|
||||||
|
font-family: Calibri, Ubuntu, "Droid Sans", Tahoma, Arial, Helvetica, sans-serif;
|
||||||
|
font-size: 0.9em;
|
||||||
|
}
|
||||||
|
pre,textarea,code,.code,.filename,.CodeMirror {
|
||||||
|
font-family: Consolas, "Ubuntu Mono", "Droid Sans Mono", "Lucida Console", "Courier New", Courier, monospace;
|
||||||
|
}
|
||||||
|
pre {
|
||||||
|
margin: 0;
|
||||||
|
}
|
||||||
|
a {
|
||||||
|
text-decoration: none;
|
||||||
|
}
|
||||||
|
|
||||||
|
.CodeMirror {
|
||||||
|
border: 1px solid lightgrey;
|
||||||
|
height: auto;
|
||||||
|
}
|
||||||
|
.CodeMirror-scroll {
|
||||||
|
max-height: 12em;
|
||||||
|
}
|
||||||
|
|
||||||
|
.codewithfn {
|
||||||
|
margin-top: 0.4em;
|
||||||
|
}
|
||||||
|
.fnfuncs {
|
||||||
|
cursor: default;
|
||||||
|
}
|
||||||
|
.filename {
|
||||||
|
display: inline-block;
|
||||||
|
border: 0;
|
||||||
|
padding: 1px;
|
||||||
|
min-width: 1em;
|
||||||
|
cursor: auto;
|
||||||
|
}
|
||||||
|
.filefuncs {
|
||||||
|
display: inline-block;
|
||||||
|
padding-top: 2px;
|
||||||
|
position: absolute;
|
||||||
|
right: 0.2em;
|
||||||
|
}
|
||||||
|
.fakelink {
|
||||||
|
color: darkblue;
|
||||||
|
cursor: pointer;
|
||||||
|
}
|
||||||
|
.badfilename {
|
||||||
|
background-color: rgba(255,200,200,255);
|
||||||
|
/* also has a placeholder text */
|
||||||
|
min-width: 10em;
|
||||||
|
}
|
||||||
|
|
||||||
|
#perlctrl {
|
||||||
|
margin-top: 0.3em;
|
||||||
|
}
|
||||||
|
|
||||||
|
#misctools {
|
||||||
|
display: inline-block;
|
||||||
|
border: 1px solid grey;
|
||||||
|
padding: 1px 0.8em 1px 0.5em;
|
||||||
|
margin-top: 0.5em;
|
||||||
|
}
|
||||||
|
#runnerstate {
|
||||||
|
margin-top: 0.2em;
|
||||||
|
margin-bottom: 0.3em;
|
||||||
|
}
|
||||||
|
#runnererrors {
|
||||||
|
background-color: rgba(255,200,200,255);
|
||||||
|
margin-top: 0.3em;
|
||||||
|
margin-bottom: 0.3em;
|
||||||
|
padding: 0.1em 0.2em;
|
||||||
|
}
|
||||||
|
|
||||||
|
#inputhere, #outputhere {
|
||||||
|
text-align: right;
|
||||||
|
}
|
||||||
|
|
||||||
|
#footer {
|
||||||
|
margin-top: 0.5em;
|
||||||
|
}
|
||||||
@ -0,0 +1,550 @@
|
|||||||
|
<!doctype html>
|
||||||
|
<html lang="en-us">
|
||||||
|
<head>
|
||||||
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
|
||||||
|
<title>WebPerl Perl Editor</title>
|
||||||
|
|
||||||
|
<!-- ##### WebPerl - http://webperl.zero-g.net #####
|
||||||
|
|
||||||
|
Copyright (c) 2018 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
|
||||||
|
##### -->
|
||||||
|
|
||||||
|
<!-- Please see the documentation on how to use this in demo.html. -->
|
||||||
|
|
||||||
|
<!--cacheable--><link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/normalize/8.0.0/normalize.min.css" integrity="sha256-oSrCnRYXvHG31SBifqP2PM1uje7SJUyX0nTwO2RJV54=" crossorigin="anonymous" />
|
||||||
|
<!--cacheable--><link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/codemirror/5.39.2/codemirror.min.css" integrity="sha256-I8NyGs4wjbMuBSUE40o55W6k6P7tu/7G28/JGUUYCIs=" crossorigin="anonymous" />
|
||||||
|
<link rel="stylesheet" href="perleditor.css" />
|
||||||
|
|
||||||
|
<!-- Optional "IFrame Resizer": -->
|
||||||
|
<!--cacheable--><!--script src="https://cdnjs.cloudflare.com/ajax/libs/iframe-resizer/3.6.2/iframeResizer.contentWindow.min.js" integrity="sha256-dEPtZVO6cj6PAmBeDzFskohUob+woyzF6TaNcYpAk84=" crossorigin="anonymous"></script-->
|
||||||
|
<!--cacheable--><script src="https://cdnjs.cloudflare.com/ajax/libs/codemirror/5.39.2/codemirror.min.js" integrity="sha256-uRIJ6Wfou5cTtmcCvQNA9lvsYl8sUbZXxnfG+P79ssY=" crossorigin="anonymous"></script>
|
||||||
|
<!--cacheable--><script src="https://cdnjs.cloudflare.com/ajax/libs/codemirror/5.39.2/mode/perl/perl.min.js" integrity="sha256-Uu9QBfi8gU6J/MzQunal8ewmY+i/BbCkBrcAXA5bcCM=" crossorigin="anonymous"></script>
|
||||||
|
<!--cacheable--><script src="https://code.jquery.com/jquery-3.3.1.min.js" integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=" crossorigin="anonymous"></script>
|
||||||
|
<script>
|
||||||
|
"use strict";
|
||||||
|
|
||||||
|
var mergeStdOutErr = false; // Possible To-Do for Later: could make an options hash
|
||||||
|
var perlRunner; // the Perl runner iframe found by findPerlRunner()
|
||||||
|
var buttonBlockers = {}; // for updateButtonState()
|
||||||
|
var lastExitStatus; // for runnerState()
|
||||||
|
var loadedRunnerIframe = false; // for findPerlRunner()
|
||||||
|
var autoRunPerl = false; // for the message listener
|
||||||
|
|
||||||
|
function makeCM (textarea,plain,ro) {
|
||||||
|
return CodeMirror.fromTextArea( textarea[0], {
|
||||||
|
viewportMargin: Infinity, // so browser's search works, not good for long documents though
|
||||||
|
lineNumbers:true, indentWithTabs:true,
|
||||||
|
tabSize:4, indentUnit:4,
|
||||||
|
mode: plain?"text/plain":"perl",
|
||||||
|
readOnly: ro?true:false,
|
||||||
|
} );
|
||||||
|
}
|
||||||
|
|
||||||
|
function runnerState (text) {
|
||||||
|
$('#runnerstate').text( text
|
||||||
|
+ (lastExitStatus ? ' (last exit status was '+lastExitStatus+')'
|
||||||
|
: '') );
|
||||||
|
}
|
||||||
|
|
||||||
|
function updateButtonState () {
|
||||||
|
$('#runperl').prop("disabled",
|
||||||
|
Object.keys(buttonBlockers).length>0 );
|
||||||
|
}
|
||||||
|
|
||||||
|
function stdOutput (which, data) { // which: 1=stdout, 2=stderr
|
||||||
|
if (mergeStdOutErr) which = 1;
|
||||||
|
var div = $(which==1?'#stdout':'#stderr');
|
||||||
|
div.show();
|
||||||
|
var cm = div.data('CodeMirrorInstance');
|
||||||
|
if (!cm) {
|
||||||
|
cm = makeCM($('textarea',div),1,1);
|
||||||
|
div.data('CodeMirrorInstance', cm);
|
||||||
|
}
|
||||||
|
if (data && data.length)
|
||||||
|
cm.setValue( cm.getValue() + data );
|
||||||
|
}
|
||||||
|
function clearStdOutput () {
|
||||||
|
$('#stdout,#stderr').each(function (i) {
|
||||||
|
var div = $(this);
|
||||||
|
var cm = div.data('CodeMirrorInstance');
|
||||||
|
if (cm) cm.setValue('');
|
||||||
|
div.hide();
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
function findPerlRunner () {
|
||||||
|
// assume calling this function means the runner isn't available
|
||||||
|
buttonBlockers.runnerState = 1;
|
||||||
|
updateButtonState();
|
||||||
|
// poll for perlRunner, which gets set by the message listener
|
||||||
|
var warnAt = Date.now() + 15*1000; // milliseconds
|
||||||
|
var loadIframe = Date.now() + 3*1000; // milliseconds
|
||||||
|
var pollId;
|
||||||
|
pollId = window.setInterval( function () {
|
||||||
|
if (perlRunner)
|
||||||
|
window.clearInterval(pollId);
|
||||||
|
else if (!loadedRunnerIframe && self===top && Date.now()>loadIframe) {
|
||||||
|
console.debug("Perl Editor is attempting to load Perl Runner...");
|
||||||
|
/* This is a special case: We appear to be the toplevel window,
|
||||||
|
* and are unable to contact the runner within a fixed amount of time.
|
||||||
|
* So we assume that someone has linked directly to this page instead
|
||||||
|
* of loading it in an IFrame, so we'll load the runner ourselves. */
|
||||||
|
$('<iframe/>',{name:"perlrunner",sandbox:"allow-scripts",
|
||||||
|
src:"perlrunner.html",style:"display:none;"})
|
||||||
|
.appendTo('body');
|
||||||
|
loadedRunnerIframe = true;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
if (window.parent && window.parent.frames["perlrunner"])
|
||||||
|
window.parent.frames["perlrunner"].postMessage(
|
||||||
|
{perlRunnerDiscovery:1}, '*');
|
||||||
|
if ( Date.now()>warnAt ) {
|
||||||
|
$('#runnererrors>pre').text("Perl does not appear to have loaded yet, still waiting...");
|
||||||
|
$('#runnererrors').show();
|
||||||
|
warnAt = Date.now() + 5*1000; // milliseconds
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}, 100);
|
||||||
|
}
|
||||||
|
|
||||||
|
window.addEventListener('message', function (event) {
|
||||||
|
var data = event.data;
|
||||||
|
if (data["perlRunnerState"]) {
|
||||||
|
if ( data.perlRunnerState=="Ready" ) {
|
||||||
|
perlRunner = event.source;
|
||||||
|
delete buttonBlockers.runnerState;
|
||||||
|
updateButtonState();
|
||||||
|
if (autoRunPerl) {
|
||||||
|
autoRunPerl = false;
|
||||||
|
$('#runperl').click();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else if ( data.perlRunnerState=="Ended" ) {
|
||||||
|
if ('exitStatus' in data)
|
||||||
|
lastExitStatus = ''+data.exitStatus;
|
||||||
|
// we know the runner will reload itself now
|
||||||
|
perlRunner = null;
|
||||||
|
findPerlRunner();
|
||||||
|
}
|
||||||
|
runnerState("Perl is "+data.perlRunnerState);
|
||||||
|
}
|
||||||
|
else if (data["perlOutput"])
|
||||||
|
stdOutput(data.perlOutput.chan, data.perlOutput.data);
|
||||||
|
else if (data["perlOutputFiles"]) {
|
||||||
|
data.perlOutputFiles.forEach(function (outp) {
|
||||||
|
setupOutputFile(outp.fn, outp.text);
|
||||||
|
});
|
||||||
|
}
|
||||||
|
else if (data["perlRunnerError"]) {
|
||||||
|
$('#runnererrors').show();
|
||||||
|
$('#runnererrors>pre').append(data.perlRunnerError+"\n");
|
||||||
|
}
|
||||||
|
else if (data.substring(0,13)=="[iFrameSizer]") {} // ignore quietly
|
||||||
|
else console.warn("Perl Editor ignoring unknown message:",data);
|
||||||
|
});
|
||||||
|
|
||||||
|
function parseCmdLine(str) {
|
||||||
|
// not the prettiest code but it works
|
||||||
|
var re = /"((?:\\"|\\\\|[^"])*)"|'((?:\\'|\\\\|[^'])*)'|(\S+)/g;
|
||||||
|
var argv = [];
|
||||||
|
var match;
|
||||||
|
while ((match = re.exec(str)) !== null) {
|
||||||
|
if (typeof match[1] != 'undefined') argv.push(match[1].replace(/\\\\/g,"\\").replace(/\\"/g,"\""));
|
||||||
|
else if (typeof match[2] != 'undefined') argv.push(match[2].replace(/\\\\/g,'\\').replace(/\\'/g,'\''));
|
||||||
|
else if (typeof match[3] != 'undefined') argv.push(match[3]);
|
||||||
|
else throw "Unexpected match "+match;
|
||||||
|
}
|
||||||
|
return argv;
|
||||||
|
}
|
||||||
|
function encodeCmdLine(arr) {
|
||||||
|
var out = [];
|
||||||
|
for (var i=0; i<arr.length; i++) {
|
||||||
|
/* Note: we only *need* to encode strings if they contain /[\s'"\\]/,
|
||||||
|
* but since we want to show the users a command line similar to a shell,
|
||||||
|
* I've added $ */
|
||||||
|
out.push( arr[i].match(/[\s'"\\\$]/)
|
||||||
|
? "'"+arr[i].replace(/\\/g, "\\\\").replace(/'/g, "\\'")+"'"
|
||||||
|
: arr[i] );
|
||||||
|
}
|
||||||
|
return out.join(' ');
|
||||||
|
}
|
||||||
|
|
||||||
|
function fetchUrl(url,cm) { // fetch the contents of a URL into a CodeMirror instance
|
||||||
|
cm.setValue("Fetching URL\n"+url+"\nPlease wait...");
|
||||||
|
buttonBlockers["fetchUrls"]++;
|
||||||
|
updateButtonState();
|
||||||
|
$.get(url, function (data) {
|
||||||
|
cm.setValue(data);
|
||||||
|
},'text').fail(function (jqXHR,textStatus,errorThrown) {
|
||||||
|
cm.setValue("Fetching URL\n"+url+"\nFailed!\n"+textStatus+"\n"+errorThrown);
|
||||||
|
}).always(function () {
|
||||||
|
buttonBlockers.fetchUrls--;
|
||||||
|
if (!buttonBlockers.fetchUrls)
|
||||||
|
delete buttonBlockers.fetchUrls;
|
||||||
|
updateButtonState();
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
function makeCodeWithFn (fn,targ,ro,isscript) {
|
||||||
|
var div = $('<div/>',{class:"codewithfn"});
|
||||||
|
|
||||||
|
var fnfuncs = $('<div/>',{class:"fnfuncs"}).appendTo(div);
|
||||||
|
|
||||||
|
var filename = $('<input/>',{class:"filename code",type:"text",
|
||||||
|
placeholder:"Enter a filename!"})
|
||||||
|
.appendTo(fnfuncs);
|
||||||
|
filename.val(fn);
|
||||||
|
// autosize the filename text box via a hidden span
|
||||||
|
var fn_width = $('<span/>',
|
||||||
|
{class:"code",style:"display:none;white-space:pre;"}
|
||||||
|
).insertAfter(filename);
|
||||||
|
filename.on('input', function () {
|
||||||
|
var newfn = filename.val();
|
||||||
|
fn_width.text( newfn );
|
||||||
|
filename.width( fn_width.width()+10 );
|
||||||
|
if (newfn.length)
|
||||||
|
filename.removeClass("badfilename");
|
||||||
|
else
|
||||||
|
filename.addClass("badfilename");
|
||||||
|
});
|
||||||
|
/* we need to trigger this handler once when the input
|
||||||
|
* field is added to the document, we do this below */
|
||||||
|
|
||||||
|
var filefuncs = $('<div/>',{class:"filefuncs text"})
|
||||||
|
.appendTo(fnfuncs);
|
||||||
|
|
||||||
|
var conf = $('<span/>', {})
|
||||||
|
.append(
|
||||||
|
" ",
|
||||||
|
"Are you sure?",
|
||||||
|
" ",
|
||||||
|
$('<span/>',{class:"fakelink",text:"Yes"})
|
||||||
|
.click(function () {
|
||||||
|
div.remove();
|
||||||
|
if (isscript) $('#addscript').show();
|
||||||
|
}),
|
||||||
|
" ",
|
||||||
|
$('<span/>',{class:"fakelink",text:"Cancel"})
|
||||||
|
.click(function () { conf.hide(); }),
|
||||||
|
);
|
||||||
|
$('<span/>',{class:"fakelink",text:"Delete"})
|
||||||
|
.appendTo(filefuncs).click(function () {
|
||||||
|
conf.show();
|
||||||
|
});
|
||||||
|
conf.hide();
|
||||||
|
conf.appendTo(filefuncs);
|
||||||
|
|
||||||
|
var ta = $('<textarea/>').appendTo(div);
|
||||||
|
targ.before(div);
|
||||||
|
filename.trigger('input'); // see above
|
||||||
|
var cm = makeCM(ta, !(isscript||fn.match(/\.pl$/i)), ro);
|
||||||
|
div.data('CodeMirrorInstance', cm);
|
||||||
|
return {div:div,ta:ta,cm:cm};
|
||||||
|
}
|
||||||
|
|
||||||
|
function pickNewFilename (inNotOut) {
|
||||||
|
var x = inNotOut ? 'input' : 'output';
|
||||||
|
for (var i=1; i<1000; i++) {
|
||||||
|
var fn = x+i+".txt";
|
||||||
|
var found = $('div.'+x+'s .filename')
|
||||||
|
.filter(function(){ return $(this).val() == fn });
|
||||||
|
if (!found.length)
|
||||||
|
return fn;
|
||||||
|
}
|
||||||
|
$('#runnererrors>pre').text('Too many '+x+' files');
|
||||||
|
$('#runnererrors').show();
|
||||||
|
throw 'Too many '+x+' files';
|
||||||
|
}
|
||||||
|
|
||||||
|
function setupOutputFile (fn, text) {
|
||||||
|
var cm;
|
||||||
|
if (fn) {
|
||||||
|
var founddiv = $('div.outputs')
|
||||||
|
.filter(function(){ return $('.filename',this).val() == fn });
|
||||||
|
if (founddiv.length)
|
||||||
|
cm = founddiv.data('CodeMirrorInstance');
|
||||||
|
}
|
||||||
|
else
|
||||||
|
fn = pickNewFilename(false);
|
||||||
|
if (!cm) {
|
||||||
|
var cfn = makeCodeWithFn(fn, $('#outputhere'), 1);
|
||||||
|
cfn.div.addClass("outputs");
|
||||||
|
cm = cfn.cm;
|
||||||
|
}
|
||||||
|
cm.setValue( text ? text : '' );
|
||||||
|
}
|
||||||
|
|
||||||
|
function setupInputFile (inp) {
|
||||||
|
var fn = inp["fn"] ? inp.fn : pickNewFilename(true);
|
||||||
|
var cfn = makeCodeWithFn(fn, $('#inputhere'), 0);
|
||||||
|
cfn.div.addClass("inputs");
|
||||||
|
if (inp["text"])
|
||||||
|
cfn.cm.setValue(inp.text);
|
||||||
|
else if (inp["url"])
|
||||||
|
fetchUrl(inp.url, cfn.cm);
|
||||||
|
}
|
||||||
|
|
||||||
|
function getFileData () {
|
||||||
|
var filedata = {};
|
||||||
|
// command-line args
|
||||||
|
filedata.cmdline = $('#argv').val();
|
||||||
|
var argv = parseCmdLine( filedata.cmdline );
|
||||||
|
if ( argv.length<1 || argv[0]!="perl" ) {
|
||||||
|
$('#runnererrors>pre').text('Invalid command line, command must be "perl"');
|
||||||
|
$('#runnererrors').show();
|
||||||
|
return;
|
||||||
|
} // else
|
||||||
|
argv.shift();
|
||||||
|
$('#runnererrors>pre').text('');
|
||||||
|
$('#runnererrors').hide();
|
||||||
|
filedata.argv = argv;
|
||||||
|
// script
|
||||||
|
var scriptdiv = $('#script');
|
||||||
|
if (scriptdiv.is(':visible')) {
|
||||||
|
filedata.script = scriptdiv.data('CodeMirrorInstance').getValue();
|
||||||
|
filedata.script_fn = scriptdiv.find('.filename').val();
|
||||||
|
}
|
||||||
|
// inputs
|
||||||
|
$('.inputs').each(function () {
|
||||||
|
var div = $(this);
|
||||||
|
var fn = $('.filename',div).val();
|
||||||
|
var text = div.data('CodeMirrorInstance').getValue();
|
||||||
|
if (!filedata["inputs"]) filedata.inputs = [];
|
||||||
|
filedata.inputs.push( { fn:fn, text:text } );
|
||||||
|
});
|
||||||
|
// outputs
|
||||||
|
$('.outputs').each(function () {
|
||||||
|
var fn = $(this).find('.filename').val();
|
||||||
|
if (!filedata["outputs"]) filedata.outputs = [];
|
||||||
|
filedata.outputs.push(fn);
|
||||||
|
});
|
||||||
|
return filedata;
|
||||||
|
}
|
||||||
|
|
||||||
|
function copyit (what) {
|
||||||
|
var pageurl = $('#pageurl');
|
||||||
|
pageurl.val(what);
|
||||||
|
pageurl.show();
|
||||||
|
pageurl[0].select();
|
||||||
|
document.execCommand("copy");
|
||||||
|
pageurl.hide();
|
||||||
|
}
|
||||||
|
|
||||||
|
$(function () {
|
||||||
|
|
||||||
|
var hashdata = window.location.hash.substr(1);
|
||||||
|
var hash = hashdata.length>0 ? JSON.parse(decodeURIComponent(hashdata)) : {};
|
||||||
|
|
||||||
|
$('#showtools').click(function () {
|
||||||
|
$('#thetools,#footer').toggle();
|
||||||
|
$('#showtools').text( $('#thetools').is(':visible')
|
||||||
|
? 'Hide Tools' : 'Show Tools' );
|
||||||
|
});
|
||||||
|
$('#webperllink').click(function () {
|
||||||
|
$('#webperlurl').show();
|
||||||
|
});
|
||||||
|
|
||||||
|
// script
|
||||||
|
var addscript = $('#addscript');
|
||||||
|
if ( hash["script"] || hash["script_url"] ) {
|
||||||
|
var fn = hash["script_fn"] ? hash.script_fn : 'script.pl';
|
||||||
|
var cfn = makeCodeWithFn(fn, $('#perlctrl'), 0, 1);
|
||||||
|
cfn.div.attr("id", "script");
|
||||||
|
if (hash["script"])
|
||||||
|
cfn.cm.setValue(hash.script);
|
||||||
|
else if (hash["script_url"])
|
||||||
|
fetchUrl(hash.script_url, cfn.cm);
|
||||||
|
addscript.hide();
|
||||||
|
}
|
||||||
|
else
|
||||||
|
addscript.show();
|
||||||
|
$('#addscript .fakelink').click(function () {
|
||||||
|
addscript.hide();
|
||||||
|
if ($('#script').length) return;
|
||||||
|
var cfn = makeCodeWithFn('script.pl', $('#perlctrl'), 0, 1);
|
||||||
|
cfn.div.attr("id", "script");
|
||||||
|
cfn.cm.setValue("use warnings;\nuse strict;\n\n");
|
||||||
|
});
|
||||||
|
|
||||||
|
// command line
|
||||||
|
var argv_inp = $('#argv');
|
||||||
|
var argv_autosize = $('<span/>',
|
||||||
|
{class:"code",style:"display:none;white-space:pre;"}
|
||||||
|
).insertAfter(argv_inp);
|
||||||
|
argv_inp.on('input', function () {
|
||||||
|
argv_autosize.text( argv_inp.val() );
|
||||||
|
argv_inp.width( argv_autosize.width()+10 );
|
||||||
|
});
|
||||||
|
if (hash["cmdline"])
|
||||||
|
argv_inp.val(hash.cmdline);
|
||||||
|
else if (hash["argv"])
|
||||||
|
argv_inp.val("perl "+encodeCmdLine(hash.argv));
|
||||||
|
argv_inp.trigger('input');
|
||||||
|
|
||||||
|
// input files
|
||||||
|
$('.inputs').remove();
|
||||||
|
if ( hash["inputs"] ) hash.inputs.forEach(function(inp) {
|
||||||
|
setupInputFile(inp);
|
||||||
|
});
|
||||||
|
$('#addinput').click(function () {
|
||||||
|
setupInputFile( {} );
|
||||||
|
});
|
||||||
|
|
||||||
|
// stdout/stderr
|
||||||
|
var mergestdoe = $('#mergestdoe');
|
||||||
|
var stdout_fn = $('#stdout .filename');
|
||||||
|
if (hash["mergeStdOutErr"]) {
|
||||||
|
mergeStdOutErr = true;
|
||||||
|
stdout_fn.val("STDOUT+STDERR");
|
||||||
|
mergestdoe.text("Split STDOUT+ERR");
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
mergeStdOutErr = false;
|
||||||
|
stdout_fn.val("STDOUT");
|
||||||
|
}
|
||||||
|
clearStdOutput();
|
||||||
|
mergestdoe.click(function () {
|
||||||
|
clearStdOutput();
|
||||||
|
mergeStdOutErr = !mergeStdOutErr;
|
||||||
|
stdout_fn.val( mergeStdOutErr ? "STDOUT+STDERR" : "STDOUT" );
|
||||||
|
mergestdoe.text( mergeStdOutErr ? "Split STDOUT+ERR" : "Merge STDOUT+ERR" );
|
||||||
|
});
|
||||||
|
|
||||||
|
// output files
|
||||||
|
$('.outputs').remove();
|
||||||
|
if ( hash["outputs"] ) hash.outputs.forEach(function(outp) {
|
||||||
|
setupOutputFile(outp);
|
||||||
|
});
|
||||||
|
$('#addoutput').click(function () {
|
||||||
|
setupOutputFile();
|
||||||
|
});
|
||||||
|
|
||||||
|
// autorun option
|
||||||
|
if (hash["autorun"])
|
||||||
|
autoRunPerl = true;
|
||||||
|
var autorunstate = $('#autorunstate');
|
||||||
|
$('#autoruntoggle').click(function () {
|
||||||
|
// the text keeps state (bit of a hack, I know)
|
||||||
|
autorunstate.text(
|
||||||
|
autorunstate.text().match(/without/i)
|
||||||
|
? "with" : "without" );
|
||||||
|
});
|
||||||
|
|
||||||
|
// "run perl" button
|
||||||
|
$('#runperl').click( function () {
|
||||||
|
clearStdOutput();
|
||||||
|
var rp_data = getFileData();
|
||||||
|
if (!rp_data) return;
|
||||||
|
delete rp_data.cmdline;
|
||||||
|
// send message to runner
|
||||||
|
buttonBlockers.runnerState = 1;
|
||||||
|
updateButtonState();
|
||||||
|
lastExitStatus = null;
|
||||||
|
runnerState("Requesting Perl Run...");
|
||||||
|
perlRunner.postMessage({ runPerl: rp_data }, '*');
|
||||||
|
});
|
||||||
|
|
||||||
|
// "copy url / json" function
|
||||||
|
$('#copyurl').click(function () {
|
||||||
|
var data = getFileData();
|
||||||
|
if (!data) return;
|
||||||
|
delete data.argv;
|
||||||
|
if (!autorunstate.text().match(/without/i)) data.autorun=true;
|
||||||
|
if (mergeStdOutErr) data.mergeStdOutErr=true;
|
||||||
|
var loc = new URL(window.location);
|
||||||
|
loc.hash = encodeURIComponent(JSON.stringify(data));
|
||||||
|
copyit(loc);
|
||||||
|
});
|
||||||
|
$('#copyjson').click(function () {
|
||||||
|
var data = getFileData();
|
||||||
|
if (!data) return;
|
||||||
|
if (!autorunstate.text().match(/without/i)) data.autorun=true;
|
||||||
|
if (mergeStdOutErr) data.mergeStdOutErr=true;
|
||||||
|
copyit(JSON.stringify(data, null, "\t"));
|
||||||
|
});
|
||||||
|
|
||||||
|
// start looking for the Perl runner
|
||||||
|
findPerlRunner();
|
||||||
|
});
|
||||||
|
|
||||||
|
</script>
|
||||||
|
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<div id="inputhere" style="display:none;"></div>
|
||||||
|
|
||||||
|
<div id="perlctrl">
|
||||||
|
<button id="runperl"><code>perl</code> ►</button>
|
||||||
|
<input type="text" id="argv" class="code" value='perl' />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div id="runnerstate" class="text">
|
||||||
|
Loading...
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div id="runnererrors" style="display:none;">
|
||||||
|
<pre></pre>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div id="stdout" class="codewithfn" style="display:none;">
|
||||||
|
<input type="text" class="filename code" readonly="readonly" value="STDOUT" size="14" />
|
||||||
|
<textarea></textarea>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div id="stderr" class="codewithfn" style="display:none;">
|
||||||
|
<input type="text" class="filename code" readonly="readonly" value="STDERR" size="14" />
|
||||||
|
<textarea></textarea>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div id="outputhere" style="display:none;"></div>
|
||||||
|
|
||||||
|
<div class="text">
|
||||||
|
<textarea id="pageurl" style="display:none;"></textarea>
|
||||||
|
<div id="misctools">
|
||||||
|
<span id="showtools" class="fakelink">Show Tools</span>
|
||||||
|
<span id="thetools" style="display:none;">
|
||||||
|
|
||||||
|
<span id="addscript" style="display:none;">•
|
||||||
|
<span class="fakelink">Add Script</span>
|
||||||
|
</span>
|
||||||
|
•
|
||||||
|
<span id="addinput" class="fakelink">Add Input File</span>
|
||||||
|
•
|
||||||
|
<span id="addoutput" class="fakelink">Add Output File</span>
|
||||||
|
•
|
||||||
|
<span id="mergestdoe" class="fakelink">Merge STDOUT+ERR</span>
|
||||||
|
•
|
||||||
|
<span id="copyurl" class="fakelink">Copy URL</span>
|
||||||
|
/ <span id="copyjson" class="fakelink">JSON</span>
|
||||||
|
(<span id="autorunstate">with</span>
|
||||||
|
<span id="autoruntoggle" class="fakelink">autorun</span>)
|
||||||
|
</span>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div class="text" id="footer" style="display:none;">
|
||||||
|
Powered by <a href="http://webperl.zero-g.net/" target="_blank" id="webperllink">WebPerl</a> (beta)
|
||||||
|
<!-- Link with target="_blank" may not work in a sandboxed iframe, so provide URL: -->
|
||||||
|
<span id="webperlurl" style="display:none;"> <code>http://webperl.zero-g.net/</code></span>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
@ -0,0 +1,178 @@
|
|||||||
|
<!doctype html>
|
||||||
|
<html lang="en-us">
|
||||||
|
<head>
|
||||||
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
|
||||||
|
<title>WebPerl Perl Runner</title>
|
||||||
|
|
||||||
|
<!-- ##### WebPerl - http://webperl.zero-g.net #####
|
||||||
|
|
||||||
|
Copyright (c) 2018 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
|
||||||
|
##### -->
|
||||||
|
|
||||||
|
<!-- Please see the documentation on how to use this in demo.html. -->
|
||||||
|
|
||||||
|
<!-- Possible To-Do for Later: This whole thing could probably also be
|
||||||
|
accomplished with a Web Worker, but that would probably require a
|
||||||
|
stripped-down version of webperl.js (that loads things without
|
||||||
|
using window.* and especially document.*
|
||||||
|
https://developer.mozilla.org/en-US/docs/Web/API/Worker/Worker
|
||||||
|
https://developer.mozilla.org/en-US/docs/Web/API/WorkerGlobalScope/importScripts
|
||||||
|
|
||||||
|
Of course, at some point I should investigate how difficult it really
|
||||||
|
is to re-start an Emscripten program...
|
||||||
|
-->
|
||||||
|
|
||||||
|
<script src="../webperl.js"></script>
|
||||||
|
<!--script src="https://webperlcdn.zero-g.net/v0.09-beta/webperl.js"
|
||||||
|
integrity="sha256-1RaYAh/WfDl3WZl+BDpSuSycg4x88pfkAFSxhWjBONk=" crossorigin="anonymous"></script-->
|
||||||
|
<script>
|
||||||
|
"use strict";
|
||||||
|
|
||||||
|
Perl.noMountIdbfs=true; // we're sandboxed
|
||||||
|
Perl.endAfterMain=true; // act like command-line perl
|
||||||
|
|
||||||
|
var knownClients = [];
|
||||||
|
var currentClient; // which client we're running Perl for, also keeps state
|
||||||
|
var curOutputFiles;
|
||||||
|
var stdbuf = [null,'',''];
|
||||||
|
|
||||||
|
function reportErr (err) {
|
||||||
|
if (currentClient)
|
||||||
|
currentClient.postMessage({ perlRunnerError: err },'*');
|
||||||
|
else
|
||||||
|
console.error(err);
|
||||||
|
}
|
||||||
|
|
||||||
|
Perl.addStateChangeListener(function (from,to) {
|
||||||
|
if (to=="Ended" && currentClient) {
|
||||||
|
for (var chan=1;chan<=2;chan++) // flush buffers
|
||||||
|
if (stdbuf[chan].length) {
|
||||||
|
currentClient.postMessage({ perlOutput: { chan:chan, data:stdbuf[chan] } },'*');
|
||||||
|
stdbuf[chan] = '';
|
||||||
|
}
|
||||||
|
currentClient.postMessage({ perlRunnerState: Perl.state,
|
||||||
|
exitStatus: Perl.exitStatus },'*');
|
||||||
|
for(var i=0; i<knownClients.length; i++)
|
||||||
|
if (knownClients[i]!=currentClient)
|
||||||
|
knownClients[i].postMessage({ perlRunnerState: Perl.state },'*');
|
||||||
|
if (curOutputFiles) {
|
||||||
|
var ofs = curOutputFiles.map(function (file) {
|
||||||
|
//TODO Later: Support binary files as well?
|
||||||
|
// {encoding:"binary"} => readFile returns Uint8Array
|
||||||
|
// Should then also provide the same support on FS.writeFile() as well
|
||||||
|
var of = { fn: file };
|
||||||
|
if (!file) return of;
|
||||||
|
try {
|
||||||
|
of.text = FS.readFile(file, {encoding:"utf8"});
|
||||||
|
}
|
||||||
|
catch (e) {
|
||||||
|
reportErr("couldn't read "+file+" because "+e);
|
||||||
|
}
|
||||||
|
return of;
|
||||||
|
});
|
||||||
|
currentClient.postMessage({ perlOutputFiles: ofs },'*');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
for(var i=0; i<knownClients.length; i++)
|
||||||
|
knownClients[i].postMessage({ perlRunnerState: Perl.state },'*');
|
||||||
|
}
|
||||||
|
if (to=="Ended") {
|
||||||
|
if (!currentClient)
|
||||||
|
console.error("Internal Error: Perl state change to Ended with no client");
|
||||||
|
window.location.reload(false);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
Perl.output = function (str,chan) {
|
||||||
|
stdbuf[chan] += str;
|
||||||
|
var pos = stdbuf[chan].lastIndexOf("\n");
|
||||||
|
if (pos<0) return;
|
||||||
|
var lines = stdbuf[chan].slice(0,pos+1);
|
||||||
|
if (currentClient)
|
||||||
|
currentClient.postMessage({ perlOutput: { chan:chan, data:lines } },'*');
|
||||||
|
else
|
||||||
|
console.error("Internal Error: Output on",chan==1?"STDOUT":"STDERR","with no client:",lines);
|
||||||
|
stdbuf[chan] = stdbuf[chan].slice(pos+1);
|
||||||
|
};
|
||||||
|
|
||||||
|
function saveFile (fn, data) {
|
||||||
|
if (fn.substring(0,1)!='/') // if relative, make absolute
|
||||||
|
fn = FS.joinPath([FS.cwd(), fn]);
|
||||||
|
try {
|
||||||
|
FS.writeFile(fn, data);
|
||||||
|
}
|
||||||
|
catch (e) {
|
||||||
|
reportErr("couldn't write "+fn+" because "+e);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
window.addEventListener('message', function (event) {
|
||||||
|
if (event.data["perlRunnerDiscovery"]) {
|
||||||
|
if (!knownClients.includes(event.source))
|
||||||
|
knownClients.push(event.source);
|
||||||
|
event.source.postMessage({ perlRunnerState: Perl.state },'*');
|
||||||
|
}
|
||||||
|
else if (event.data["runPerl"]) {
|
||||||
|
if (!knownClients.includes(event.source))
|
||||||
|
knownClients.push(event.source);
|
||||||
|
// check state
|
||||||
|
if (currentClient && currentClient !== event.source) {
|
||||||
|
console.error("Attempt to run Perl from",event.source,
|
||||||
|
"but am already running Perl for",currentClient);
|
||||||
|
reportErr("Attempt to run Perl (from "+event.origin
|
||||||
|
+") but am already running Perl for someone else (see JavaScript console)");
|
||||||
|
return;
|
||||||
|
} // else
|
||||||
|
currentClient = event.source;
|
||||||
|
if (Perl.state!="Ready") {
|
||||||
|
reportErr("Attempt to run Perl in state "+Perl.state);
|
||||||
|
return;
|
||||||
|
} // else
|
||||||
|
// set up files and run perl
|
||||||
|
var rp = event.data.runPerl;
|
||||||
|
//TODO: we don't check for overlaps in filenames between script+input files (maybe the editor should do that)
|
||||||
|
// one solution would be to just have the script be an input file (code mirror syntax highlighting based on filename?)
|
||||||
|
// note overlaps of output filenames with input files is ok
|
||||||
|
// we also don't check for duplicate filenames
|
||||||
|
if (rp["script"])
|
||||||
|
saveFile(rp["script_fn"] ? rp.script_fn : 'script.pl', rp.script);
|
||||||
|
//TODO Later: can we support STDIN? (probably need to look at webperl.js)
|
||||||
|
if (rp["inputs"])
|
||||||
|
rp.inputs.forEach(function (inp) {
|
||||||
|
if (!inp.fn) return;
|
||||||
|
saveFile(inp.fn, inp.text);
|
||||||
|
});
|
||||||
|
curOutputFiles = rp["outputs"];
|
||||||
|
Perl.start( rp["argv"] ? rp.argv : [] );
|
||||||
|
}
|
||||||
|
else console.warn("Perl Runner ignoring unknown message:", event.data);
|
||||||
|
});
|
||||||
|
|
||||||
|
Perl.init(function () {
|
||||||
|
Module['thisProgram'] = 'perl';
|
||||||
|
FS.currentPath = ENV.HOME; // NOTE: https://github.com/kripken/emscripten/issues/5873
|
||||||
|
});
|
||||||
|
|
||||||
|
</script>
|
||||||
|
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
Loading…
Reference in New Issue