Initial public release of WebPerl
Hauke D
7 years ago
commit
8733c25cd3
@ -0,0 +1,6 @@
|
|||||||
|
/*.zip
|
||||||
|
/work/
|
||||||
|
/emperl5/
|
||||||
|
/web/emperl.js
|
||||||
|
/web/emperl.wasm
|
||||||
|
/web/emperl.data
|
||||||
@ -0,0 +1,158 @@
|
|||||||
|
NAME
|
||||||
|
perlartistic - the Perl Artistic License
|
||||||
|
|
||||||
|
SYNOPSIS
|
||||||
|
You can refer to this document in Pod via "L<perlartistic>"
|
||||||
|
Or you can see this document by entering "perldoc perlartistic"
|
||||||
|
|
||||||
|
DESCRIPTION
|
||||||
|
Perl is free software; you can redistribute it and/or modify it under
|
||||||
|
the terms of either:
|
||||||
|
|
||||||
|
a) the GNU General Public License as published by the Free
|
||||||
|
Software Foundation; either version 1, or (at your option) any
|
||||||
|
later version, or
|
||||||
|
|
||||||
|
b) the "Artistic License" which comes with this Kit.
|
||||||
|
|
||||||
|
This is "The Artistic License". It's here so that modules, programs,
|
||||||
|
etc., that want to declare this as their distribution license can link
|
||||||
|
to it.
|
||||||
|
|
||||||
|
For the GNU General Public License, see perlgpl.
|
||||||
|
|
||||||
|
The "Artistic License"
|
||||||
|
Preamble
|
||||||
|
The intent of this document is to state the conditions under which a
|
||||||
|
Package may be copied, such that the Copyright Holder maintains some
|
||||||
|
semblance of artistic control over the development of the package, while
|
||||||
|
giving the users of the package the right to use and distribute the
|
||||||
|
Package in a more-or-less customary fashion, plus the right to make
|
||||||
|
reasonable modifications.
|
||||||
|
|
||||||
|
Definitions
|
||||||
|
"Package"
|
||||||
|
refers to the collection of files distributed by the Copyright
|
||||||
|
Holder, and derivatives of that collection of files created through
|
||||||
|
textual modification.
|
||||||
|
|
||||||
|
"Standard Version"
|
||||||
|
refers to such a Package if it has not been modified, or has been
|
||||||
|
modified in accordance with the wishes of the Copyright Holder as
|
||||||
|
specified below.
|
||||||
|
|
||||||
|
"Copyright Holder"
|
||||||
|
is whoever is named in the copyright or copyrights for the package.
|
||||||
|
|
||||||
|
"You"
|
||||||
|
is you, if you're thinking about copying or distributing this
|
||||||
|
Package.
|
||||||
|
|
||||||
|
"Reasonable copying fee"
|
||||||
|
is whatever you can justify on the basis of media cost, duplication
|
||||||
|
charges, time of people involved, and so on. (You will not be
|
||||||
|
required to justify it to the Copyright Holder, but only to the
|
||||||
|
computing community at large as a market that must bear the fee.)
|
||||||
|
|
||||||
|
"Freely Available"
|
||||||
|
means that no fee is charged for the item itself, though there may
|
||||||
|
be fees involved in handling the item. It also means that recipients
|
||||||
|
of the item may redistribute it under the same conditions they
|
||||||
|
received it.
|
||||||
|
|
||||||
|
Conditions
|
||||||
|
1. You may make and give away verbatim copies of the source form of the
|
||||||
|
Standard Version of this Package without restriction, provided that
|
||||||
|
you duplicate all of the original copyright notices and associated
|
||||||
|
disclaimers.
|
||||||
|
|
||||||
|
2. You may apply bug fixes, portability fixes and other modifications
|
||||||
|
derived from the Public Domain or from the Copyright Holder. A
|
||||||
|
Package modified in such a way shall still be considered the
|
||||||
|
Standard Version.
|
||||||
|
|
||||||
|
3. You may otherwise modify your copy of this Package in any way,
|
||||||
|
provided that you insert a prominent notice in each changed file
|
||||||
|
stating how and when you changed that file, and provided that you do
|
||||||
|
at least ONE of the following:
|
||||||
|
|
||||||
|
a) place your modifications in the Public Domain or otherwise make
|
||||||
|
them Freely Available, such as by posting said modifications to
|
||||||
|
Usenet or an equivalent medium, or placing the modifications on
|
||||||
|
a major archive site such as uunet.uu.net, or by allowing the
|
||||||
|
Copyright Holder to include your modifications in the Standard
|
||||||
|
Version of the Package.
|
||||||
|
|
||||||
|
b) use the modified Package only within your corporation or
|
||||||
|
organization.
|
||||||
|
|
||||||
|
c) rename any non-standard executables so the names do not conflict
|
||||||
|
with standard executables, which must also be provided, and
|
||||||
|
provide a separate manual page for each non-standard executable
|
||||||
|
that clearly documents how it differs from the Standard Version.
|
||||||
|
|
||||||
|
d) make other distribution arrangements with the Copyright Holder.
|
||||||
|
|
||||||
|
4. You may distribute the programs of this Package in object code or
|
||||||
|
executable form, provided that you do at least ONE of the following:
|
||||||
|
|
||||||
|
a) distribute a Standard Version of the executables and library
|
||||||
|
files, together with instructions (in the manual page or
|
||||||
|
equivalent) on where to get the Standard Version.
|
||||||
|
|
||||||
|
b) accompany the distribution with the machine-readable source of
|
||||||
|
the Package with your modifications.
|
||||||
|
|
||||||
|
c) give non-standard executables non-standard names, and clearly
|
||||||
|
document the differences in manual pages (or equivalent),
|
||||||
|
together with instructions on where to get the Standard Version.
|
||||||
|
|
||||||
|
d) make other distribution arrangements with the Copyright Holder.
|
||||||
|
|
||||||
|
5. You may charge a reasonable copying fee for any distribution of this
|
||||||
|
Package. You may charge any fee you choose for support of this
|
||||||
|
Package. You may not charge a fee for this Package itself. However,
|
||||||
|
you may distribute this Package in aggregate with other (possibly
|
||||||
|
commercial) programs as part of a larger (possibly commercial)
|
||||||
|
software distribution provided that you do not advertise this
|
||||||
|
Package as a product of your own. You may embed this Package's
|
||||||
|
interpreter within an executable of yours (by linking); this shall
|
||||||
|
be construed as a mere form of aggregation, provided that the
|
||||||
|
complete Standard Version of the interpreter is so embedded.
|
||||||
|
|
||||||
|
6. The scripts and library files supplied as input to or produced as
|
||||||
|
output from the programs of this Package do not automatically fall
|
||||||
|
under the copyright of this Package, but belong to whoever generated
|
||||||
|
them, and may be sold commercially, and may be aggregated with this
|
||||||
|
Package. If such scripts or library files are aggregated with this
|
||||||
|
Package via the so-called "undump" or "unexec" methods of producing
|
||||||
|
a binary executable image, then distribution of such an image shall
|
||||||
|
neither be construed as a distribution of this Package nor shall it
|
||||||
|
fall under the restrictions of Paragraphs 3 and 4, provided that you
|
||||||
|
do not represent such an executable image as a Standard Version of
|
||||||
|
this Package.
|
||||||
|
|
||||||
|
7. C subroutines (or comparably compiled subroutines in other
|
||||||
|
languages) supplied by you and linked into this Package in order to
|
||||||
|
emulate subroutines and variables of the language defined by this
|
||||||
|
Package shall not be considered part of this Package, but are the
|
||||||
|
equivalent of input as in Paragraph 6, provided these subroutines do
|
||||||
|
not change the language in any way that would cause it to fail the
|
||||||
|
regression tests for the language.
|
||||||
|
|
||||||
|
8. Aggregation of this Package with a commercial distribution is always
|
||||||
|
permitted provided that the use of this Package is embedded; that
|
||||||
|
is, when no overt attempt is made to make this Package's interfaces
|
||||||
|
visible to the end user of the commercial distribution. Such use
|
||||||
|
shall not be construed as a distribution of this Package.
|
||||||
|
|
||||||
|
9. The name of the Copyright Holder may not be used to endorse or
|
||||||
|
promote products derived from this software without specific prior
|
||||||
|
written permission.
|
||||||
|
|
||||||
|
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
|
||||||
|
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
||||||
|
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
|
The End
|
||||||
|
|
||||||
@ -0,0 +1,281 @@
|
|||||||
|
NAME
|
||||||
|
perlgpl - the GNU General Public License, version 1
|
||||||
|
|
||||||
|
SYNOPSIS
|
||||||
|
You can refer to this document in Pod via "L<perlgpl>"
|
||||||
|
Or you can see this document by entering "perldoc perlgpl"
|
||||||
|
|
||||||
|
DESCRIPTION
|
||||||
|
Perl is free software; you can redistribute it and/or modify it under
|
||||||
|
the terms of either:
|
||||||
|
|
||||||
|
a) the GNU General Public License as published by the Free
|
||||||
|
Software Foundation; either version 1, or (at your option) any
|
||||||
|
later version, or
|
||||||
|
|
||||||
|
b) the "Artistic License" which comes with this Kit.
|
||||||
|
|
||||||
|
This is the "GNU General Public License, version 1". It's here so that
|
||||||
|
modules, programs, etc., that want to declare this as their distribution
|
||||||
|
license can link to it.
|
||||||
|
|
||||||
|
For the Perl Artistic License, see perlartistic.
|
||||||
|
|
||||||
|
GNU GENERAL PUBLIC LICENSE
|
||||||
|
GNU GENERAL PUBLIC LICENSE
|
||||||
|
Version 1, February 1989
|
||||||
|
|
||||||
|
Copyright (C) 1989 Free Software Foundation, Inc.
|
||||||
|
51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
||||||
|
|
||||||
|
Everyone is permitted to copy and distribute verbatim copies
|
||||||
|
of this license document, but changing it is not allowed.
|
||||||
|
|
||||||
|
Preamble
|
||||||
|
|
||||||
|
The license agreements of most software companies try to keep users
|
||||||
|
at the mercy of those companies. By contrast, our General Public
|
||||||
|
License is intended to guarantee your freedom to share and change free
|
||||||
|
software--to make sure the software is free for all its users. The
|
||||||
|
General Public License applies to the Free Software Foundation's
|
||||||
|
software and to any other program whose authors commit to using it.
|
||||||
|
You can use it for your programs, too.
|
||||||
|
|
||||||
|
When we speak of free software, we are referring to freedom, not
|
||||||
|
price. Specifically, the General Public License is designed to make
|
||||||
|
sure that you have the freedom to give away or sell copies of free
|
||||||
|
software, that you receive source code or can get it if you want it,
|
||||||
|
that you can change the software or use pieces of it in new free
|
||||||
|
programs; and that you know you can do these things.
|
||||||
|
|
||||||
|
To protect your rights, we need to make restrictions that forbid
|
||||||
|
anyone to deny you these rights or to ask you to surrender the rights.
|
||||||
|
These restrictions translate to certain responsibilities for you if you
|
||||||
|
distribute copies of the software, or if you modify it.
|
||||||
|
|
||||||
|
For example, if you distribute copies of a such a program, whether
|
||||||
|
gratis or for a fee, you must give the recipients all the rights that
|
||||||
|
you have. You must make sure that they, too, receive or can get the
|
||||||
|
source code. And you must tell them their rights.
|
||||||
|
|
||||||
|
We protect your rights with two steps: (1) copyright the software,
|
||||||
|
and (2) offer you this license which gives you legal permission to
|
||||||
|
copy, distribute and/or modify the software.
|
||||||
|
|
||||||
|
Also, for each author's protection and ours, we want to make certain
|
||||||
|
that everyone understands that there is no warranty for this free
|
||||||
|
software. If the software is modified by someone else and passed on,
|
||||||
|
we want its recipients to know that what they have is not the original,
|
||||||
|
so that any problems introduced by others will not reflect on the
|
||||||
|
original authors' reputations.
|
||||||
|
|
||||||
|
The precise terms and conditions for copying, distribution and
|
||||||
|
modification follow.
|
||||||
|
|
||||||
|
GNU GENERAL PUBLIC LICENSE
|
||||||
|
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
|
||||||
|
|
||||||
|
0. This License Agreement applies to any program or other work which
|
||||||
|
contains a notice placed by the copyright holder saying it may be
|
||||||
|
distributed under the terms of this General Public License. The
|
||||||
|
"Program", below, refers to any such program or work, and a "work based
|
||||||
|
on the Program" means either the Program or any work containing the
|
||||||
|
Program or a portion of it, either verbatim or with modifications.
|
||||||
|
Each licensee is addressed as "you".
|
||||||
|
|
||||||
|
1. You may copy and distribute verbatim copies of the Program's
|
||||||
|
source code as you receive it, in any medium, provided that you
|
||||||
|
conspicuously and appropriately publish on each copy an appropriate
|
||||||
|
copyright notice and disclaimer of warranty; keep intact all the
|
||||||
|
notices that refer to this General Public License and to the absence of
|
||||||
|
any warranty; and give any other recipients of the Program a copy of
|
||||||
|
this General Public License along with the Program. You may charge a
|
||||||
|
fee for the physical act of transferring a copy.
|
||||||
|
|
||||||
|
2. You may modify your copy or copies of the Program or any portion
|
||||||
|
of it, and copy and distribute such modifications under the terms of
|
||||||
|
Paragraph 1 above, provided that you also do the following:
|
||||||
|
|
||||||
|
a) cause the modified files to carry prominent notices stating that
|
||||||
|
you changed the files and the date of any change; and
|
||||||
|
|
||||||
|
b) cause the whole of any work that you distribute or publish, that
|
||||||
|
in whole or in part contains the Program or any part thereof,
|
||||||
|
either with or without modifications, to be licensed at no charge
|
||||||
|
to all third parties under the terms of this General Public License
|
||||||
|
(except that you may choose to grant warranty protection to some or
|
||||||
|
all third parties, at your option).
|
||||||
|
|
||||||
|
c) If the modified program normally reads commands interactively
|
||||||
|
when run, you must cause it, when started running for such
|
||||||
|
interactive use in the simplest and most usual way, to print or
|
||||||
|
display an announcement including an appropriate copyright notice
|
||||||
|
and a notice that there is no warranty (or else, saying that you
|
||||||
|
provide a warranty) and that users may redistribute the program
|
||||||
|
under these conditions, and telling the user how to view a copy of
|
||||||
|
this General Public License.
|
||||||
|
|
||||||
|
d) You may charge a fee for the physical act of transferring a
|
||||||
|
copy, and you may at your option offer warranty protection in
|
||||||
|
exchange for a fee.
|
||||||
|
|
||||||
|
Mere aggregation of another independent work with the Program (or its
|
||||||
|
derivative) on a volume of a storage or distribution medium does not
|
||||||
|
bring the other work under the scope of these terms.
|
||||||
|
|
||||||
|
3. You may copy and distribute the Program (or a portion or
|
||||||
|
derivative of it, under Paragraph 2) in object code or executable form
|
||||||
|
under the terms of Paragraphs 1 and 2 above provided that you also do
|
||||||
|
one of the following:
|
||||||
|
|
||||||
|
a) accompany it with the complete corresponding machine-readable
|
||||||
|
source code, which must be distributed under the terms of
|
||||||
|
Paragraphs 1 and 2 above; or,
|
||||||
|
|
||||||
|
b) accompany it with a written offer, valid for at least three
|
||||||
|
years, to give any third party free (except for a nominal charge
|
||||||
|
for the cost of distribution) a complete machine-readable copy of
|
||||||
|
the corresponding source code, to be distributed under the terms of
|
||||||
|
Paragraphs 1 and 2 above; or,
|
||||||
|
|
||||||
|
c) accompany it with the information you received as to where the
|
||||||
|
corresponding source code may be obtained. (This alternative is
|
||||||
|
allowed only for noncommercial distribution and only if you
|
||||||
|
received the program in object code or executable form alone.)
|
||||||
|
|
||||||
|
Source code for a work means the preferred form of the work for making
|
||||||
|
modifications to it. For an executable file, complete source code
|
||||||
|
means all the source code for all modules it contains; but, as a
|
||||||
|
special exception, it need not include source code for modules which
|
||||||
|
are standard libraries that accompany the operating system on which the
|
||||||
|
executable file runs, or for standard header files or definitions files
|
||||||
|
that accompany that operating system.
|
||||||
|
|
||||||
|
4. You may not copy, modify, sublicense, distribute or transfer the
|
||||||
|
Program except as expressly provided under this General Public License.
|
||||||
|
Any attempt otherwise to copy, modify, sublicense, distribute or
|
||||||
|
transfer the Program is void, and will automatically terminate your
|
||||||
|
rights to use the Program under this License. However, parties who
|
||||||
|
have received copies, or rights to use copies, from you under this
|
||||||
|
General Public License will not have their licenses terminated so long
|
||||||
|
as such parties remain in full compliance.
|
||||||
|
|
||||||
|
5. By copying, distributing or modifying the Program (or any work
|
||||||
|
based on the Program) you indicate your acceptance of this license to
|
||||||
|
do so, and all its terms and conditions.
|
||||||
|
|
||||||
|
6. Each time you redistribute the Program (or any work based on the
|
||||||
|
Program), the recipient automatically receives a license from the
|
||||||
|
original licensor to copy, distribute or modify the Program subject to
|
||||||
|
these terms and conditions. You may not impose any further
|
||||||
|
restrictions on the recipients' exercise of the rights granted herein.
|
||||||
|
|
||||||
|
7. The Free Software Foundation may publish revised and/or new
|
||||||
|
versions of the General Public License from time to time. Such new
|
||||||
|
versions will be similar in spirit to the present version, but may
|
||||||
|
differ in detail to address new problems or concerns.
|
||||||
|
|
||||||
|
Each version is given a distinguishing version number. If the Program
|
||||||
|
specifies a version number of the license which applies to it and "any
|
||||||
|
later version", you have the option of following the terms and
|
||||||
|
conditions either of that version or of any later version published by
|
||||||
|
the Free Software Foundation. If the Program does not specify a
|
||||||
|
version number of the license, you may choose any version ever
|
||||||
|
published by the Free Software Foundation.
|
||||||
|
|
||||||
|
8. If you wish to incorporate parts of the Program into other free
|
||||||
|
programs whose distribution conditions are different, write to the
|
||||||
|
author to ask for permission. For software which is copyrighted by the
|
||||||
|
Free Software Foundation, write to the Free Software Foundation; we
|
||||||
|
sometimes make exceptions for this. Our decision will be guided by the
|
||||||
|
two goals of preserving the free status of all derivatives of our free
|
||||||
|
software and of promoting the sharing and reuse of software generally.
|
||||||
|
|
||||||
|
NO WARRANTY
|
||||||
|
|
||||||
|
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO
|
||||||
|
WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
|
||||||
|
EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
|
||||||
|
OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND,
|
||||||
|
EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||||
|
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS
|
||||||
|
WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
|
||||||
|
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
|
||||||
|
|
||||||
|
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
|
||||||
|
WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
|
||||||
|
AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU
|
||||||
|
FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
|
||||||
|
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
|
||||||
|
PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
|
||||||
|
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
|
||||||
|
FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF
|
||||||
|
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
|
||||||
|
DAMAGES.
|
||||||
|
|
||||||
|
END OF TERMS AND CONDITIONS
|
||||||
|
|
||||||
|
Appendix: How to Apply These Terms to Your New Programs
|
||||||
|
|
||||||
|
If you develop a new program, and you want it to be of the greatest
|
||||||
|
possible use to humanity, the best way to achieve this is to make it
|
||||||
|
free software which everyone can redistribute and change under these
|
||||||
|
terms.
|
||||||
|
|
||||||
|
To do so, attach the following notices to the program. It is safest
|
||||||
|
to attach them to the start of each source file to most effectively
|
||||||
|
convey the exclusion of warranty; and each file should have at least
|
||||||
|
the "copyright" line and a pointer to where the full notice is found.
|
||||||
|
|
||||||
|
<one line to give the program's name and a brief idea of what it
|
||||||
|
does.>
|
||||||
|
Copyright (C) 19yy <name of author>
|
||||||
|
|
||||||
|
This program is free software; you can redistribute it and/or
|
||||||
|
modify it under the terms of the GNU General Public License as
|
||||||
|
published by the Free Software Foundation; either version 1, or (at
|
||||||
|
your option) any later version.
|
||||||
|
|
||||||
|
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
|
||||||
|
GNU General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program; if not, write to the Free Software
|
||||||
|
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA
|
||||||
|
02110-1301 USA
|
||||||
|
|
||||||
|
|
||||||
|
Also add information on how to contact you by electronic and paper
|
||||||
|
mail.
|
||||||
|
|
||||||
|
If the program is interactive, make it output a short notice like this
|
||||||
|
when it starts in an interactive mode:
|
||||||
|
|
||||||
|
Gnomovision version 69, Copyright (C) 19xx name of author
|
||||||
|
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type
|
||||||
|
'show w'. This is free software, and you are welcome to
|
||||||
|
redistribute it under certain conditions; type 'show c' for
|
||||||
|
details.
|
||||||
|
|
||||||
|
The hypothetical commands 'show w' and 'show c' should show the
|
||||||
|
appropriate parts of the General Public License. Of course, the
|
||||||
|
commands you use may be called something other than 'show w' and 'show
|
||||||
|
c'; they could even be mouse-clicks or menu items--whatever suits your
|
||||||
|
program.
|
||||||
|
|
||||||
|
You should also get your employer (if you work as a programmer) or your
|
||||||
|
school, if any, to sign a "copyright disclaimer" for the program, if
|
||||||
|
necessary. Here a sample; alter the names:
|
||||||
|
|
||||||
|
Yoyodyne, Inc., hereby disclaims all copyright interest in the
|
||||||
|
program 'Gnomovision' (a program to direct compilers to make passes
|
||||||
|
at assemblers) written by James Hacker.
|
||||||
|
|
||||||
|
<signature of Ty Coon>, 1 April 1989
|
||||||
|
Ty Coon, President of Vice
|
||||||
|
|
||||||
|
That's all there is to it!
|
||||||
|
|
||||||
@ -0,0 +1,39 @@
|
|||||||
|
|
||||||
|
WebPerl
|
||||||
|
=======
|
||||||
|
|
||||||
|
This is the main WebPerl repository.
|
||||||
|
Please see the documentation on the main site **<http://webperl.zero-g.net>**:
|
||||||
|
|
||||||
|
\[ [Home](https://webperl.zero-g.net/index.html) -
|
||||||
|
[Using WebPerl](https://webperl.zero-g.net/using.html) -
|
||||||
|
[Building WebPerl](https://webperl.zero-g.net/building.html) -
|
||||||
|
[Wiki](https://github.com/haukex/webperl/wiki) -
|
||||||
|
[GitHub](https://github.com/haukex/webperl) -
|
||||||
|
[Notes](https://webperl.zero-g.net/notes.html) -
|
||||||
|
[Legal](https://webperl.zero-g.net/legal.html) \]
|
||||||
|
|
||||||
|
|
||||||
|
Author, Copyright, and License
|
||||||
|
==============================
|
||||||
|
|
||||||
|
**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>.
|
||||||
|
|
||||||
@ -0,0 +1,31 @@
|
|||||||
|
|
||||||
|
WebPerl TODOs
|
||||||
|
=============
|
||||||
|
|
||||||
|
<http://webperl.zero-g.net>
|
||||||
|
|
||||||
|
1. Documentation (Website)
|
||||||
|
|
||||||
|
- Using WebPerl
|
||||||
|
- the user must explicitly "unregister" anonymous Perl subs (or show alternatives) to prevent %CodeTable from growing too large
|
||||||
|
- the user shouldn't mess with the symbol table (delete subs, redefine them, etc.)
|
||||||
|
- <http://kripken.github.io/emscripten-site/docs/compiling/Deploying-Pages.html>
|
||||||
|
- Building WebPerl
|
||||||
|
- test out perl -Mlazy to install all the deps (and if it works well, document)
|
||||||
|
|
||||||
|
2. Testing
|
||||||
|
|
||||||
|
- Continue work on `WebPerl.t`
|
||||||
|
- More tests for Unicode support (Perl/JS interface, Perl.eval(), plus Emscripten's virtual FS)
|
||||||
|
- I should focus on getting the tests running in the browser instead of node.js
|
||||||
|
- How to package tests? How does `make test` find&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
|
||||||
|
|
||||||
|
See also: "TODO" tags in code (use `findtodo.sh`)
|
||||||
|
|
||||||
@ -0,0 +1,465 @@
|
|||||||
|
#!/usr/bin/env perl
|
||||||
|
use warnings;
|
||||||
|
use 5.026;
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
Build script for WebPerl; see L<http://webperl.zero-g.net>.
|
||||||
|
|
||||||
|
build.pl [OPTIONS]
|
||||||
|
OPTIONS:
|
||||||
|
--showconf - Show configuration
|
||||||
|
--reconfig - Force regeneration config.sh
|
||||||
|
--forceext - Force fetching of extensions
|
||||||
|
--applyconfig - Apply any changes to config.sh (sh Configure -S)
|
||||||
|
--remakeout - Force rebuild of the output directory
|
||||||
|
--forceemperl - Force rebuild of emperl.js
|
||||||
|
--dist=FN - Create a distro file "FN.zip"
|
||||||
|
--verbose - Be more verbose
|
||||||
|
|
||||||
|
=head1 Author, Copyright, and License
|
||||||
|
|
||||||
|
B<< WebPerl L<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, L<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
|
||||||
|
B<WITHOUT ANY WARRANTY>; without even the implied warranty of
|
||||||
|
B<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 L<http://perldoc.perl.org/index-licence.html>.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
use Getopt::Long qw/ HelpMessage :config posix_default gnu_compat bundling auto_version auto_help /;
|
||||||
|
use Hash::Util qw/lock_hash/;
|
||||||
|
use Data::Dump;
|
||||||
|
use Path::Class qw/file dir/;
|
||||||
|
use IPC::Run3::Shell {show_cmd=>1}, qw/ :FATAL :run git make emmake /;
|
||||||
|
use ExtUtils::MakeMaker qw/prompt/;
|
||||||
|
use FindBin ();
|
||||||
|
use Carp;
|
||||||
|
use Cwd qw/getcwd abs_path/;
|
||||||
|
use URI ();
|
||||||
|
use IO::Socket::SSL 1.56 (); # for HTTP::Tiny
|
||||||
|
use Net::SSLeay 1.49 (); # for HTTP::Tiny
|
||||||
|
use HTTP::Tiny ();
|
||||||
|
use Cpanel::JSON::XS qw/decode_json/;
|
||||||
|
use File::Temp qw/tempdir/;
|
||||||
|
use Archive::Tar ();
|
||||||
|
use File::Copy::Recursive qw/dirmove/;
|
||||||
|
use File::Replace qw/replace3/;
|
||||||
|
use Pod::Strip ();
|
||||||
|
use Archive::Zip qw/AZ_OK/;
|
||||||
|
|
||||||
|
GetOptions(\my %opts,'showconf','reconfig','forceext','applyconfig',
|
||||||
|
'forceemperl','remakeout','dist=s','verbose')
|
||||||
|
or HelpMessage(-exitval=>255);
|
||||||
|
|
||||||
|
# check that emperl_config.sh has been run
|
||||||
|
die "Please run '. emperl_config.sh' to set up the environment variables.\n"
|
||||||
|
unless $ENV{EMPERL_PERLVER};
|
||||||
|
die "Please edit 'emperl_config.sh' to point it to the correct location of 'emsdk_env.sh'\n"
|
||||||
|
unless $ENV{EMSCRIPTEN} && -d $ENV{EMSCRIPTEN} && $ENV{EMSDK} && -d $ENV{EMSDK};
|
||||||
|
|
||||||
|
# copy over config variables from environment
|
||||||
|
my %C = map {$_=>$ENV{'EMPERL_'.$_}} qw/ EXTENSIONS
|
||||||
|
HOSTPERLDIR OUTPUTDIR DOWNLOADDIR PERLSRCDIR
|
||||||
|
PREFIX PERLVER
|
||||||
|
PERL_REPO PERL_BRANCH CLOBBER_BRANCH /;
|
||||||
|
$C{$_} = dir($C{$_}) for qw/ HOSTPERLDIR OUTPUTDIR DOWNLOADDIR PERLSRCDIR /;
|
||||||
|
$C{EXTENSIONS} = [ split ' ', $C{EXTENSIONS} ];
|
||||||
|
lock_hash %C; # typo prevention
|
||||||
|
dd \%C if $opts{showconf};
|
||||||
|
|
||||||
|
my $VERBOSE = $opts{verbose}?1:0;
|
||||||
|
my $needs_reconfig = !!$opts{reconfig};
|
||||||
|
|
||||||
|
# ##### ##### ##### Step: Patch Emscripten ##### ##### #####
|
||||||
|
|
||||||
|
{
|
||||||
|
my $d = pushd( dir($ENV{EMSCRIPTEN}, 'src') );
|
||||||
|
# Emscripten's fork() (and system()) stubs return EAGAIN, meaning "Resource temporarily unavailable".
|
||||||
|
# So perl will wait 5 seconds and try again, which is not helpful to us, since Emscripten doesn't support those functions at all.
|
||||||
|
# This patch fixes that on the Emscripten side, so the stubs return ENOTSUP.
|
||||||
|
#TODO Later: we should probably verify the Emscripten version too, and in the future we may need different patches for different versions
|
||||||
|
if ( try_patch_file( file($FindBin::Bin,'emscripten_1.38.10_eagain.patch') ) ) {
|
||||||
|
say STDERR "# Emscripten was newly patched, forcing a rebuild";
|
||||||
|
# not sure if the following is needed, but playing it safe:
|
||||||
|
run 'emcc', '--clear-cache'; # force Emscripten to rebuild libs (takes a bit of time)
|
||||||
|
$needs_reconfig=1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# ##### ##### ##### Step: Check out Perl sources ##### ##### #####
|
||||||
|
|
||||||
|
if (!-e $C{PERLSRCDIR}) {
|
||||||
|
say STDERR "# $C{PERLSRCDIR} doesn't exist, checking out";
|
||||||
|
my $d = pushd($C{PERLSRCDIR}->parent);
|
||||||
|
git 'clone', '--branch', $C{PERL_BRANCH}, $C{PERL_REPO}, $C{PERLSRCDIR}->basename;
|
||||||
|
die "something went wrong with git clone" unless -d $C{PERLSRCDIR};
|
||||||
|
$needs_reconfig=1;
|
||||||
|
}
|
||||||
|
{
|
||||||
|
my $d = pushd($C{PERLSRCDIR});
|
||||||
|
git 'fetch';
|
||||||
|
my $myhead = git 'log', '-1', '--format=%h', $C{PERL_BRANCH}, {chomp=>1,show_cmd=>$VERBOSE};
|
||||||
|
my $remhead = git 'log', '-1', '--format=%h', 'origin/'.$C{PERL_BRANCH}, {chomp=>1,show_cmd=>$VERBOSE};
|
||||||
|
say STDERR "# Local branch is at $myhead, remote is $remhead";
|
||||||
|
if ($myhead ne $remhead) {
|
||||||
|
if (prompt("Would you like to update? WARNING: Unsaved local changes may be lost! [Yn]","y")=~/^\s*y/i) {
|
||||||
|
eval {
|
||||||
|
if ($C{CLOBBER_BRANCH}) {
|
||||||
|
say "WARNING: I am about to clobber the branch $C{PERL_BRANCH} in $C{PERLSRCDIR}!";
|
||||||
|
verify_perlsrc_modify(1);
|
||||||
|
git 'checkout', '-q', $C{PERLVER};
|
||||||
|
git 'branch', '-D', $C{PERL_BRANCH};
|
||||||
|
git 'branch', $C{PERL_BRANCH}, 'origin/'.$C{PERL_BRANCH};
|
||||||
|
git 'checkout', $C{PERL_BRANCH};
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
git 'checkout', $C{PERL_BRANCH};
|
||||||
|
git 'pull';
|
||||||
|
}
|
||||||
|
1 } or die "$@\nA git step failed - perhaps you have uncommited changes in $C{PERLSRCDIR}?\n";
|
||||||
|
$needs_reconfig=1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
my $tags = git 'tag', '--list', {show_cmd=>$VERBOSE};
|
||||||
|
die "could not find tag '$C{PERLVER}', is this the right repository?"
|
||||||
|
unless $tags=~/^\Q$C{PERLVER}\E$/m;
|
||||||
|
my $branches = git 'branch', '--list', {show_cmd=>$VERBOSE};
|
||||||
|
die "could not find branch '$C{PERL_BRANCH}', is this the right repository?"
|
||||||
|
unless $branches=~/^\*?\s*\b\Q$C{PERL_BRANCH}\E$/m;
|
||||||
|
say STDERR "# Found tag '$C{PERLVER}' and branch '$C{PERL_BRANCH}' in $C{PERLSRCDIR}";
|
||||||
|
}
|
||||||
|
sub verify_perlsrc_modify {
|
||||||
|
my $force = shift;
|
||||||
|
state $already_prompted = 0;
|
||||||
|
$already_prompted=0 if $force;
|
||||||
|
return if $already_prompted;
|
||||||
|
if (prompt("WARNING: You will lose any changes to the working copy and index in $C{PERLSRCDIR}!\n"
|
||||||
|
." Continue? [yN]","n")!~/^\s*y/i) {
|
||||||
|
say STDERR "Aborting.";
|
||||||
|
exit 1;
|
||||||
|
} else { $already_prompted = 1 }
|
||||||
|
}
|
||||||
|
|
||||||
|
# ##### ##### ##### Step: Check/build hostperl ##### ##### #####
|
||||||
|
|
||||||
|
sub verify_hostperl {
|
||||||
|
my $miniperl = $C{HOSTPERLDIR}->file('miniperl');
|
||||||
|
return 0 unless -e $miniperl;
|
||||||
|
my $miniperlver = run $miniperl, '-e', 'print $^V', {show_cmd=>$VERBOSE};
|
||||||
|
say STDERR "# Detected hostperl / miniperl '$miniperlver' (need '$C{PERLVER}')";
|
||||||
|
my $perl = $C{HOSTPERLDIR}->file('perl');
|
||||||
|
if (-e $perl) { # currently just an optional check
|
||||||
|
my $perlver = run $perl, '-e', 'print $^V', {show_cmd=>$VERBOSE};
|
||||||
|
say STDERR "# Detected hostperl / perl '$perlver'";
|
||||||
|
die "miniperl ('$miniperlver') / perl ('$perlver') version mismatch"
|
||||||
|
unless $miniperlver eq $perlver;
|
||||||
|
}
|
||||||
|
return $miniperlver eq $C{PERLVER};
|
||||||
|
}
|
||||||
|
if (!verify_hostperl()) {
|
||||||
|
say STDERR "# A rebuild of hostperl is required";
|
||||||
|
$C{HOSTPERLDIR}->rmtree(1);
|
||||||
|
$C{HOSTPERLDIR}->mkpath(1);
|
||||||
|
verify_perlsrc_modify();
|
||||||
|
{
|
||||||
|
my $d = pushd($C{PERLSRCDIR});
|
||||||
|
git 'checkout', '-qf', $C{PERLVER};
|
||||||
|
git 'clean', '-dxf';
|
||||||
|
}
|
||||||
|
{
|
||||||
|
my $d = pushd($C{HOSTPERLDIR});
|
||||||
|
run {stdin=>\undef}, 'sh', file($C{PERLSRCDIR},'Configure'),
|
||||||
|
'-des', '-Dusedevel', '-Dmksymlinks';
|
||||||
|
make 'miniperl';
|
||||||
|
make 'minitest';
|
||||||
|
make 'generate_uudmap';
|
||||||
|
#TODO Later: do we really need the following full perl build as well? (good for testing?)
|
||||||
|
# if we do, make the test for "perl" in verify_hostperl required, not optional
|
||||||
|
make 'perl';
|
||||||
|
make 'test';
|
||||||
|
}
|
||||||
|
$needs_reconfig=1;
|
||||||
|
die "something went wrong with hostperl" unless verify_hostperl();
|
||||||
|
}
|
||||||
|
|
||||||
|
# ##### ##### ##### Step: Prep "emperl" sources (for next steps) ##### ##### #####
|
||||||
|
|
||||||
|
my $config_sh = $C{PERLSRCDIR}->file('config.sh');
|
||||||
|
if (!-e $config_sh) {
|
||||||
|
say STDERR "# config.sh NOT found, forcing a reconfig";
|
||||||
|
$needs_reconfig=1 }
|
||||||
|
else { say STDERR "# config.sh found" }
|
||||||
|
|
||||||
|
if (-e $config_sh) {
|
||||||
|
my $our_mtime = file($FindBin::Bin, 'emperl_config.sh')->stat->mtime;
|
||||||
|
my $perl_mtime = $config_sh->stat->mtime;
|
||||||
|
if ($perl_mtime>$our_mtime)
|
||||||
|
{ say STDERR "# config.sh is newer than emperl_config.sh" }
|
||||||
|
else {
|
||||||
|
say STDERR "# config.sh is OLDER than emperl_config.sh, forcing a reconfig";
|
||||||
|
$needs_reconfig=1 }
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($needs_reconfig) {
|
||||||
|
exit 1 if prompt("Looks like we need a full reconfig. Continue? [Yn]","y")!~/^\s*y/i;
|
||||||
|
verify_perlsrc_modify();
|
||||||
|
my $d = pushd($C{PERLSRCDIR});
|
||||||
|
# Note: could get the current branch with: git 'rev-parse', '--abbrev-ref', 'HEAD', {chomp=>1};
|
||||||
|
# but since we're clobbering anyway...
|
||||||
|
git 'checkout', '-qf', $C{PERL_BRANCH};
|
||||||
|
git 'clean', '-dxf';
|
||||||
|
}
|
||||||
|
|
||||||
|
# ##### ##### ##### Step: Add custom extensions ##### ##### #####
|
||||||
|
|
||||||
|
if ($needs_reconfig || $opts{forceext}) {
|
||||||
|
my $http = HTTP::Tiny->new;
|
||||||
|
$C{DOWNLOADDIR}->mkpath(1);
|
||||||
|
for my $modname ($C{EXTENSIONS}->@*) {
|
||||||
|
my $apiuri = URI->new('https://fastapi.metacpan.org/v1/download_url');
|
||||||
|
$apiuri->path_segments( $apiuri->path_segments, $modname );
|
||||||
|
say STDERR "# Fetching $apiuri...";
|
||||||
|
my $resp1 = $http->get($apiuri);
|
||||||
|
die "$apiuri: $resp1->{status} $resp1->{reason}\n" unless $resp1->{success};
|
||||||
|
my $apiresp = decode_json($resp1->{content});
|
||||||
|
my $version = $apiresp->{version};
|
||||||
|
my $dluri = URI->new($apiresp->{download_url});
|
||||||
|
|
||||||
|
my $file = $C{DOWNLOADDIR}->file( ($dluri->path_segments)[-1] );
|
||||||
|
die "I don't know what to do with this file type (yet): $file"
|
||||||
|
unless $file->basename=~/(?:\.tar\.gz|\.tgz)$/i;
|
||||||
|
|
||||||
|
say STDERR "# Fetching $dluri into $file...";
|
||||||
|
my $resp2 = $http->mirror($dluri, $file);
|
||||||
|
die "$dluri: $resp2->{status} $resp2->{reason}\n" unless $resp2->{success};
|
||||||
|
say STDERR "# $dluri: $resp2->{status} $resp2->{reason}";
|
||||||
|
|
||||||
|
my $tempd = dir( tempdir(DIR=>$C{DOWNLOADDIR}, CLEANUP => 1) );
|
||||||
|
{
|
||||||
|
my $d = pushd($tempd);
|
||||||
|
my @files = Archive::Tar->new->extract_archive($file, Archive::Tar::COMPRESS_GZIP);
|
||||||
|
say STDERR "# Extracted ",0+@files," files into $tempd";
|
||||||
|
}
|
||||||
|
|
||||||
|
my @dirs = $tempd->children;
|
||||||
|
die "Can't handle the directory structure of this file (yet): $file"
|
||||||
|
unless @dirs==1 && $dirs[0]->is_dir;
|
||||||
|
my ($dirname) = $dirs[0]->basename =~ /^(.+)-\Q$version\E$/g
|
||||||
|
or die "Failed to parse ".$dirs[0]->basename;
|
||||||
|
my $targdir = $C{PERLSRCDIR}->subdir( 'ext', $dirname );
|
||||||
|
my $domove = 1;
|
||||||
|
if (-e $targdir) {
|
||||||
|
if ( prompt("WARNING: $targdir exists, Keep or Delete? [Kd]","k")=~/^\s*d/i )
|
||||||
|
{ $targdir->rmtree(1) }
|
||||||
|
else { $domove=0 }
|
||||||
|
}
|
||||||
|
if ($domove) {
|
||||||
|
say STDERR "# Moving $dirs[0] to $targdir";
|
||||||
|
dirmove($dirs[0], $targdir)
|
||||||
|
or die "move failed: $!";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
say STDERR "# Done setting up modules";
|
||||||
|
}
|
||||||
|
else { say STDERR "# Since we don't need a reconfig, not looking at extensions" }
|
||||||
|
|
||||||
|
# ##### ##### ##### Step: Run configure ##### ##### #####
|
||||||
|
|
||||||
|
if ($needs_reconfig) { # this means that we cleaned the source tree above
|
||||||
|
say STDERR "# Running Configure...";
|
||||||
|
my $d = pushd($C{PERLSRCDIR});
|
||||||
|
# note that we don't use -Dmksymlinks here because something in the
|
||||||
|
# Emscripten build process seems to have issues with the symlinks (?)
|
||||||
|
run {stdin=>\undef}, 'emconfigure', 'sh', 'Configure', '-des',
|
||||||
|
'-Dhintfile=emscripten';
|
||||||
|
}
|
||||||
|
elsif ($opts{applyconfig}) {
|
||||||
|
say STDERR "# Running Configure -S...";
|
||||||
|
my $d = pushd($C{PERLSRCDIR});
|
||||||
|
run {stdin=>\undef}, 'emconfigure', 'sh', 'Configure', '-S';
|
||||||
|
}
|
||||||
|
|
||||||
|
# ##### ##### ##### Step: Build perl into outputdir ##### ##### #####
|
||||||
|
|
||||||
|
my $destdir = dir($C{OUTPUTDIR},$C{PREFIX});
|
||||||
|
if ($needs_reconfig || !-e $destdir || $opts{remakeout}) {
|
||||||
|
say STDERR "# Rebuilding $destdir...";
|
||||||
|
$destdir->rmtree(1);
|
||||||
|
# make the target dir here so that nodeperl_dev_prerun.js can mount it during build
|
||||||
|
$destdir->mkpath(1);
|
||||||
|
|
||||||
|
my $d = pushd($C{PERLSRCDIR});
|
||||||
|
|
||||||
|
emmake 'make', 'perl';
|
||||||
|
|
||||||
|
# a really basic test to see if the build succeeded
|
||||||
|
my $perltest = run file($C{PERLSRCDIR},'perl'), '-e', q{print "$^O $^V"},
|
||||||
|
{chomp=>1,show_cmd=>$VERBOSE,fail_on_stderr=>1};
|
||||||
|
die "something went wrong building perl (got: '$perltest')"
|
||||||
|
unless $perltest eq 'emscripten '.$C{PERLVER};
|
||||||
|
|
||||||
|
# note that installperl requires ./perl to be executable (our Makefile patch currently takes care of that)
|
||||||
|
run $C{HOSTPERLDIR}.'/miniperl', 'installperl', '-p', '--destdir='.$C{OUTPUTDIR};
|
||||||
|
|
||||||
|
# clean out the stuff we really don't need
|
||||||
|
$destdir->subdir('bin')->rmtree(1);
|
||||||
|
$destdir->recurse( callback => sub {
|
||||||
|
my $f = shift;
|
||||||
|
return if $f->is_dir;
|
||||||
|
if ( ( $f->basename=~/\.(?:h|a|pod)$/i ) || ( $f->basename eq 'extralibs.ld' && (-s $f)==1 )
|
||||||
|
|| ( $f->basename eq '.packlist' ) ) {
|
||||||
|
print STDERR "removing $f\n";
|
||||||
|
$f->remove or die "failed to remove $f";
|
||||||
|
}
|
||||||
|
elsif ( $f->basename=~/\.(?:pm|pl)$/i && $f->basename ne 'WebPerl.pm' ) {
|
||||||
|
print STDERR "stripping POD from $f\n";
|
||||||
|
my $strip = Pod::Strip->new;
|
||||||
|
my ($infh,$outfh,$repl) = replace3($f);
|
||||||
|
$strip->output_fh($outfh);
|
||||||
|
$strip->parse_file($infh);
|
||||||
|
$repl->finish;
|
||||||
|
}
|
||||||
|
});
|
||||||
|
CLEAN_EMPTY: {
|
||||||
|
my @todel;
|
||||||
|
$destdir->recurse( callback => sub { push @todel, $_[0] if $_[0]->is_dir && !$_[0]->children } );
|
||||||
|
for my $f (@todel) {
|
||||||
|
print STDERR "removing $f\n";
|
||||||
|
$f->remove or die "failed to remove $f";
|
||||||
|
}
|
||||||
|
redo CLEAN_EMPTY if @todel;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Development aides:
|
||||||
|
$destdir->subdir('dev')->mkpath(1);
|
||||||
|
# we make them hard links so that edits to WebPerl.pm don't require a full
|
||||||
|
# rebuild of the output directory (a rebuild of emperl.js is enough)
|
||||||
|
safelink( $C{PERLSRCDIR}->file('ext','WebPerl','WebPerl.t'),
|
||||||
|
$destdir->file('dev','WebPerl.t') );
|
||||||
|
safelink( $C{PERLSRCDIR}->file('ext','WebPerl','WebPerl.pm'),
|
||||||
|
$destdir->file('lib','5.28.0','wasm','WebPerl.pm') ); #TODO: should figure this directory out dynamically
|
||||||
|
|
||||||
|
say STDERR "# Done rebuilding $destdir";
|
||||||
|
}
|
||||||
|
|
||||||
|
# ##### ##### ##### Step: Build emperl.js ##### ##### #####
|
||||||
|
|
||||||
|
{
|
||||||
|
say STDERR "# Making emperl.js...";
|
||||||
|
if ($opts{forceemperl})
|
||||||
|
{ $C{PERLSRCDIR}->file('emperl.js')->remove
|
||||||
|
or die "failed to delete emperl.js" }
|
||||||
|
my $d = pushd($C{PERLSRCDIR});
|
||||||
|
emmake 'make', 'emperl.js';
|
||||||
|
say STDERR "# Done making emperl.js";
|
||||||
|
}
|
||||||
|
for my $f (qw/ emperl.js emperl.wasm emperl.data /) {
|
||||||
|
$C{PERLSRCDIR}->file($f)
|
||||||
|
->copy_to( dir($FindBin::Bin)->parent->subdir('web') )
|
||||||
|
or die "failed to copy $f: $!";
|
||||||
|
}
|
||||||
|
say STDERR "# Copied emperl.* files to web dir";
|
||||||
|
|
||||||
|
# ##### ##### ##### Step: Build distro ##### ##### #####
|
||||||
|
|
||||||
|
if (my $dist = $opts{dist}) {
|
||||||
|
my $basedir = dir($FindBin::Bin)->parent;
|
||||||
|
my $zipfn = $basedir->file("$dist.zip");
|
||||||
|
my $zip = Archive::Zip->new();
|
||||||
|
$zip->addTree($basedir->subdir('web').'', dir($dist).'');
|
||||||
|
$zip->writeToFileNamed("$zipfn") == AZ_OK or die "$zipfn write error";
|
||||||
|
say STDERR "# Wrote to $zipfn:";
|
||||||
|
my $unzip = Archive::Zip->new("$zipfn");
|
||||||
|
say "\t$_" for $unzip->memberNames;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# ##### ##### ##### subs ##### ##### #####
|
||||||
|
|
||||||
|
sub safelink { # like link(OLDFILE,NEWFILE) but with extra checks
|
||||||
|
my ($oldfile,$newfile) = @_;
|
||||||
|
die "not a file: $oldfile" unless -f $oldfile;
|
||||||
|
if (-e $newfile) {
|
||||||
|
die "files don't match: $oldfile vs. $newfile"
|
||||||
|
unless do { open my $fh, '<:raw', $oldfile or die "$oldfile: $!"; local $/; <$fh> }
|
||||||
|
eq do { open my $fh, '<:raw', $newfile or die "$newfile: $!"; local $/; <$fh> };
|
||||||
|
file($newfile)->remove or die "failed to remove $newfile: $!";
|
||||||
|
}
|
||||||
|
link($oldfile,$newfile)
|
||||||
|
or die "link('$oldfile','$newfile'): $!";
|
||||||
|
}
|
||||||
|
|
||||||
|
# First argument: the filename of the .patch file
|
||||||
|
# Any following arguments are additionally passed to "patch" (e.g. "-p1")
|
||||||
|
# Attempts to run "patch", will fail gracefully if the patch has already been applied.
|
||||||
|
# Dies if anything goes wrong (patch not applied cleanly, etc.).
|
||||||
|
# Returns false (0) if the patch was already applied previously, true (1) if the patch was newly applied.
|
||||||
|
sub try_patch_file {
|
||||||
|
my ($patchf,@args) = @_;
|
||||||
|
say STDERR "# Attempting to apply patch $patchf...";
|
||||||
|
run 'patch', @args, '-r-', '-sNi', $patchf, {allow_exit=>[0,1],show_cmd=>$VERBOSE};
|
||||||
|
if ($?==1<<8) {
|
||||||
|
# Slightly hackish way to test if the patch did not apply cleanly, or it's just already been applied:
|
||||||
|
# Apply the patch in reverse once, and then apply it again, if both go through without errors all is ok.
|
||||||
|
# There is probably a better way to do this, I'm just feeling a little lazy at the moment.
|
||||||
|
run 'patch', @args, '-sRi', $patchf, {show_cmd=>$VERBOSE};
|
||||||
|
run 'patch', @args, '-si', $patchf, {show_cmd=>$VERBOSE};
|
||||||
|
say STDERR "# Verified that $patchf was previously applied";
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
elsif ($?) { die "patch $patchf \$?=$?" }
|
||||||
|
else { say STDERR "# Successfully applied patch $patchf"; return 1 }
|
||||||
|
}
|
||||||
|
|
||||||
|
# A simplified version of File::pushd that outputs debug info. TODO Later: should probably propose a patch for a debug option.
|
||||||
|
sub pushd {
|
||||||
|
if (not defined wantarray) { carp "pushd in void context"; return }
|
||||||
|
croak "bad arguments to pushd" unless @_==1 && defined $_[0];
|
||||||
|
my $targ = abs_path(shift);
|
||||||
|
croak "not a directory: $targ" unless -d $targ;
|
||||||
|
my $orig = getcwd;
|
||||||
|
if ($targ ne $orig) {
|
||||||
|
say STDERR "\$ cd $targ";
|
||||||
|
chdir $targ or croak "chdir to $targ failed: $!";
|
||||||
|
}
|
||||||
|
return bless { orig=>$orig }, 'PushedDir';
|
||||||
|
}
|
||||||
|
sub PushedDir::DESTROY {
|
||||||
|
my $self = shift;
|
||||||
|
if (getcwd ne $self->{orig}) {
|
||||||
|
say STDERR "\$ cd ".$self->{orig};
|
||||||
|
chdir $self->{orig} or croak "chdir to ".$self->{orig}." failed: $!";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
__END__
|
||||||
|
|
||||||
|
#TODO Later: Fix the following (note setting d_getgrgid_r and d_getgrnam_r in the hints file didn't seem to help)
|
||||||
|
warning: unresolved symbol: getgrgid
|
||||||
|
warning: unresolved symbol: getgrnam
|
||||||
|
warning: unresolved symbol: llvm_fma_f64
|
||||||
|
warning: unresolved symbol: sigsuspend
|
||||||
|
|
||||||
|
#TODO Later: Fix the following "miniperl make_ext.pl" errors (warnings?)
|
||||||
|
./miniperl -Ilib make_ext.pl lib/auto/Encode/Byte/Byte.a MAKE="make" LIBPERL_A=libperl.a LINKTYPE=static CCCDLFLAGS=
|
||||||
|
Can't find extension Encode/Byte in any of cpan dist ext at make_ext.pl line 251.
|
||||||
|
./miniperl -Ilib make_ext.pl lib/auto/Encode/Symbol/Symbol.a MAKE="make" LIBPERL_A=libperl.a LINKTYPE=static CCCDLFLAGS=
|
||||||
|
Can't find extension Encode/Symbol in any of cpan dist ext at make_ext.pl line 251.
|
||||||
|
./miniperl -Ilib make_ext.pl lib/auto/Encode/Unicode/Unicode.a MAKE="make" LIBPERL_A=libperl.a LINKTYPE=static CCCDLFLAGS=
|
||||||
|
Can't find extension Encode/Unicode in any of cpan dist ext at make_ext.pl line 251.
|
||||||
|
|
||||||
@ -0,0 +1,46 @@
|
|||||||
|
#!/bin/bash
|
||||||
|
|
||||||
|
# This is the configuration file for building WebPerl.
|
||||||
|
# You should edit it according to the comments below.
|
||||||
|
# Remember to reload this file after making changes! (". emperl_config.sh")
|
||||||
|
|
||||||
|
# You must edit this to point to your Emscripten SDK's emsdk_env.sh.
|
||||||
|
. $HOME/emsdk/emsdk_env.sh
|
||||||
|
|
||||||
|
# A whitespace-separated list of modules to download and add to the build.
|
||||||
|
# Note: Cpanel::JSON::XS is required for WebPerl!
|
||||||
|
export EMPERL_EXTENSIONS="Cpanel::JSON::XS Devel::StackTrace"
|
||||||
|
|
||||||
|
# Modules from the above list that have XS code need to be linked statically.
|
||||||
|
# Add them here, separated by whitespace (see also the "static_ext" variable
|
||||||
|
# in https://perl5.git.perl.org/perl.git/blob/HEAD:/Porting/Glossary ).
|
||||||
|
export EMPERL_STATIC_EXT="Cpanel/JSON/XS"
|
||||||
|
|
||||||
|
# Do not edit (this gets this script's parent directory)
|
||||||
|
BASEDIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )"/.. >/dev/null && pwd )"
|
||||||
|
|
||||||
|
# Various working directories, you normally don't need to edit these
|
||||||
|
export EMPERL_PERLSRCDIR="$BASEDIR/emperl5"
|
||||||
|
export EMPERL_HOSTPERLDIR="$BASEDIR/work/hostperl"
|
||||||
|
export EMPERL_DOWNLOADDIR="$BASEDIR/work/download"
|
||||||
|
export EMPERL_OUTPUTDIR="$BASEDIR/work/outputperl"
|
||||||
|
|
||||||
|
# Don't edit the following options unless you know what you're doing!
|
||||||
|
# Note to self: In build.pl, we take advantage of the fact that on Perls >=v5.10.0, "$^V" is the same as the tag name.
|
||||||
|
export EMPERL_PERLVER="v5.28.0"
|
||||||
|
export EMPERL_PREFIX="/opt/perl"
|
||||||
|
export EMPERL_PRELOAD_FILE="$EMPERL_OUTPUTDIR$EMPERL_PREFIX@$EMPERL_PREFIX"
|
||||||
|
export EMPERL_OPTIMIZ="-O2"
|
||||||
|
export EMPERL_LINK_FLAGS="--pre-js common_preamble.js -s EXPORTED_FUNCTIONS=['_main','_emperl_end_perl','_Perl_call_sv','_Perl_call_pv','_Perl_call_method','_Perl_call_argv','_Perl_eval_pv','_Perl_eval_sv','_webperl_eval_perl'] -s EXTRA_EXPORTED_RUNTIME_METHODS=['ccall','cwrap']"
|
||||||
|
# Note: not including "-s SAFE_HEAP=1" in the debug flags because we're building to WebAssembly, which doesn't require alignment
|
||||||
|
#TODO Later: Can some of the SAFE_HEAP functionality (null pointer access I think?) be replaced by the WASM error traps?
|
||||||
|
# http://kripken.github.io/emscripten-site/docs/compiling/WebAssembly.html#binaryen-codegen-options
|
||||||
|
export EMPERL_DEBUG_FLAGS="-s ASSERTIONS=2 -s STACK_OVERFLOW_CHECK=2"
|
||||||
|
|
||||||
|
# Location and branch of the perl git repository that contains the emperl branch
|
||||||
|
export EMPERL_PERL_REPO="https://github.com/haukex/emperl5.git"
|
||||||
|
export EMPERL_PERL_BRANCH="emperl_$EMPERL_PERLVER"
|
||||||
|
# Enabling this setting causes the local emperl branch to be deleted and re-fetched from the origin.
|
||||||
|
# This is useful during development, when rewrites of the (unpublished!) git history of the branch might happen.
|
||||||
|
export EMPERL_CLOBBER_BRANCH=0
|
||||||
|
|
||||||
@ -0,0 +1,20 @@
|
|||||||
|
--- emscripten/src/library.js 2018-08-01 18:58:49.428051969 +0200
|
||||||
|
+++ emsdk/emscripten/1.38.10/src/library.js 2018-08-01 18:58:03.288051969 +0200
|
||||||
|
@@ -250,7 +250,7 @@
|
||||||
|
// pid_t fork(void);
|
||||||
|
// http://pubs.opengroup.org/onlinepubs/000095399/functions/fork.html
|
||||||
|
// We don't support multiple processes.
|
||||||
|
- ___setErrNo(ERRNO_CODES.EAGAIN);
|
||||||
|
+ ___setErrNo(ERRNO_CODES.ENOTSUP);
|
||||||
|
return -1;
|
||||||
|
},
|
||||||
|
vfork: 'fork',
|
||||||
|
@@ -545,7 +545,7 @@
|
||||||
|
// int system(const char *command);
|
||||||
|
// http://pubs.opengroup.org/onlinepubs/000095399/functions/system.html
|
||||||
|
// Can't call external programs.
|
||||||
|
- ___setErrNo(ERRNO_CODES.EAGAIN);
|
||||||
|
+ ___setErrNo(ERRNO_CODES.ENOTSUP);
|
||||||
|
return -1;
|
||||||
|
},
|
||||||
|
|
||||||
@ -0,0 +1,24 @@
|
|||||||
|
#!/bin/bash
|
||||||
|
set -e
|
||||||
|
# Finds and displays TODOs for the WebPerl project.
|
||||||
|
# the output can be piped into e.g. "less -R"
|
||||||
|
if [ -z ${EMPERL_PERLVER+x} ]; then
|
||||||
|
echo "Please source emperl_config.sh first"
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )"/.. >/dev/null && pwd )"
|
||||||
|
TEMPFILE="`mktemp`"
|
||||||
|
trap 'rm -f "$TEMPFILE"' EXIT
|
||||||
|
(
|
||||||
|
cd "$DIR/emperl5"
|
||||||
|
# only look at files that have been added
|
||||||
|
git diff --numstat --diff-filter=A $EMPERL_PERLVER $EMPERL_PERL_BRANCH \
|
||||||
|
| BASEDIR=$DIR perl -wMstrict -MFile::Spec::Functions=abs2rel,rel2abs -nl0 \
|
||||||
|
-e '/^\d+\s+\d+\s+(.+)$/ or die $_; -e $1 and print abs2rel(rel2abs($1),$ENV{BASEDIR})'
|
||||||
|
) >>"$TEMPFILE"
|
||||||
|
cd $DIR
|
||||||
|
find . -mindepth 1 \( -path ./.git -o -path ./work -o -path ./emperl5 \) -prune \
|
||||||
|
-o ! -name 'emperl.*' ! -type d -print0 \
|
||||||
|
| perl -wMstrict -MFile::Spec::Functions=canonpath -n0le 'print canonpath($_)' >>"$TEMPFILE"
|
||||||
|
xargs -0 -a "$TEMPFILE" \
|
||||||
|
grep --color=always -C1 -niE '\bto.?do\b'
|
||||||
@ -0,0 +1,36 @@
|
|||||||
|
|
||||||
|
/** CSS file for emscr_ide.js **/
|
||||||
|
|
||||||
|
.emide {
|
||||||
|
font-family: Calibri, Ubuntu, "Droid Sans", Tahoma, Arial, Helvetica, sans-serif;
|
||||||
|
}
|
||||||
|
.CodeMirror,.code {
|
||||||
|
font-family: Consolas, "Ubuntu Mono", "Droid Sans Mono", "Lucida Console", "Courier New", Courier, monospace;
|
||||||
|
}
|
||||||
|
|
||||||
|
.toolbar button {
|
||||||
|
margin: 0 0.2em;
|
||||||
|
}
|
||||||
|
|
||||||
|
.statusbar {
|
||||||
|
padding: 0.2em;
|
||||||
|
height: 1em;
|
||||||
|
font-size: 10pt;
|
||||||
|
}
|
||||||
|
|
||||||
|
.filebrowser {
|
||||||
|
border: 1px solid black;
|
||||||
|
padding: 0.2em 0.5em;
|
||||||
|
overflow: auto;
|
||||||
|
height: 20em;
|
||||||
|
}
|
||||||
|
.fb-link { cursor:pointer; }
|
||||||
|
.fb-link:hover { color:#000090; background:rgba(255,255,102,0.4); }
|
||||||
|
.fb-link:active { color:#FF0000; }
|
||||||
|
|
||||||
|
.cm-resize-frame {
|
||||||
|
overflow: hidden;
|
||||||
|
resize: vertical;
|
||||||
|
height: 24em;
|
||||||
|
border: 1px solid grey;
|
||||||
|
}
|
||||||
@ -0,0 +1,259 @@
|
|||||||
|
"use strict";
|
||||||
|
|
||||||
|
/** ***** 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
|
||||||
|
**/
|
||||||
|
|
||||||
|
function make_emscr_ide (textarea, callbacks) {
|
||||||
|
|
||||||
|
var defaulttext = "use warnings;\nuse 5.028;\nuse WebPerl qw/js/;\n\n";
|
||||||
|
var div = $('<div/>').addClass("emide");
|
||||||
|
var ide = { elem: div, cleanval: '' };
|
||||||
|
|
||||||
|
var tb = $('<div/>').addClass("toolbar").appendTo(div);
|
||||||
|
var file_new = $('<button/>',{title:"New File",html:"📄"}).appendTo(tb);
|
||||||
|
var file_upload = $('<button/>',{title:"File from Disk",html:"⬆"}).appendTo(tb);
|
||||||
|
var file_download = $('<button/>',{title:"Download editor contents",html:"⬇"}).appendTo(tb);
|
||||||
|
var file_open = $('<button/>',{title:"Open File",html:"📁"}).appendTo(tb);
|
||||||
|
var file_save = $('<button/>',{title:"Save File",html:"💾"}).appendTo(tb);
|
||||||
|
var file_name = $('<input/>',{title:"File Name",type:"text",size:60}).addClass("code").appendTo(tb);
|
||||||
|
//TODO Later: support for deleting files?
|
||||||
|
|
||||||
|
var upload_file = $('<input/>',{type:"file"});
|
||||||
|
var file_up_form = $('<div/>').append(
|
||||||
|
$('<form/>').append( upload_file ) ).appendTo(div);
|
||||||
|
file_up_form.hide();
|
||||||
|
|
||||||
|
var fbrowser = make_emscr_ide_filebrowser();
|
||||||
|
fbrowser.elem.hide();
|
||||||
|
fbrowser.elem.appendTo(div);
|
||||||
|
|
||||||
|
var resize_frame = $('<div/>').addClass("cm-resize-frame").appendTo(div);
|
||||||
|
textarea.replaceWith(div);
|
||||||
|
resize_frame.append(textarea);
|
||||||
|
|
||||||
|
var statusbar = $('<div/>').addClass("statusbar").appendTo(div);
|
||||||
|
|
||||||
|
var cm = CodeMirror.fromTextArea( textarea[0], {
|
||||||
|
lineNumbers: true, indentWithTabs: true,
|
||||||
|
tabSize: 4, indentUnit: 4 });
|
||||||
|
ide.cm = cm;
|
||||||
|
/* With thanks to https://codepen.io/sakifargo/pen/KodNyR */
|
||||||
|
var fr = resize_frame[0];
|
||||||
|
var cm_resize = function() { cm.setSize(fr.clientWidth + 2, fr.clientHeight - 10); };
|
||||||
|
cm_resize();
|
||||||
|
if (window.ResizeObserver)
|
||||||
|
new ResizeObserver(cm_resize).observe(fr);
|
||||||
|
else if (window.MutationObserver)
|
||||||
|
new MutationObserver(cm_resize).observe(fr, {attributes: true});
|
||||||
|
|
||||||
|
ide.isDirty = function () { return cm.getValue()!=ide.cleanval; };
|
||||||
|
// returns true if the user chose to abort
|
||||||
|
// returns false if the buffer is not dirty or the user chose to continue anyway
|
||||||
|
ide.dirtyCheck = function () {
|
||||||
|
if (ide.isDirty()) {
|
||||||
|
// confirm() returns true if the user clicked "OK", and false otherwise.
|
||||||
|
if (confirm("Unsaved changes in editor!\nContinue anyway?"))
|
||||||
|
return false;
|
||||||
|
else return true; // buffer is dirty and user chose to abort
|
||||||
|
}
|
||||||
|
else return false;
|
||||||
|
};
|
||||||
|
|
||||||
|
file_new.click(function () {
|
||||||
|
if (ide.dirtyCheck()) return;
|
||||||
|
console.debug("IDE: New File");
|
||||||
|
file_name.val("");
|
||||||
|
ide.cleanval = defaulttext;
|
||||||
|
cm.setValue(defaulttext);
|
||||||
|
sessionStorage.removeItem('file_mru');
|
||||||
|
statusbar.text("New File");
|
||||||
|
});
|
||||||
|
|
||||||
|
file_upload.click(function () {
|
||||||
|
if(!window.FileReader) {
|
||||||
|
alert("Sorry, your browser does not support file uploads.");
|
||||||
|
return; }
|
||||||
|
if (file_up_form.is(":visible")) file_up_form.hide(); else file_up_form.show();
|
||||||
|
});
|
||||||
|
upload_file.on('change', function (chgEvt) {
|
||||||
|
statusbar.text("");
|
||||||
|
file_up_form.hide();
|
||||||
|
if (ide.dirtyCheck()) return;
|
||||||
|
file_name.val("");
|
||||||
|
sessionStorage.removeItem('file_mru');
|
||||||
|
console.debug("IDE: Reading file from local disk...");
|
||||||
|
var reader = new FileReader();
|
||||||
|
reader.onload = function(loadEvt) {
|
||||||
|
if(loadEvt.target.readyState != 2) return;
|
||||||
|
if(loadEvt.target.error) {
|
||||||
|
alert('Error while reading file');
|
||||||
|
return; }
|
||||||
|
console.debug("IDE: File read!");
|
||||||
|
statusbar.text("File opened from local disk");
|
||||||
|
cm.setValue(loadEvt.target.result);
|
||||||
|
};
|
||||||
|
reader.readAsText(chgEvt.target.files[0]);
|
||||||
|
});
|
||||||
|
|
||||||
|
file_download.click(function () {
|
||||||
|
var blob = new Blob([cm.getValue()],
|
||||||
|
{type: "text/plain;charset=utf-8"});
|
||||||
|
var link = document.createElement("a");
|
||||||
|
link.download = 'script.pl';
|
||||||
|
link.href = URL.createObjectURL(blob);
|
||||||
|
link.target = '_blank';
|
||||||
|
document.body.appendChild(link);
|
||||||
|
link.click();
|
||||||
|
document.body.removeChild(link);
|
||||||
|
});
|
||||||
|
|
||||||
|
file_open.click(function () {
|
||||||
|
statusbar.text("");
|
||||||
|
if (!fbrowser) return;
|
||||||
|
if (fbrowser.isVisible()) {
|
||||||
|
file_open.html("📁");
|
||||||
|
fbrowser.cancel();
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
file_open.html("📂⃠");
|
||||||
|
fbrowser.show(function (file) {
|
||||||
|
file_open.html("📁");
|
||||||
|
if (ide.dirtyCheck()) return;
|
||||||
|
console.debug("IDE: Opening "+file);
|
||||||
|
file_name.val(file);
|
||||||
|
var data = FS.readFile(file,{encoding:"utf8"});
|
||||||
|
ide.cleanval = data;
|
||||||
|
cm.setValue(data);
|
||||||
|
sessionStorage.setItem('file_mru',file);
|
||||||
|
statusbar.text("Opened "+file);
|
||||||
|
console.debug("IDE: Opened "+file);
|
||||||
|
if (callbacks && callbacks.open) callbacks.open(file);
|
||||||
|
});
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
file_save.click(function () {
|
||||||
|
statusbar.text("");
|
||||||
|
var file = file_name.val();
|
||||||
|
if (file.length<1) {
|
||||||
|
alert("Invalid File Name");
|
||||||
|
return; }
|
||||||
|
try {
|
||||||
|
console.debug("IDE: Trying to save "+file);
|
||||||
|
var data = cm.getValue();
|
||||||
|
FS.writeFile( file, data );
|
||||||
|
/* Note: The user may be saving to some location outside of the IDBFS, in which
|
||||||
|
* case this syncfs call isn't really needed. But it doesn't really hurt either,
|
||||||
|
* so we always do it. */
|
||||||
|
FS.syncfs(false, function (err) {
|
||||||
|
if(err) { console.error(err); alert("Saving IDBFS failed: "+err); return; }
|
||||||
|
statusbar.text("Saved to "+file);
|
||||||
|
console.debug("IDE: Saved "+file);
|
||||||
|
sessionStorage.setItem('file_mru',file);
|
||||||
|
ide.cleanval = data;
|
||||||
|
if (callbacks && callbacks.save) callbacks.save(file);
|
||||||
|
});
|
||||||
|
}
|
||||||
|
catch (err) { console.error(err); alert("Save Failed: "+err); }
|
||||||
|
});
|
||||||
|
|
||||||
|
var mru_file = sessionStorage.getItem('file_mru');
|
||||||
|
try {
|
||||||
|
if (!mru_file) throw "No MRU file";
|
||||||
|
var data = FS.readFile( mru_file, {encoding:"utf8"} );
|
||||||
|
ide.cleanval = data;
|
||||||
|
cm.setValue(data);
|
||||||
|
file_name.val(mru_file);
|
||||||
|
console.debug("IDE: Loaded "+mru_file);
|
||||||
|
statusbar.text("Opened "+mru_file);
|
||||||
|
if (callbacks && callbacks.open) callbacks.open(mru_file);
|
||||||
|
}
|
||||||
|
catch (e) {
|
||||||
|
console.debug("IDE: Loading MRU failed:",e,"- falling back...");
|
||||||
|
file_name.val('');
|
||||||
|
ide.cleanval = defaulttext;
|
||||||
|
cm.setValue(defaulttext);
|
||||||
|
}
|
||||||
|
|
||||||
|
window.addEventListener("beforeunload", function (evt) {
|
||||||
|
if (ide.isDirty()) {
|
||||||
|
var dialogText = "Unsaved changes in editor!";
|
||||||
|
evt.returnValue = dialogText;
|
||||||
|
return dialogText;
|
||||||
|
}
|
||||||
|
});
|
||||||
|
|
||||||
|
return ide;
|
||||||
|
}
|
||||||
|
|
||||||
|
function make_emscr_ide_filebrowser() {
|
||||||
|
var fb = {
|
||||||
|
elem: $('<div/>').addClass("filebrowser"),
|
||||||
|
curpath: (ENV && ENV.HOME) ? ENV.HOME : FS.cwd(),
|
||||||
|
};
|
||||||
|
fb.update = function () {
|
||||||
|
fb.elem.empty();
|
||||||
|
$('<div>📂 </div>').addClass("fb-curdir")
|
||||||
|
.append(fb.curpath).appendTo(fb.elem);
|
||||||
|
var files = FS.readdir(fb.curpath);
|
||||||
|
$.each( files.sort(), function (idx,file) {
|
||||||
|
if (file=='.') return;
|
||||||
|
if (file=='..' && fb.curpath=='/') return;
|
||||||
|
var fullfile = FS.joinPath([fb.curpath,file]);
|
||||||
|
var stat = FS.stat(fullfile);
|
||||||
|
var icon = "📜";
|
||||||
|
var click;
|
||||||
|
if (FS.isFile(stat.mode)) {
|
||||||
|
icon = "📄";
|
||||||
|
click = function (evt) {
|
||||||
|
fb.elem.hide();
|
||||||
|
if(fb.callback) fb.callback(fullfile);
|
||||||
|
fb.callback = null;
|
||||||
|
};
|
||||||
|
}
|
||||||
|
else if (FS.isDir(stat.mode)) {
|
||||||
|
icon = file=='..'?"📁⃖":"📁";
|
||||||
|
click = function (evt) {
|
||||||
|
fb.curpath = fullfile;
|
||||||
|
fb.update();
|
||||||
|
};
|
||||||
|
}
|
||||||
|
else if (FS.isLink(stat.mode)) {
|
||||||
|
icon = "📄⃪";
|
||||||
|
}
|
||||||
|
var el = $('<div>'+icon+' </div>').addClass("fb-link")
|
||||||
|
.append(file).appendTo(fb.elem);
|
||||||
|
if (click) el.click(click);
|
||||||
|
});
|
||||||
|
};
|
||||||
|
fb.show = function (callback) {
|
||||||
|
fb.callback = callback;
|
||||||
|
fb.elem.show();
|
||||||
|
fb.curpath = FS.cwd();
|
||||||
|
fb.update();
|
||||||
|
};
|
||||||
|
fb.cancel = function () {
|
||||||
|
fb.elem.hide();
|
||||||
|
fb.callback = null;
|
||||||
|
}
|
||||||
|
fb.isVisible = function () { return fb.elem.is(":visible") }
|
||||||
|
return fb;
|
||||||
|
}
|
||||||
@ -0,0 +1,244 @@
|
|||||||
|
<!doctype html>
|
||||||
|
<html lang="en-us">
|
||||||
|
<head>
|
||||||
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
|
||||||
|
<title>WebPerl (IDE)</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
|
||||||
|
-->
|
||||||
|
|
||||||
|
<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" type="text/css" href="emscr_ide.css" />
|
||||||
|
<style>
|
||||||
|
button,.text {
|
||||||
|
font-family: Calibri, Ubuntu, "Droid Sans", Tahoma, Arial, Helvetica, sans-serif;
|
||||||
|
}
|
||||||
|
pre,.code,textarea {
|
||||||
|
font-family: Consolas, "Ubuntu Mono", "Droid Sans Mono", "Lucida Console", "Courier New", Courier, monospace;
|
||||||
|
}
|
||||||
|
.fakelink {
|
||||||
|
color: darkblue;
|
||||||
|
cursor: pointer;
|
||||||
|
}
|
||||||
|
.border {
|
||||||
|
border: 1px solid black;
|
||||||
|
margin: 0.5em;
|
||||||
|
padding: 0.2em;
|
||||||
|
}
|
||||||
|
#evalcode_container .CodeMirror {
|
||||||
|
height: 4em;
|
||||||
|
border: 1px solid grey;
|
||||||
|
margin: 0.2em 0;
|
||||||
|
}
|
||||||
|
.output {
|
||||||
|
margin-top: 0.5em;
|
||||||
|
}
|
||||||
|
.output textarea {
|
||||||
|
max-width: 100%;
|
||||||
|
}
|
||||||
|
</style>
|
||||||
|
|
||||||
|
<script src="https://cdnjs.cloudflare.com/ajax/libs/codemirror/5.39.2/codemirror.min.js" integrity="sha256-uRIJ6Wfou5cTtmcCvQNA9lvsYl8sUbZXxnfG+P79ssY=" crossorigin="anonymous"></script>
|
||||||
|
<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>
|
||||||
|
<script src="https://code.jquery.com/jquery-3.3.1.min.js" integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=" crossorigin="anonymous"></script>
|
||||||
|
<script src="emscr_ide.js"></script>
|
||||||
|
<script src="../webperl.js"></script>
|
||||||
|
<script>
|
||||||
|
"use strict";
|
||||||
|
console.debug("Running our Javascript...");
|
||||||
|
|
||||||
|
window.onerror = function(event) {
|
||||||
|
alert('Exception thrown, see JavaScript console'); };
|
||||||
|
|
||||||
|
// This is a workaround for Emscripten only being able to call main() once per page load.
|
||||||
|
// I wouldn't recommend this for "production" use.
|
||||||
|
var baseurl = new URL(window.location);
|
||||||
|
baseurl = baseurl.origin + baseurl.pathname.substring(0,baseurl.pathname.lastIndexOf('/'));
|
||||||
|
function run_perl_iframe (argv, state_callback, done_callback) {
|
||||||
|
var html = '<html><head><base href="'+baseurl+'"><script src="webperl.js"></scr'+'ipt></head><body></body></html>';
|
||||||
|
var blob = new Blob([html], {type: "text/html;charset=utf-8"});
|
||||||
|
var src = URL.createObjectURL(blob);
|
||||||
|
var iframe = $('<iframe/>',{id:'Perl_IFrame',src:src}).hide().appendTo('body');
|
||||||
|
iframe.on('load', function() {
|
||||||
|
var IFramePerl = iframe[0].contentWindow['Perl'];
|
||||||
|
var outbuf = '';
|
||||||
|
IFramePerl.output = function (str) { outbuf+=str }; //TODO Later: maybe dynamic output updating is possible?
|
||||||
|
IFramePerl.endAfterMain = true;
|
||||||
|
IFramePerl.stateChanged = function (from,to) {
|
||||||
|
if (state_callback) state_callback(to);
|
||||||
|
if (from!='Ended' && to=='Ended') {
|
||||||
|
iframe.remove();
|
||||||
|
if (done_callback) done_callback(outbuf);
|
||||||
|
}
|
||||||
|
};
|
||||||
|
IFramePerl.init(function () {
|
||||||
|
window.setTimeout(function () { IFramePerl.start(argv); }, 1);
|
||||||
|
});
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
var eval_cm;
|
||||||
|
$( function() {
|
||||||
|
console.debug("Document is ready, setting up...");
|
||||||
|
$('#runperl').prop("disabled",true);
|
||||||
|
$('#evalperl').prop("disabled",true);
|
||||||
|
$('#endperl').prop("disabled",true);
|
||||||
|
|
||||||
|
var once_out_ta = Perl.makeOutputTextarea();
|
||||||
|
$("#once_output").append(once_out_ta);
|
||||||
|
$("#once_out_clear").click(function () { $(once_out_ta).val("") });
|
||||||
|
|
||||||
|
{
|
||||||
|
var multirun = $('#multi_run');
|
||||||
|
var multirun_toggle = $('<div/>',{text:"Hide Run Multi (via IFrame)"});
|
||||||
|
multirun_toggle.addClass('fakelink');
|
||||||
|
multirun_toggle.click(function () {
|
||||||
|
if (multirun.is(":visible")) {
|
||||||
|
multirun.hide();
|
||||||
|
multirun_toggle.text("Show Run Multi (via IFrame)");
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
multirun.show();
|
||||||
|
multirun_toggle.text("Hide Run Multi (via IFrame)");
|
||||||
|
}
|
||||||
|
});
|
||||||
|
multirun.before( multirun_toggle );
|
||||||
|
}
|
||||||
|
|
||||||
|
// need to set up CodeMirror while #runonce is still visible (!)
|
||||||
|
eval_cm = CodeMirror.fromTextArea( $('#evalcode')[0], {
|
||||||
|
lineNumbers: true, indentWithTabs: true,
|
||||||
|
tabSize: 4, indentUnit: 4 });
|
||||||
|
{
|
||||||
|
var runonce = $('#runonce');
|
||||||
|
var runonce_toggle = $('<div/>',{text:"Show Run & Persist"});
|
||||||
|
runonce_toggle.addClass('fakelink');
|
||||||
|
runonce_toggle.click(function () {
|
||||||
|
if (runonce.is(":visible")) {
|
||||||
|
runonce.hide();
|
||||||
|
runonce_toggle.text("Show Run & Persist");
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
runonce.show();
|
||||||
|
runonce_toggle.text("Hide Run & Persist");
|
||||||
|
}
|
||||||
|
});
|
||||||
|
runonce.before( runonce_toggle );
|
||||||
|
runonce.hide();
|
||||||
|
}
|
||||||
|
Perl.stateChanged = function (from,to) {
|
||||||
|
console.debug("Perl: state changed from "+from+" to "+to);
|
||||||
|
$('#runstate').text("State: "+to);
|
||||||
|
$('#runperl' ).prop("disabled", to!="Ready");
|
||||||
|
$('#argv' ).prop("disabled", to!="Ready");
|
||||||
|
$('#evalperl').prop("disabled", to!="Running");
|
||||||
|
$('#endperl' ).prop("disabled", to!="Running");
|
||||||
|
};
|
||||||
|
Perl.init(final_init);
|
||||||
|
});
|
||||||
|
|
||||||
|
function final_init () { // Called when Perl goes to Ready state
|
||||||
|
console.debug("Final initialization steps...");
|
||||||
|
|
||||||
|
// set up the IDE now that the Emscripten FS object is all ready to go
|
||||||
|
var ide = make_emscr_ide( $('textarea#ide'), {
|
||||||
|
open: function(file) { $('#argv,#multi_argv').val( JSON.stringify([file]) ) },
|
||||||
|
save: function(file) { $('#argv,#multi_argv').val( JSON.stringify([file]) ) },
|
||||||
|
} );
|
||||||
|
|
||||||
|
$('#multi_runperl').click(function () {
|
||||||
|
if (ide.dirtyCheck()) return;
|
||||||
|
$('#multi_runperl').prop("disabled",true); // we *could* run multiple Perls in parallel, I just don't recommend it (memory & performance issues)
|
||||||
|
var argv = JSON.parse( $('#multi_argv').val() );
|
||||||
|
$('#multi_out_ta').text("");
|
||||||
|
run_perl_iframe(argv,
|
||||||
|
//TODO Later: the user never gets to see the "Running" state
|
||||||
|
function (newstate) { $('#multi_state').text("State: "+newstate) },
|
||||||
|
function (output) {
|
||||||
|
var ta = $('#multi_out_ta');
|
||||||
|
ta.text(output);
|
||||||
|
ta[0].scrollTop = ta[0].scrollHeight;
|
||||||
|
$('#multi_runperl').prop("disabled",false);
|
||||||
|
});
|
||||||
|
});
|
||||||
|
$('#runperl').click(function () {
|
||||||
|
if (ide.dirtyCheck()) return;
|
||||||
|
var argv = JSON.parse( $('#argv').val() );
|
||||||
|
// run Perl async so that the window has a chance to refresh
|
||||||
|
window.setTimeout(function () { Perl.start(argv); }, 1);
|
||||||
|
});
|
||||||
|
$('#evalperl').click(function () {
|
||||||
|
var rv = Perl.eval( eval_cm.getValue() );
|
||||||
|
console.debug('eval returned',rv);
|
||||||
|
});
|
||||||
|
$('#endperl').click(function () {
|
||||||
|
if (confirm("Are you sure you want to end Perl?\nYou'll have to reload the page to restart Perl."))
|
||||||
|
Perl.end();
|
||||||
|
});
|
||||||
|
}
|
||||||
|
</script>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<div class="border text" style="text-align:center"><small>Really Simple Mini IDE as a Demo for <a href="http://webperl.zero-g.net" target="_blank">WebPerl</a></small></div>
|
||||||
|
|
||||||
|
<div class="border">
|
||||||
|
<textarea id="ide" rows="24" cols="80"></textarea>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div class="text border">
|
||||||
|
<div id="runonce">
|
||||||
|
<div>
|
||||||
|
<span class="code">ARGV:</span> <small>(JSON)</small>
|
||||||
|
<input type="text" id="argv" class="code" value='["--version"]' size="60" title="argv for perl (JSON)"/>
|
||||||
|
<button id="runperl" title="Run perl"><span class="code">perl</span> ►</button>
|
||||||
|
<button id="endperl" title="End perl">end ■</button>
|
||||||
|
</div>
|
||||||
|
<div class="statusbar" id="runstate">State: None</div>
|
||||||
|
<div>
|
||||||
|
<div id="evalcode_container"><textarea id="evalcode" rows="3" cols="80"></textarea></div>
|
||||||
|
<div><button id="evalperl" title="eval Perl code"><span class="code">eval</span> ►</button></div>
|
||||||
|
</div>
|
||||||
|
<div class="output" id="once_output">
|
||||||
|
<span class="code">STDOUT and STDERR:</span> <button id="once_out_clear">Clear</button><br/>
|
||||||
|
<!-- output textarea will be inserted here -->
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div class="text border">
|
||||||
|
<div id="multi_run">
|
||||||
|
<div>
|
||||||
|
<span class="code">ARGV:</span> <small>(JSON)</small>
|
||||||
|
<input type="text" id="multi_argv" class="code" value='["--version"]' size="60" title="argv for perl (JSON)"/>
|
||||||
|
<button id="multi_runperl" title="Run perl"><span class="code">perl</span> ►■</button><br/>
|
||||||
|
<small><i>(Remember to store code in a persistent storage like <span class="code">/mnt/idb</span>!)</i></small>
|
||||||
|
</div>
|
||||||
|
<div class="statusbar" id="multi_state">State: None</div>
|
||||||
|
<div class="output">
|
||||||
|
<span class="code">STDOUT and STDERR:</span><br/>
|
||||||
|
<textarea id="multi_out_ta" rows="24" cols="80" readonly></textarea>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
@ -0,0 +1,350 @@
|
|||||||
|
"use strict";
|
||||||
|
|
||||||
|
/** ***** 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
|
||||||
|
**/
|
||||||
|
|
||||||
|
/** Public Interface:
|
||||||
|
* Perl.output - override this for output somewhere else
|
||||||
|
* Perl.stateChanged - callback for state changes
|
||||||
|
* Perl.trace - enables debug/trace messages
|
||||||
|
* Perl.endAfterMain - see exit(0) discussion below
|
||||||
|
* Perl.init - initializes the Perl interpreter. Pass this function a callback to be called when init is done
|
||||||
|
* Perl.start - starts up the Perl interpreter
|
||||||
|
* Perl.eval - evaluates the given Perl string
|
||||||
|
* Perl.end - Ends the Perl interpreter
|
||||||
|
* Perl.makeOutputTextarea - creates a <textarea> and redirects output there (see HTML examples)
|
||||||
|
*/
|
||||||
|
|
||||||
|
/** On our patched perlmain.c and exit(0):
|
||||||
|
* Since we want the Perl process to persist while the webpage is open, we've patched perlmain.c so that:
|
||||||
|
* 1. Global destruction and END blocks aren't triggered until explicitly requested by calling emperl_end_perl()
|
||||||
|
* 2. emperl_end_perl() won't actually call exit() when the exit status is zero (because Emscripten complains when you call exit() and NO_EXIT_RUNTIME is set)
|
||||||
|
* This has some consequences:
|
||||||
|
* 1. An exit(0) in the main program won't have any effect other than stopping the execution of the main program at that point, the interpreter is kept running (?)
|
||||||
|
* 2. ... TODO Later: Any other consequences?
|
||||||
|
* As a result:
|
||||||
|
* - Just don't call exit(0);/exit; from Perl.
|
||||||
|
* Note that if you want to "end" the currently running Perl, so that global destruction is performed and END blocks are executed, there are several ways to do so:
|
||||||
|
* - From JS, set Perl.endAfterMain before initializing Perl (this enables a "hack" that calls emperl_end_perl() after main() finishes)
|
||||||
|
* - From JS, call Perl.end()
|
||||||
|
* - From Perl, WebPerl::end_perl() (TODO Later: This doesn't cause Module.onExit to be called, right?)
|
||||||
|
*/
|
||||||
|
|
||||||
|
var Module;
|
||||||
|
var Perl = {
|
||||||
|
trace: false, // user may enable this
|
||||||
|
endAfterMain: false, // user may enable this (before Perl.init)
|
||||||
|
// internal variables:
|
||||||
|
initStepsLeft: 2, // Must match number of Perl.initStepFinished() calls!
|
||||||
|
state: "Uninitialized",
|
||||||
|
readyCallback: null,
|
||||||
|
stdout_buf: "", stderr_buf: "", // for our default Perl.output implementation
|
||||||
|
};
|
||||||
|
|
||||||
|
/* TODO: Embedded script should be able to influence the running of Perl,
|
||||||
|
* the cleanest would probably be to set properties on the Perl object,
|
||||||
|
* such as Perl.autorun = false or Perl.argv = [...]. */
|
||||||
|
|
||||||
|
window.addEventListener("load", function () {
|
||||||
|
// Note: to get the content of script tags with jQuery: $('script[type="text/perl"]').html()
|
||||||
|
var scripts = [];
|
||||||
|
var script_src;
|
||||||
|
document.querySelectorAll("script[type='text/perl']")
|
||||||
|
.forEach(function (el) {
|
||||||
|
if (el.src) {
|
||||||
|
if (script_src || scripts.length)
|
||||||
|
console.error('Only a single Perl script may be loaded via "script src=", ignoring others');
|
||||||
|
else
|
||||||
|
script_src = el.src;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
if (script_src)
|
||||||
|
console.error('Only a single Perl script may be loaded via "script src=", ignoring others');
|
||||||
|
else
|
||||||
|
scripts.push(el.innerHTML);
|
||||||
|
}
|
||||||
|
});
|
||||||
|
if (script_src) {
|
||||||
|
console.debug("Perl: Found a script with src, fetching and running...", script_src);
|
||||||
|
var xhr = new XMLHttpRequest();
|
||||||
|
xhr.addEventListener("load", function () {
|
||||||
|
//TODO Later: Might be nice to name the script in the virtual FS after the URL instead of a generic name
|
||||||
|
Perl._saveAndRun( this.responseText );
|
||||||
|
});
|
||||||
|
xhr.open("GET", script_src);
|
||||||
|
xhr.send();
|
||||||
|
}
|
||||||
|
else if (scripts.length) {
|
||||||
|
console.debug("Perl: Found",scripts.length,"embedded script(s), autorunning...");
|
||||||
|
//TODO: should we maybe prefix "use warnings; use 5.028;"? or at least "use WebPerl qw/js/;"?
|
||||||
|
Perl._saveAndRun( scripts.join(";\n") );
|
||||||
|
}
|
||||||
|
else console.debug("Perl: No embedded scripts");
|
||||||
|
});
|
||||||
|
Perl._saveAndRun = function (script) {
|
||||||
|
Perl.init(function () {
|
||||||
|
var file = "/tmp/scripts.pl";
|
||||||
|
try {
|
||||||
|
FS.writeFile( file, script );
|
||||||
|
console.debug("Perl: Saved script(s) to ",file,", now running");
|
||||||
|
window.addEventListener("beforeunload", function () {
|
||||||
|
// not really needed because we're unloading anyway, but for good measure, end Perl...
|
||||||
|
console.debug("Perl: beforeunload, ending...");
|
||||||
|
Perl.end();
|
||||||
|
});
|
||||||
|
// run Perl async so that the window has a chance to refresh
|
||||||
|
window.setTimeout(function () { Perl.start( [ file ] ); }, 1);
|
||||||
|
}
|
||||||
|
catch (err) { console.error("Perl:",err); alert("Save to "+file+"Failed: "+err); }
|
||||||
|
});
|
||||||
|
};
|
||||||
|
|
||||||
|
Perl.changeState = function (newState) {
|
||||||
|
var oldState = Perl.state;
|
||||||
|
Perl.state = newState;
|
||||||
|
if (Perl.stateChanged) Perl.stateChanged(oldState,newState);
|
||||||
|
};
|
||||||
|
Perl.stateChanged = function (from,to) { //TODO: allow multiple listeners
|
||||||
|
console.debug("Perl: state changed from "+from+" to "+to);
|
||||||
|
};
|
||||||
|
|
||||||
|
// chan: 1=STDOUT, 2=STDERR
|
||||||
|
// implementations are free to ignore the "chan" argument if they want to merge the two streams
|
||||||
|
Perl.output = function (str,chan) { // can be overridden by the user
|
||||||
|
var buf = chan==2 ? 'stderr_buf' : 'stdout_buf';
|
||||||
|
Perl[buf] += str;
|
||||||
|
var pos = Perl[buf].indexOf("\n");
|
||||||
|
while (pos>-1) {
|
||||||
|
console.log( chan==2?"STDERR":"STDOUT", Perl[buf].slice(0,pos) );
|
||||||
|
Perl[buf] = Perl[buf].slice(pos+1);
|
||||||
|
pos = Perl[buf].indexOf("\n");
|
||||||
|
}
|
||||||
|
};
|
||||||
|
Perl.outputLine = function (chan,text) { // internal function
|
||||||
|
if (arguments.length > 1) text = Array.prototype.slice.call(arguments).join(' ');
|
||||||
|
Perl.output(text,chan);
|
||||||
|
Perl.output("\n",chan);
|
||||||
|
};
|
||||||
|
Perl.outputChar = function (chan,c) { // internal function
|
||||||
|
Perl.output(String.fromCharCode(c),chan);
|
||||||
|
};
|
||||||
|
|
||||||
|
Perl.makeOutputTextarea = function (id) {
|
||||||
|
var ta = document.createElement('textarea');
|
||||||
|
if (id) ta.id = id;
|
||||||
|
ta.rows = 24; ta.cols = 80;
|
||||||
|
ta.setAttribute("readonly",true);
|
||||||
|
Perl.output = function (str) {
|
||||||
|
ta.value = ta.value + str;
|
||||||
|
ta.scrollTop = ta.scrollHeight;
|
||||||
|
};
|
||||||
|
return ta;
|
||||||
|
};
|
||||||
|
|
||||||
|
var getScriptURL = (function() { // with thanks to https://stackoverflow.com/a/2976714
|
||||||
|
var scripts = document.getElementsByTagName('script');
|
||||||
|
var index = scripts.length - 1;
|
||||||
|
var myScript = scripts[index];
|
||||||
|
return function() { return myScript.src; };
|
||||||
|
})();
|
||||||
|
|
||||||
|
Perl.init = function (readyCallback) {
|
||||||
|
if (Perl.state != "Uninitialized")
|
||||||
|
throw "Perl: can't call init in state "+Perl.state;
|
||||||
|
Perl.changeState("Initializing");
|
||||||
|
var baseurl = new URL(getScriptURL());
|
||||||
|
baseurl = baseurl.origin + baseurl.pathname.substring(0,baseurl.pathname.lastIndexOf('/'));
|
||||||
|
Perl.readyCallback = readyCallback;
|
||||||
|
Module = {
|
||||||
|
noInitialRun: true,
|
||||||
|
noExitRuntime: true,
|
||||||
|
print: Perl.outputLine.bind(null,1), printErr: Perl.outputLine.bind(null,2),
|
||||||
|
stdout: Perl.outputChar.bind(null,1), stderr: Perl.outputChar.bind(null,2),
|
||||||
|
stdin: function () { return null },
|
||||||
|
arguments: ['--version'],
|
||||||
|
onAbort: function () {
|
||||||
|
Perl.changeState("Ended");
|
||||||
|
console.error("Perl: Aborted (state "+Perl.state+")");
|
||||||
|
alert("Perl aborted");
|
||||||
|
},
|
||||||
|
onExit: function (status) { // note this may be called multiple times
|
||||||
|
Perl.changeState("Ended");
|
||||||
|
if (status==0)
|
||||||
|
console.info( "Perl: Exit status "+status+" (state "+Perl.state+")");
|
||||||
|
else {
|
||||||
|
console.error("Perl: Exit status "+status+" (state "+Perl.state+")");
|
||||||
|
alert("Perl exited with exit status "+status+" in state "+Perl.state);
|
||||||
|
}
|
||||||
|
},
|
||||||
|
onRuntimeInitialized: function () {
|
||||||
|
console.debug("Perl: Module.onRuntimeInitialized");
|
||||||
|
Perl.initStepFinished();
|
||||||
|
},
|
||||||
|
preRun: [
|
||||||
|
function () {
|
||||||
|
console.debug("Perl: doing preRun, fetching IndexDB filesystem...");
|
||||||
|
try { FS.mkdir('/mnt'); } catch(e) {}
|
||||||
|
try { FS.mkdir('/mnt/idb'); } catch(e) {}
|
||||||
|
FS.mount(IDBFS, {} ,'/mnt/idb');
|
||||||
|
FS.syncfs(true, function (err) {
|
||||||
|
if (err) { console.error("Perl:",err); alert("Perl: Loading IDBFS failed: "+err); return; }
|
||||||
|
console.debug("Perl: IndexDB filesystem ready");
|
||||||
|
Perl.initStepFinished();
|
||||||
|
});
|
||||||
|
}
|
||||||
|
],
|
||||||
|
locateFile: function (file) {
|
||||||
|
var wasmRe = /\.(wast|wasm|asm\.js|data)$/;
|
||||||
|
if (wasmRe.exec(file))
|
||||||
|
return baseurl+"/"+file;
|
||||||
|
return file;
|
||||||
|
},
|
||||||
|
};
|
||||||
|
if (Perl.endAfterMain) {
|
||||||
|
Module.preRun.push(function () {
|
||||||
|
// patch _main so that afterwards we call emperl_end_perl
|
||||||
|
var origMain = Module._main;
|
||||||
|
Module._main = function() {
|
||||||
|
origMain.apply(this, arguments);
|
||||||
|
console.debug("Perl: main() has ended, ending perl...");
|
||||||
|
var status = ccall("emperl_end_perl","number",[],[]);
|
||||||
|
if (status==0) {
|
||||||
|
// we know that in this case, there is no event thrown to us (since exit() isn't called)
|
||||||
|
// so we have to transition states manually
|
||||||
|
Module.onExit(status);
|
||||||
|
}
|
||||||
|
return status;
|
||||||
|
};
|
||||||
|
});
|
||||||
|
}
|
||||||
|
console.debug("Perl: Fetching Emscripten/Perl...");
|
||||||
|
var script = document.createElement('script');
|
||||||
|
script.async = true; script.defer = true;
|
||||||
|
script.src = baseurl+"/emperl.js";
|
||||||
|
document.getElementsByTagName('head')[0].appendChild(script);
|
||||||
|
};
|
||||||
|
|
||||||
|
Perl.initStepFinished = function () {
|
||||||
|
if (Perl.state!="Initializing" || Perl.initStepsLeft<1)
|
||||||
|
throw "Perl: internal error: can't call initStepFinished in state "+Perl.state+" ("+Perl.initStepsLeft+")";
|
||||||
|
if (--Perl.initStepsLeft) {
|
||||||
|
console.debug("Perl: One init step done, but "+Perl.initStepsLeft+" steps left, waiting...");
|
||||||
|
return;
|
||||||
|
} else console.debug("Perl: All init steps done, doing final initialization...");
|
||||||
|
|
||||||
|
/* NOTE: Apparently, when NO_EXIT_RUNTIME is set, and exit() is called from the main program
|
||||||
|
* (from Module.callMain), Emscripten doesn't report this back to us via an ExitStatus exception
|
||||||
|
* like it does from ccall - it doesn't even call the addOnExit/ATEXIT or addOnPostRun/ATPOSTRUN
|
||||||
|
* handlers! So at the moment, the only reliable way I've found to catch the program exit()ing
|
||||||
|
* is to patch into Emscripten's (undocumented!) Module.quit... */
|
||||||
|
var origQuit = Module.quit;
|
||||||
|
Module.quit = function (status, exception) {
|
||||||
|
console.debug("Perl: quit with",exception);
|
||||||
|
Module.onExit(status);
|
||||||
|
origQuit(status,exception);
|
||||||
|
}
|
||||||
|
|
||||||
|
Perl.changeState("Ready");
|
||||||
|
if (Perl.readyCallback) Perl.readyCallback();
|
||||||
|
Perl.readyCallback = null;
|
||||||
|
};
|
||||||
|
|
||||||
|
Perl.start = function (argv) {
|
||||||
|
if (Perl.state!="Ready")
|
||||||
|
throw "Perl: can't call start in state "+Perl.state;
|
||||||
|
Perl.changeState("Running");
|
||||||
|
try {
|
||||||
|
// Note: currently callMain doesn't seem to throw ExitStatus exceptions, see discussion in Perl.initStepFinished
|
||||||
|
Module.callMain(argv ? argv : Module.arguments);
|
||||||
|
}
|
||||||
|
catch (e) {
|
||||||
|
if (e instanceof ExitStatus) {
|
||||||
|
console.debug("Perl: start:",e);
|
||||||
|
Module.onExit(e.status);
|
||||||
|
} else throw e;
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
Perl.eval = function (code) {
|
||||||
|
if (Perl.state!="Running")
|
||||||
|
throw "Perl: can't call eval in state "+Perl.state;
|
||||||
|
if (Perl.trace) console.debug('Perl: ccall webperl_eval_perl',code);
|
||||||
|
try {
|
||||||
|
return ccall("webperl_eval_perl","string",["string"],[code]);
|
||||||
|
}
|
||||||
|
catch (e) {
|
||||||
|
if (e instanceof ExitStatus) {
|
||||||
|
// the code caused perl to (try to) exit - now we need to call
|
||||||
|
// Perl's global destruction via our emperl_end_perl() function
|
||||||
|
Perl.end(); //TODO: Perl.end has already been called at this point (how?)
|
||||||
|
} else throw e;
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
/* Note that Emscripten apparently doesn't support re-running the program once it exits (?).
|
||||||
|
* So at the moment, once we end Perl, that's it. The only useful effect of ending Perl is
|
||||||
|
* that global destruction is executed and END blocks are called. But since a user may leave
|
||||||
|
* a webpage at any moment without warning, WebPerl scripts should not rely on normal termination! */
|
||||||
|
Perl.end = function () {
|
||||||
|
if (Perl.state!="Running") {
|
||||||
|
if (Perl.state=="Ended") {
|
||||||
|
console.warn("Perl: end called when already Ended");
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
else throw "Perl: can't call end in state "+Perl.state;
|
||||||
|
}
|
||||||
|
else Perl.changeState("Ended");
|
||||||
|
try {
|
||||||
|
ccall("emperl_end_perl","number",[],[]);
|
||||||
|
}
|
||||||
|
catch (e) {
|
||||||
|
if (e instanceof ExitStatus) {
|
||||||
|
console.debug("Perl: end: ",e);
|
||||||
|
Module.onExit(e.status);
|
||||||
|
} else throw e;
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
Perl.next_glue_id = 0;
|
||||||
|
Perl.GlueTable = {};
|
||||||
|
Perl._glue_free_ids = {};
|
||||||
|
Perl.glue = function (ref) {
|
||||||
|
var id;
|
||||||
|
var free_ids = Object.keys(Perl._glue_free_ids);
|
||||||
|
if (free_ids.length>0) {
|
||||||
|
id = free_ids[0];
|
||||||
|
delete Perl._glue_free_ids[id];
|
||||||
|
if (Perl.trace) console.debug('Perl: Glue reused id',id,'to',ref);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
if (Perl.next_glue_id>=Number.MAX_SAFE_INTEGER)
|
||||||
|
throw "Perl.GlueTable is overflowing!"
|
||||||
|
id = ''+(Perl.next_glue_id++);
|
||||||
|
if (Perl.trace) console.debug('Perl: Glue id',id,'to',ref);
|
||||||
|
}
|
||||||
|
Perl.GlueTable[id] = ref;
|
||||||
|
return id;
|
||||||
|
}
|
||||||
|
Perl.unglue = function (id) {
|
||||||
|
if (Perl.trace) console.debug('Perl: Unglue id',id,'from',Perl.GlueTable[id]);
|
||||||
|
delete Perl.GlueTable[id];
|
||||||
|
Perl._glue_free_ids[id]=1;
|
||||||
|
}
|
||||||
@ -0,0 +1,31 @@
|
|||||||
|
#!/usr/bin/env perl
|
||||||
|
use warnings;
|
||||||
|
use 5.0.26;
|
||||||
|
use FindBin;
|
||||||
|
use Plack::MIME;
|
||||||
|
use Plack::Builder qw/builder enable mount/;
|
||||||
|
use Plack::App::Directory ();
|
||||||
|
|
||||||
|
# Demo Plack server for WebPerl
|
||||||
|
# run me with "plackup webperl.psgi"
|
||||||
|
|
||||||
|
# in an Apache .htaccess file, one could say:
|
||||||
|
#AddType application/javascript .js
|
||||||
|
#AddType application/octet-stream .data .mem
|
||||||
|
#AddType application/wasm .wasm
|
||||||
|
|
||||||
|
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");
|
||||||
|
|
||||||
|
my $SERV_ROOT = $FindBin::Bin;
|
||||||
|
|
||||||
|
builder {
|
||||||
|
enable 'SimpleLogger';
|
||||||
|
enable 'Static',
|
||||||
|
path => qr/\.(?:html?|js|css|data|mem|wasm|pl)\z/i,
|
||||||
|
root => $SERV_ROOT;
|
||||||
|
Plack::App::Directory->new({root=>$SERV_ROOT})->to_app;
|
||||||
|
}
|
||||||
|
|
||||||
@ -0,0 +1,78 @@
|
|||||||
|
<!doctype html>
|
||||||
|
<html lang="en-us">
|
||||||
|
<head>
|
||||||
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
|
||||||
|
<title>WebPerl <script> Demos</title>
|
||||||
|
|
||||||
|
<script src="webperl.js"></script>
|
||||||
|
|
||||||
|
<!-- It's possible to load a single script like this:
|
||||||
|
|
||||||
|
<script type="text/perl" src="foo.pl"></script>
|
||||||
|
|
||||||
|
but then only a single <script type="text/perl"> tag is allowed in the
|
||||||
|
document, because there is only a single Perl interpreter.
|
||||||
|
|
||||||
|
If you use multiple <script type="text/perl"> tags like below, they are
|
||||||
|
concatenated into a single script and then run.
|
||||||
|
|
||||||
|
If you don't have any such script tags in the document, Perl won't be
|
||||||
|
run automatically, and you can control Perl in detail via the JS "Perl"
|
||||||
|
object provided by webperl.js (more control over output redirection, set
|
||||||
|
command line arguments, etc.). Most of this functionality is
|
||||||
|
demonstrated in the included "mini IDE".
|
||||||
|
-->
|
||||||
|
|
||||||
|
<!-- Example 1: A really basic script -->
|
||||||
|
<script type="text/perl">
|
||||||
|
print "Hello, Perl World!\n";
|
||||||
|
</script>
|
||||||
|
|
||||||
|
<!-- Example 2: Accessing JavaScript -->
|
||||||
|
<script type="text/perl">
|
||||||
|
use warnings;
|
||||||
|
use strict;
|
||||||
|
use WebPerl qw/js/;
|
||||||
|
|
||||||
|
js('document')->getElementById('my_button')
|
||||||
|
->addEventListener("click", sub {
|
||||||
|
print "You clicked 'Testing!'\n";
|
||||||
|
} );
|
||||||
|
|
||||||
|
</script>
|
||||||
|
|
||||||
|
<!-- Example 3: Using jQuery -->
|
||||||
|
<script src="https://code.jquery.com/jquery-3.3.1.min.js" integrity="sha256-FgpCb/KJQlLNfOu91ta32o/NMZxltwRo8QtmkMRdAu8=" crossorigin="anonymous"></script>
|
||||||
|
<script type="text/perl">
|
||||||
|
use warnings;
|
||||||
|
use strict;
|
||||||
|
use WebPerl qw/js/;
|
||||||
|
|
||||||
|
my $jq = js('jQuery');
|
||||||
|
my $btn = $jq->('<button>', { text=>"Click me!" } );
|
||||||
|
$btn->click(sub {
|
||||||
|
print "You clicked the jQuery button!\n";
|
||||||
|
} );
|
||||||
|
$btn->appendTo( $jq->('#buttons') );
|
||||||
|
</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( Perl.makeOutputTextarea() );
|
||||||
|
});
|
||||||
|
</script>
|
||||||
|
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<p>This is a demo of <a href="http://webperl.zero-g.net" target="_blank">WebPerl</a>!</p>
|
||||||
|
|
||||||
|
<div id="output"></div>
|
||||||
|
<div id="buttons">
|
||||||
|
<button id="my_button">Testing!</button>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
Loading…
Reference in New Issue