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