http://qs321.pair.com?node_id=91684

package Language::Japh; =pod =head1 NAME Language::Japh - Little language for creating JAPHs =head1 SYNOPSIS use Language::Japh; $j = Language::Japh->new($PROGRAM); $j->execute; =head1 DESCRIPTION Have you ever looked at the Obfuscated JAPHs posted online, and wondered how to get started on writing your own? Or maybe you've written some in the past, and are fresh out of ideas on how to write new ones. Enter Japh! Japh (pronounced to rhyme with "chaff") is a very simple language for writing JAPHs. This script includes the complete Japh parser as a Perl 5 module, so you can get started right away on creati +ng brand new JAPHs. Unfortunately, I'm still working on the syntax of the language, so I don't have a complete instruction set. But this script contains an example Japh language program at the very end, so you can get a feel o +f how the syntax works. The instructions are also commented, in case you need some additional help. Coming soon: the Japh programmer's reference, desktop ref, T-shirt, Website, ad banner, ballcap, IRC channel, mailing list, AYB image, PowerPoint presentation, dog bandanna, O'Reilly book, and geek cruise. I even got a good slogan: "It's not JAPH or japh -- it's Japh!" =head2 METHODS =over =item $j = Language::Japh->new($CODE); Creates a new Japh parser object. Pass to the constructor your program code. =item $j->execute(); Executes the code associated with the Language::Japh object. =back =head1 BUGS No diagnostic messages yet. I'll get around to it. =head1 AUTHOR James Allenspach, E<lt>jima@mcs.netE<gt> =head1 SEE ALSO L<perl>. =cut use strict; sub new { my $self = shift; my $class = ref $self || $self; $self = bless {}, $class; # Had to encode the parser inline, sorry s&|!0/pp&AeYswNzQmgm-NWi-x-Z-6ffisx"Y^ymXyxW0M!p&, s&oO2Wm0eVy&WY!ttPxg7W{-e2p^o^oit!{!VoemyQm/Qy O&, s&WYNeN`e!eY!!0exQfeyVY!p&!a{AeXmoIt[P6^ y|Nx!x[&, s&a`eoqWyp"VWpVZIyy`yo&WiZ!Q-f[-/im5Z7ze5byOzZ^x&, s&!NYUo-5|!b&tXWpWQaYtN7P^e!xp!IQy[e^t6eQx!tM[-m&, s&Vt^!X6ZpQW#syyWee&m/Izi!VOXw-ee!w[Q{zo[WA!s--x&, s&7m0bm-PNt!VwQe-.i5-e-mO#&zofZ,Xqp!y{aaZmzwZqOs&, s&ZbX&xIZxX!Uzxz^Wto{Z`mx/Vge!oeXIU6z!WeVYtexWW!&, s&Zp/tmW#w-eZm^5Nx&2`WbIN!ZbY[{NoV!_Z2P5ez print&, s&ozmY7f!2Ie[Yeo{]a&wI ^ag|mVYXI!QY_QYy-e-! Just&, s&X tg!QeUW`Yem-MX?!&N Yt/! ttxNVQt-Nooy another&, s&M!e!!{etY62&![xe[yYNZ tM!we2ob^tiY et!p^t Perl&, s&oz{p-2y-eXV!wZxe&mUz{IpgoV!xY!!{gPbNZe hacker,&, s&QifztXN!oQ6QQQ^It!&NmemZ[N#YXOm ZZMybXozaww \n&, s&Q^yt!oytQZ`p#ope&5Zbyqzpmo!!tQW`O{`!f2X_-tzsZ6&, s&Nozi{&V!Q2!{IYY}[N!X[Y!bNxb[Poio[W`p^toeW-2ZQQ&, s&N-aMQZtXZt!MZ!"xZ6N{ZA Y&t^eeoZtV{QZYy^eN0m{!e&, s&o`!{mowysfo{tWteN5!&!t!pYm -!tqNZo|g{!YY`eNY!^&, s&UXfXf_2tmo!ZQe^W-Am&Xmpx!!mP[OQtbIeppxIQ-t!^e[&, s&pppx}|!eN!pX!NZ5U{mN&emZi/zewoUfm2ymexymXx!`!{&, s&o_WtMNpQztet`N|m/Z2wtp&N!AVZ!5YNw[!p!-6tZgJAPH&, s&oZ-|yxVW-PV!ezp&efNxyeeeZ[^mytqy5IZXb!NyZ22y-X&, s&7OxY!fteYoy#5!-0ay_yyZt#Y&U[pV"s{VxwXQm7M2{ZyQ&, s&Wt,qpmA^A&xymp !w!YNM!-`^O2W[!tx!f-Z2Ze_7teiZ}&, s&Nomt}0N5oWo|Y#N-ZZ^"-!Zm&ZNmU!yWza`YZzt[eiyt-^&, s&,tg#eezty"ZtYyN/z>.AV &{f--eWUy-mx!!iN-`x2N7t!&, s&xQW&Nm[N!!Q![eQ-Vxg`z!05e!-[ZfNI[!`-e#N6e!!-yx&, s&Z&etWoQVXzpow{-!b!["oQ[^a5z!wmzQm{ZXW-yo2YZZyt&, s&txtWNaxx&W-Q^zN5Z!YpxY2!ZWQ!sy#2!!pNWX-ypNeWto&, s&`Nm<!Wa}!NeQ0>e&mm0ey`!W`{yy|UY^MeW2!st{!tQ^N!&, s&ty{!`!"ewUNX&tZWWzIpa2YtW!yf2qeZwWV!2^tQ`{-e!}&, s&oxMpeZxe#zm{eQzfNfptpb!2&Q!-Y^![W`-!ZPVey{eXAN&, s&!Oieyee}!Y Y5Nmze_6X!!!fX&xW!tWX2ftN`yIPpye!!y&, s&NtxsI&ymW[QgwoA56p-2g^!z`-wez!Z!2!pw!zsps!sAfY&, s&!tYawyQwe{yOwsz&teowfxgUWoN!tWONo[-!!!-MN!-NQW&, s&-{O-{0^ZeeeempoNb!ZWyWy&{W_QWseyeiQZop-y;print&, s&{i#xZz&-mYp{M!eOZx!m!{MtXZVmX[zt^qeq`opQebzo7!&, s&,m:Wx"t}pYx%f{Nex7MXe0x&sU2W{|-o`YV yZzw7o!^Uy&, s&/-f&wee"woe!eeo!!zey`Z!yU6-f!wx{y{eeaX2{Z!W!YZ&, s&tyiwNIZt_QoeZ&!o|!tt!tyy{W!Y[NZQg-|w`{q!NXyNoV&, s&x!`e?Wxx!a_,o&Xzmx#eXeZzWwpe!`^}UQWtyNf2{Y/yyW&, s&o|Wo!&xNYWtyoWepy{//eItteN#b!-t#Wy!^W _wxzemIQ&, s&Z&#!b!ee{{xf-O!!xQ!I/t!zte!6x##^pWt!eWZX-WzN}!&, s&|!Qe{{!xoN&xeQy-#oZe!"p!N/t"!b^e!{W!!pep#!#7WQ&, s&yeoVe!twNW{Vff&qtm!!{N!NUYYxse"PyV6t_z{Qwpt-bN&, s&m0ZQ-{x27WybzI&Wo!e-t!tmwWVUoZe-!Nxmo!etat-y{m&, s&^.+$&yme!sxNV{y!"!Y-e!NI{!p!Y-e!NezxMPNINVO{yN&, s&^&iZ[^WxUZa_bxtQ/eZ[Xf2Qyyme!q zt!!-[XxtQp`Www&, s&$&ez!^W`YfZpt#!YW-bgeZp2mteW^X}0m5A67oo|{tQ-oo&, s&ZNNoZ{z/A$&ZNNoZ{z/A&,y,p-} -o, -},,eval,#tt!e&, s&x!tz-ti2Z-ba&-zNm6ibyp!!yYytz2ZoxNt^{!-!Ye-xtZ&, s&pZzz`{&xNb^eNI!ZwmfoiQWWmm^!e-tee!!OttettNp#f|&, s&ZpeYx&a!bmx-!ONze#b-Y-Uz2YWwYypQQX{XyAQ zft!-t&, s&A_pQ&{{-ppxtQ_o6xVUzm#Z!Zwi/bZ0Q!bMXmfb{!eNeWe&, s&!t!yNx^/##w{N`&tA!tQtwt!em"7eoW0MVpYIW^^}#x!tZ&, s&Ib2&yYeNeye2-`p!YIeXQ2N`V!XWYeAep!}2yoQ 5o{eze&, s&{_|-eYpyYx#IYwN`q N!ytiX!&!eIyAtm0xINfVQ Q!YM!&, s&}m!yWpo!Y!e"!XWQ!#!!eWpt!&tVZNNoZ{z/AeY!WY!e!O&, s&!xs&m0YaYOZ{Y^w!x{omNewxe-IV6"e`!VoYwo!Wt{!!!e&, s&YxYN!WYa}t!z2^t0 xp6em&my!!e/`x!6"#f{Qpte!e_wZ&, s&7N!!eY!bm!x!!!UVXM{zoQ&!X`Z 5ze6atQbfmxtNo-0V5&, s&e!my!N-fVy!om&t!^qtOm-eee#"5ZX^!{!V{Ne#/Zxy{Z2&, s&WqWQP/Y!e`W"ewetZ{QeOx#&gytyyszZW0#!7N^!5-NZ5o&, s&-5}YWN!0eo#!VIx&#ypeXWxNzW#Z7ezM{-ffZ!and+eval&, s&`2ZpmemmsQ&!oWVypZQ^pQg#mQgXPxwI!{eo![5Z-W-tQo&, s&Nz`N!zYmxY0tt&WVf-Nxg{Ab2me^eWYze2^zZQ6e5NyXP!&, s&eN2om!p!eXpY Np/&e--W-!m-|fY-!i`bxm^[Q[fx-ZZiY&, s&Mow&5mtIZ{Ny{[2X!2{e[QN#-0Wm6Wef6Q6m[sIiIOAWw-&, s&AYW#emQtxy2efQI{!ImeWZoI`&ZtYQe2|{eQ^[f!-Xe!VU&, s&o}-PN&eZQ2eex/^YzztxWMNpWYtXN!^-[!!Yt-btm2I2yN&, s&e!!`ZXAyZ`maZ &pp{we2YeZ-em-_Q{-W"ye{ !W`tpXe{&, s&xZ}^t{ZNI2Vt{{!!x2pV&tt!Zm!p6ZNNtxXXN!!!a2!pb`&, s&Nz{YZmmQQ &pN ^NeZpybt -{wo}gYZ }Nyx"!s[zYxQWm&, s&tQ-geoZxYAm!bx{6ex&Wmf{Mt!WZ!b{sx!zQ!!zOo^/we#&, s&g6-z"bot!XP20Wsy2&W^-mwPoZXe/e!{!xx`2pte-#yUwq&, s&Q{#&^-zz`ym7zty{"^y0eXw[eIVP55^Xzm!^p!{s2"QU5o&, s&!we-wQWpmtwWe!py&{Z-xXg!`[t!fYtAz!!e{NNbx"{!Pb&, s&OepezQ!Q!tieNoZp5YWNewYeA&7{oUyeb!yeVZm^QIwQ!i&, s&p&e!teZ`f-!^f5VY!AytW`Z`[yNQb}eoe!y!X!!WAasbI5&, s&"!ieeU^VN fZN&+and+or+not+eval+sin+cos+tan+pop&, s&Ms!Z/eP- {`oxoy,tNme22b&+push+pack+unpack+else&, s&6eb_Qze&+if+elsif+print+pop+join+map+grep+sort&, s&!!oZ`&0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ#{}!&, s&mI`-!p/-!$&+},rekcah lreP rehtona tsuJ{q+tnirp&, return $self; } sub execute { my($self) = shift; my($op) = shift @{$self->{CODE}}; ## OPCODE TO EXECUTE if (ref $op eq 'CODE') { ## SUBROUTINE DATA &{$op}($self); warn "subroutine error: $!" if $!; } elsif (ref $op eq 'HASH') { ## DATASET for (sort values %$op) { print $_ if ref eq ''; # print only scalars } } elsif (ref $op eq 'SCALAR') { ## SCALAR DATATYPE print $$op; } elsif (ref $op eq 'ARRAY') { ## ITEMLIST print join ' ', @$op; } else { ## DEFAULT: CHAR DATA print chr $op; } return $self->execute if @{$self->{CODE}}; } package main; # and finally, our example! my($japh) = Language::Japh->new(<DATA>); $japh->execute(); print "\n"; __END__ PROGRAM JAPH; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!! !!! !!! PROGRAM: JAPH !!! !!! AUTHOR: JIMA !!! !!! DATE: 2001-JUN-22 !!! !!! !!! !!! THIS IS A DEMO PROGRAM TO SHOW THE BASIC !!! !!! PROPERTIES OF THE JAPH PROGRAMMING LANGUAGE. !!! !!! IT SHOULD BE OBVIOUS WHAT THIS PROGRAM DOES; !!! !!! CHECK THE COMMENTS IF CLARIFICATION IS !!! !!! NEEDED. !!! !!! !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! X,Y: INTEGER; !! OUR COEFFICIENTS Z,W: FLOAT; !! ITERATORS A,B: BINARY; !! CAKE FROSTING CLR(PC); !! RESET PROGRAM COUNTER ASSOCIATE(INTEGER); !! DO INTEGER MATH X:=A+#75; !! CONSTANT ADDITION Z:=Z+W; !! SELF-REFERENTIAL CALCUALTIONS A:=W(BINARY); !! BINARY DATA? Y:=#40(CHAR); !! STRONG TYPING? B:=#99*Y; !! 99 OCT(??) B:=B(CHAR); !! SELF-EXPLANATORY CLR(PC); !! RESET THE PC POPSTACK(#01); !! RETURN TO CALLING PROGRAM Y:=#40+B; !! SPACE? Y:=Y(CHAR); !! TYPE? B:=#40(POPSTACK()); !! OF COURSE! XOR(PC); !! NOW PRINT OUT RESULTS Y:=#40(CHAR); !! Y IS ITEM DELIMITER CHRFORMAT(<<<<SSSSSSS); !! OUTPUT FORMAT FOR STRINGS NUMFORMAT(<<FFFFFFFFF); !! OUTPUT FORMAT FOR NUMERICS P(#01,INTEGER); !! DATA IS INTEGER TYPE P(#01,Y); !! PRINT RESULTS Y:=Y(CHAR); !! TYPECAST Y VARIABLE, FOR THE NEXT PROG R +UN STOP PROG.