Added experimental Perl 6 support
Hauke D
7 years ago
parent
3e8acce5f3
commit
fe8e030cdc
@ -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 */
|
||||
Loading…
Reference in New Issue