serve.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 no warnings qw(uninitialized redefine);
   5 $| = 1;
   6 use FindBin qw($Bin);
   7 use lib "$Bin/othlia";
   8 use lib "$Bin/slib";
   9 use G;
  10 sub dige { slm(12, Digest::SHA::sha256_hex( encode_utf8(shift) ) ) };
  11 my ($A,$C,$G,$T);
  12 my $ar = {};
  13 !-d $_ && `mkdir -p $_` for qw'wormhole/digway G W';
  14 $| = 1;
  15
  16 use Mojolicious::Lite;
  17 use MIME::Base64;
  18 push @{app->static->paths}, '/home/s/styleshed/public';
  19 app->secrets(["nothing"]);
  20 # divert mojo log statements from our err channel
  21 #app->log->path(($G->{c}->{ipd} || $G->{c}->{dir})."/mojo\.log")
  22 #    if $G->{c}->{dir} || $G->{c}->{ipd};
  23
  24 our $listen = "http://localhost:1422";
  25 if (-f 'listen') {
  26     $_ = `cat listen`; chomp $_;
  27     $listen = 'http://'.$_;
  28 }
  29 sub starts {
  30     1 && saybl "Starting     listens: $listen";
  31     app->start('daemon', '--listen' => "$listen");
  32 }
  33 sub JaBabz {
  34     my $C = shift;
  35     no warnings qw(uninitialized redefine);
  36     my $poing = qr/\w+(?:\.\w+)?/;
  37 my $nlp = qr/[^\n]+/;
  38 my $nls = qr/[ \t]*(?! *\/\/)/;
  39 # < enj() should do this
  40 my $jstring = sub { my ($s) = @_;
  41     $s = sjson([$s]);
  42     $s =~ s/^\[//;
  43     $s =~ s/\]$//;
  44     $s
  45 };
  46 my $hide = {};
  47
  48 # leaf 4:
  49 my $twolt = '<<';
  50 $C->{c}->{s} =~ s/^(\w+)(?: (-?\w+))?:(?: (%$nlp))?$/n $1 $2 \$s:$twolt'' $3/smg;
  51 # blockquote til /^\s*$/g
  52 # multi line, always \n$
  53 # supposed to not babz anything in it...
  54 # < stylehouse (the editor) must know this too
  55 #     or it'll expand tabs to 4 spaces
  56 $C->{c}->{s} =~ s{^(\s*)($nlp)<<(''|"")($nlp?)\n((?:\1$nlp\n)+)[ \t]*\n}{
  57 # < allow empty lines with first line's indent
  58 #   would be easy if we were iterating lines
  59     my $babin = $3 eq '""';
  60     my $ind = $1 || '';
  61     my $fore = $2;
  62     my $line = $ind.$fore."BlockQuote$4\n";
  63     my $was = $5;
  64     my ($reind) = $was =~ /^(\s+)/;
  65     $was =~ s/^$reind//sgm;
  66     if ($babin) {
  67         my $C = {c=>{s=>$was}};
  68         JaBabz($C);
  69         $was = $C->{c}->{s};
  70     }
  71     my $lines = [split /\n/, $was];
  72     $lines->[-1] eq '' && pop @$lines;
  73     # not always?
  74     #die "not nl last: aft $line: $lines->[-1] ".wdump 3,[$was,$lines];
  75     $lines = join "+\n", map {
  76         $ind.$jstring->("$_\n")
  77     } @$lines;
  78     $lines = $ind."var BlockQuote =\n$lines;";
  79     my $dig = dig($lines);
  80     $hide->{$dig} = $lines;
  81     "HIDING:$dig\n$line";
  82 }smeg;
  83
  84 #$o = $G->{h}->($A,$C,$G,$T,"readLines",<<'');
  85
  86 # # comment to // comment
  87 $C->{c}->{s} =~ s/^(\s*)#/$1\/\//gsm;
  88 $C->{c}->{s} =~ s/( \{|}|;) #/$1 \/\//gsm;
  89 # =pod (.+) =cut comment
  90 $C->{c}->{s} =~ s/^(\s*)=\w+(.+?)^\s*=\w+\s*$/
  91     join "\n",map{"$1\/\/ $_"} split"\n",$2;
  92     /gesm;
  93
  94 # capital A is the more empiricle
  95 $C->{c}->{s} =~ s/\bA&(\w+)\b/A\.c\.$1/g;
  96 $C->{c}->{s} =~ s/\ba&(\w+)\b/A\.sc\.$1/g;
  97 # and for $G->{h}->($A,$C,$G,$T,"somea","goof") -> $A->{some}->{sc}->{goof}
  98 $C->{c}->{s} =~ s/\b(\w+)A&(\w+)\b/A\.$1\.c\.$2/g;
  99 $C->{c}->{s} =~ s/\b(\w+)a&(\w+)\b/A\.$1\.sc\.$2/g;
 100
 101 # @Thing -> $A->{1}->{sc}->{Thing}
 102 0 &&
 103 $C->{c}->{s} =~ s/(?<!\w)\@(\w+)\b/1s\&$1/g;
 104
 105 # '$A->{4}->("tv") jo eig notch'
 106 #  -> '$A->{4}->{y}->{tv} && $A->{4}->{y}->{tv}->{jo} && $A->{4}->{y}->{tv}->{jo}[0.1]' etc
 107 # io but much simpler, single
 108 # < could N many/gref with a sub
 109 # < jsbab since so floody
 110 # < going into $G->{h}->($A,$C,$G,$T,"things","uni/va/ve/la") etc
 111 $C->{c}->{s} =~ s{\b($poing)&tv(( \$?\w+\b)+)}{
 112     my $thing = $1;
 113     my @path = split ' ', $2;
 114     my @expr = ("'$thing"."&tv @path'", $thing);
 115     for (@path) {
 116         my $cv = s/(\d+)$// ? $1 : 1;
 117         $cv *= 0.1 while $cv >= 1;
 118         my $t = s/^\$// ? '['.$_.']' : '.'.$_;
 119         push @expr, $thing.'.y', ($thing = $thing.'.y'.'.tv');
 120         push @expr, "$thing$t", ($thing = "$thing$t"."[$cv]");
 121     };
 122     join " && ", @expr;
 123 }ges;
 124
 125
 126
 127 # $A->{3}->{sc}->{do} -> $A->{3}->{sc}->{do}
 128 $C->{c}->{s} =~ s/\b(\d)(s|c)&(\w+)\b/"A[$1].".($2 eq 's' ? 'sc' : 'c').".$3"/smeg;
 129 # make $G->{h}->($A,$C,$G,$T,"upA","thing") -> $A->{up}->{c}->{thing}
 130 $C->{c}->{s} =~ s/\b(\w+)(a|A)&(\w+)\b/"A.$1.".($2 eq 'a' ? 'sc' : 'c').".$3"/smeg;
 131 # $A->{1} -> A[1]
 132 $C->{c}->{s} =~ s/\b([a-z]+)\.(\d)\b/$1.'['.$2.']'/gie;
 133
 134 # $v->{sc}->{do} -> $v->{sc}->{do}, etc
 135 # < doing the above three paragraphs in this one:
 136 # < $A->{up}->{c}->{s}->{sc}->{pi}...
 137 $C->{c}->{s} =~ s[\b(\w+)(s|c|y)&(\w+)\b][
 138     my $arm = ($2 eq 's' ? 'sc' : $2).".$3";
 139     my $on = $1;
 140     my $wa = $on;
 141     my $s = 'A';
 142     if ($on =~ /^(up)+(C)?$/) { # $A->{up}->{sc}->{do} -> $A->{up}->{sc}->{do}
 143         # the other A aliases use $G->{h}->($A,$C,$G,$T,"upa","do")
 144         $s .= '.up' while $on =~ s/^up//;
 145         $s .= ".c\.s" if $on =~ s/^C//;
 146
 147     }
 148     elsif ($on =~ /^\w\w+$/) { # $G->{h}->($A,$C,$G,$T,"oms","do") -> $om->{sc}->{do}
 149         # used to hang off A
 150         $s = $on;
 151     }
 152     else { # $z->{sc}->{do} -> $z->{sc}->{do}
 153         $s = $on;
 154     }
 155     $s.'.'.$arm
 156 ]smeg;
 157
 158 # capital C is the more universal (prefer $C->{sc}->{do})
 159 $C->{c}->{s} =~ s/\bs&(\w+)\b/C\.sc\.$1/g;
 160 $C->{c}->{s} =~ s/\bC&(\w+)\b/C\.sc\.$1/g;
 161 $C->{c}->{s} =~ s/\bc&(\w+)\b/C\.c\.$1/g;
 162
 163 #c io
 164 # recursive regex, but:
 165 #   imbalanced brackets cause an infinite loop
 166 # < something off the net
 167 #   perldoc perlre "(??{ code })" onwards?
 168 my $brackin;
 169 $brackin = qr/\{[^\}\{]*$brackin?[^\}\{]*\}/;
 170 my $varguessbab = sub { my ($t,$s,$varcod,$nocall) = @_;
 171     my $talk = $s;
 172     # talk is all the i is without the i
 173     my $cod = [];
 174     my $h = {path=>[],vars=>[],arks=>[]};
 175     my $defunc;$defunc = sub {
 176         $s =~ s/^\s+//s;
 177         if ($s =~ s/^((\w+:)*)\{/\{/s) {
 178             my $arkfor = $1; # not in $whole, can forget
 179             $h->{bail} = "not even" unless $s =~ /^$brackin/;
 180             $s =~ s/^($brackin)(:(\S+)|) ?//;
 181             my $whole = $1;
 182             my $withname = $2;
 183             my $name = $3;
 184             my $code = $whole;
 185             $code =~ s/\s+$//;
 186             $code =~ s/^\{|\}$//g;
 187             if ($code =~ /^(\w+)(?::(.+))?$/) {
 188                 my $prerolled_function = $1;
 189                 # which will peel/parse
 190                 my $subtalk = $2;
 191                 # < turn "la $inter " into "la ".$inter." "
 192                 # < sjson string
 193                 push @{$h->{vars}}, '"'.$subtalk.'"';
 194                 my $now = "{$prerolled_function}";
 195                 $talk =~ s/\Q$whole\E/$now/;
 196                 # continue
 197                 return $defunc->();
 198             }
 199             $code = [split ";", $code];
 200             # return last expression
 201             if ($code->[-1] !~ /return/) {
 202                 my $expr = pop @$code;
 203                 $expr =~ s/^\s+//;
 204                 push @$code, " return $expr"
 205             }
 206             $code = join ";", @$code;
 207             $code = "&acgts"."{ $code }";
 208             push @{$h->{vars}}, $code;
 209             # its var is a function, its talk is anything else about it
 210             my $now = "{}";
 211             if ($name) {
 212                 $now .= ":$name";
 213                 push @{$h->{arks}}, $name;
 214             }
 215             $talk =~ s/\Q$whole$withname\E/$now/s
 216                 || push @$cod, "no replacing: $whole";
 217             #push @$cod, "Would $name: $code\n"
 218             #    ."  onward: ".slim(20,$s)."\n";
 219
 220             # and again
 221             $defunc->();
 222         }
 223     };
 224     my $after_first_pathy_thing;
 225     # since that redefines columns
 226     # assume @things, #things, $things, anything:things are for var/ar unpack
 227     $defunc->();
 228     my $firstpath = $h->{path};
 229     while ($s =~ s/^(\S+)\s*//) {
 230         my $island = $1;
 231         $firstpath = [@{$h->{path}}] if $island =~ /^[io]$/;
 232         my $path = [split '/', $island];
 233         for (@$path) {
 234             my $pa = {};
 235             # waving (and so we dont see :y)
 236             #   and this avoids latic:yon/... in paths...
 237             $pa->{arkfor} = $1 if @$path == 1 && s/^((\w+:)+)(\*)?y(\w|$)/${3}y$4/;
 238             # returning
 239             $pa->{ark} = $1 || 1 if s/:(\w*)$//;
 240             # greffing
 241             if (s/\{(\S+)\}?$//) {
 242                 $pa->{gref} = $1;
 243                 while ($pa->{gref} =~ /\$(\w[\w\[\]\.]*)/g) {
 244                     push @{$pa->{grefpara} ||= []},$1;
 245                     push @{$h->{vars}}, $1;
 246                 }
 247                 s/^/*/ if /^$/; # implies globbing
 248             }
 249
 250             # parameters in
 251             $pa->{isdelete} = 1 if s/^-|-$//;
 252             $pa->{issark} = 1 if s/^@//;
 253             $pa->{isvar} = 1 if s/^#//;
 254             $pa->{isvar} = 2 if s/^\$//;
 255             $pa->{issark} && $pa->{isvar} < 2 && delete $pa->{isvar};
 256             $pa->{t} = $_;
 257             my $varnamung;
 258             # the notion of C always split/linking domain names etc
 259             if ($pa->{t} =~ /^\w+[\[\.]\w/) {
 260                 # A[1].$sc->{cee} named $cee
 261                 # < could be pointing to anything
 262                 #   into datatype (date/time/style?) aspects
 263                 #   to/through/with functions
 264                 #   at such rhythms, intro such dimension
 265                 $varnamung = $pa->{t};
 266                 my $name = $1 if $pa->{t} =~ /^\w[\w\[\]\.]+?(\w+)$/;
 267                 !$name && die "Cant de-qualify name: $pa->{t}    in $talk";
 268                 #1 && saybl "AHvo: $name ". substr($name,0,1) . " OPR " . substr($name,1,0);
 269                 $name = "\$$name" unless
 270                     substr($name,0,1) eq "\$";
 271                 $talk =~ s/\$?\Q$varnamung\E/$name/sg
 272                     || die "Cant find $pa->{t}    in $talk";
 273                 $pa->{t} = $name;
 274                 $pa->{isvar} = 1;
 275             }
 276             $pa->{isvar} && push @{$h->{vars}}, $varnamung || $pa->{t};
 277             $pa->{glob} = 1 if $pa->{t} =~ /^\*/;
 278             $pa->{word} = 1 unless $pa->{isvar} || $pa->{issark} || $pa->{glob};
 279
 280
 281             # not barewords or spacers :unless
 282             # but anything @plumbed
 283             $pa->{ark} = $pa->{t} if $pa->{ark} eq '1';
 284             !$after_first_pathy_thing
 285                 && ($pa->{ark} || $pa->{issark}) &&
 286                     push @{$h->{arks}}, $pa->{ark} || $pa->{t};
 287             push @{$h->{path}}, $pa;
 288         }
 289         $after_first_pathy_thing = 1 if @$path > 1;
 290         $defunc->();
 291     }
 292     #c iocall
 293     return "Bailed: $h->{bail}" if $h->{bail};
 294     while (my ($t,$iv) = each %{$h }) { ref $iv eq 'HASH' || next;
 295     while (my ($i,$n) = each %{$iv }) {
 296         $n =~ /\W+/ && die "wobbyly $t varnameinterpretation: $n", $s;
 297     }}
 298     @{$h->{arks}} = uniq @{$h->{arks}};
 299     if (!@{$h->{arks}}) { # see $io->{realise}
 300         # accept $pa->{t} as a possible name
 301         for my $pa (@{$h->{path}}) {
 302             next if !$pa->{t};
 303             next if $pa->{t} =~ /\W/;
 304             push @{$h->{arks}}, $pa->{t}
 305         }
 306         # possibly just s
 307         @{$h->{arks}} = 's' if !@{$h->{arks}};
 308     }
 309     my $la = $firstpath->[-1];
 310     # the test: i $d/@la/@dio la:{} ... puts s as the {}
 311         #my $vork = '$d/@la/@dio';
 312         #$talk =~ m{\Q$vork\E}
 313         #    && saybl "Found it: ".wdump 5,[$h,$la];
 314     # maybe we should call it r if .../made:s {}
 315     # probably about right.. unplumbed {}$ could mean grep that stuff?
 316     #   except for row generation, which is how anyway?
 317     # < knowing better, realise() won't spit out doofs as s
 318     if (($la->{glob} || $la->{word}) && !$la->{ark} && !$la->{issark} && !grep {$_ eq 's'} @{$h->{arks}}) {
 319         @{$h->{arks}} = grep { $_ ne $la->{t} } @{$h->{arks}}; # remove word as nonark
 320         push @{$h->{arks}}, 's';
 321     }
 322
 323     # S does var setting, or each io can set ay
 324     #   but not each $ay->{sc}.$arks
 325     my $sets = 'ay';
 326
 327     push @$cod, "var $sets = " unless $nocall;
 328     $nocall->{sets} = $sets if $nocall;
 329
 330     # put i/o in talk
 331     $talk = "$t $talk" if $nocall;
 332     # quote talk
 333     (my $vus = sjson([$talk])) =~ s/^\[|\]$//g;
 334     # call io (or dont)
 335     my $call = $nocall ? "" : "io\.$t(";
 336     push @$cod, "$call$vus,[";
 337     # bind params
 338     push @$cod, join ',', @{$h->{vars}} if @{$h->{vars}};
 339
 340     push @$cod, ']'.($nocall ? "" : ");");
 341     # undef (becomes $cod) if $ar->{testing_io_vars}
 342     # else for hoisting up to the inside of the S {
 343     my $ya = '';
 344     # if not hoisting and returning an s column, set first one as ya
 345     $ya = " var ya = ay\.sc\.s && ay\.sc\.s[0];"
 346         if !$nocall && grep {$_ eq 's'} @{$h->{arks}};
 347     $varcod ||= $cod;
 348     push @$varcod, ' var '.$_.' = '.$sets.'.sc.'.$_.';' for uniq @{$h->{arks}};
 349     $cod = join '', @$cod, $ya;
 350     $ar->{ta} and push @{$ar->{ta}}, [$talk,$cod];
 351     return $cod
 352 };
 353 return $varguessbab if $ar->{ta};
 354 $C->{c}->{s} =~ s{(^\s*|return )(i|o) ([\w\@\{\$\#]+[^\n]*[^\n;]+)$}{
 355     # unless testing, i/o doesn't set variables, only as S i/o
 356     my $varcod = $ar->{testing_io_vars} ? undef : [];
 357     "$1".$varguessbab->($2,$3,$varcod) }smeg;
 358
 359
 360 #c each
 361         # each etc $data {    into:
 362         # while (my ($e,$tv) = each %$data) {
 363         # while (my ($t,$c) = each %$tv) {
 364         #   so the value tv is for t-ing into
 365         # DIY closing brackets
 366         # avoids eaching nonref after first
 367         # could replace with $G->{h}->($A,$C,$G,$T,"chew-ish") call if more spec
 368         # and know indents to close
 369         my $doi = sub {
 370             my ($ind,$in,$from) = @_;
 371             my @in = split ',', $in;
 372             @in = split '', $in[0] if @in == 1;
 373             my @open;
 374             while (@in) {
 375                 my $k = shift(@in);
 376                 my $v = shift(@in);
 377                 unshift @in, $v if @in;
 378                 $v = $v.'v' if @in;
 379
 380                 my $s = "for (var $k in $from) {";
 381                 $s .= "\n    var $v = $from\[$k];";
 382                 $s .= "\n    if(typeof $v != 'object') { continue }"
 383                     if @in;
 384
 385                 $from = $v;
 386                 push @open, $s;
 387             }
 388             @open = map { $ind.$_ } @open;
 389             join "\n", @open;
 390         };
 391         $C->{c}->{s} =~ s/^(\s*)each (\w+(,\w+)*) (\S+) \{(\s*)$/
 392             $doi->($1,$2,$4);
 393         /smeg;
 394
 395
 396 #
 397 #c other
 398 # (~hifnotc)?~com message: list, of, interestings
 399 # < colouring or otherwise classifying by the source of the way
 400 #   eg everything from 4* looks kind of blue, etc
 401 #   more colour will jump in on top as aspects unfold, yadda
 402
 403 my $lnlp = qr/[^\n;]+/;
 404 $C->{c}->{s} =~ s{(; |^|\{|and |return |= ) *~(?:(\w+)~)?(\$?>?[\w]+(?:$lnlp?:)?)(?: ($lnlp)?)?(;|$)}{
 405     my $ope = $1;
 406     my$c=$2||'c';
 407     my$s=$3;
 408     my$e=$4;
 409     $s=~s/:$//;
 410     $s = "'$s'" unless $s =~ s/^\$//;
 411     $ope."G\&$c:$s,[$e];"
 412 }segm;
 413
 414 # chuck error: throw "Something", C
 415 #   throws new Error("Something"), its .tc=[C]
 416 #     also handles concatenated bits for "Something":
 417 my $varbits = qr/[\w\[\]\.]+/;
 418 my $concatbit = qr/\+(?:[\w\[\]\.]+|"[^\n"]+")/;
 419 $C->{c}->{s} =~ s{(^\s*(?!#)$nlp?)throw ("[^\n"]+?"$concatbit*)(, ?$nlp)?;?\s*$}{
 420     my $ope = $1;
 421     my $msg = $2;
 422     my $tc = $3;
 423     $msg =~ s/: ?"$/"/;
 424     my $guts = "new Error($msg)";
 425     if ($tc =~ s/^, ?//) {
 426         $tc =~ s/;$//;
 427         $guts = "{var er = $guts; er\.tc = [$tc]; throw er}";
 428         # "
 429     }
 430     else {
 431         $guts = "throw $guts;";
 432     }
 433     $ope.$guts
 434 }segm;
 435
 436 # rechuck error: throw e, "inn"
 437 #   pushes $e->{catches} $e->{stack} to $e->{stacks}[],
 438 #     chrome < 2012 restacks when rethrowing
 439 #
 440 $C->{c}->{s} =~ s{(^\s*(?!#)$nlp?)throw ($varbits)(, ?$nlp)?;?\s*$}{
 441     my $ope = $1;
 442     my $var = $2;
 443     my $tc = $3;
 444     my $guts = "($var\.catches = $var\.catches || [])";
 445     $tc = $tc =~ s/^, ?// ? ",tc:[$tc]" : "";
 446     $guts .= ".push({stack:$var\.stack$tc}); throw $var;"; # "
 447     $ope.$guts
 448 }smeg;
 449
 450 #c n groundula, keywords, subs
 451
 452 # n thing -jod_33 s:var hue:'490deg'
 453 #   c/sc get wrapped with {}
 454 # or:
 455 # n thing -jod_33 s:string %hue:490deg,note:$note+btw
 456 #   and c/sc become $G->{h}->($A,$C,$G,$T,"peel") bits, $note+ becomes "+note+"
 457 #   and c $s:object,$up:ob will make json (wrapped with {})
 458 #   greediness of c/sc regarding % needs tuning
 459 #     be nice to have spaces in c, editor could easily step over all this
 460 # < C like this, but fits after { or =
 461 # < n:r yabbada to $r = $G->{h}->($A,$C,$G,$T,"n",['yabbada','W'])
 462 #   viz. this Babz decides when [t] means cW:t
 463 #   and sets a variable to the C created
 464 # also u:thing so that $thing becomes that object in the mind
 465
 466 my $blankycsc = '"",{},{}';
 467 $C->{c}->{s} =~ s{(^\s*|return )(n|u|m|e) (\$)?("[^\n"]+"|\w+\S*)(?: (\$)?([-\w]*))?(?: ([^\n]*?))?(?: (%)?([^\n]*?))?$}{
 468     my $ope = $1;
 469     my $mode = $2;
 470     my $tvar = $3;
 471     my $t = $4;
 472     my $yvar = $5;
 473     my $y = $6;
 474     my $c = $7;
 475     my $scvar = $8;
 476     my $sc = $9;
 477     $t = '"'.$t.'"' if !$tvar;
 478     $y = '"'.$y.'"' if !$yvar;
 479     $scvar ||= 1;
 480     if ($scvar) {
 481         for ($c, $sc) {
 482             !$_ and s/^/{}/ && next;
 483             if ($_ eq $c && /^\$\w+:\w+/) {
 484                 s/\$(\w+):(\w+)( )?/"$1:$2".(defined $3 ? ",":"")/seg;
 485                 s/^/{/sg;
 486                 s/$/}/sg;
 487                 next;
 488             }
 489             s/\$([^\s\+]+)(\+|$)/"+$1+"/sg;
 490             s/^|$/"/sg;
 491             s/^(.*)$/"G\&"."peel,".$1." ";/smeg
 492         }
 493     }
 494     else {
 495         $c = "{$c}";
 496         $sc = "{$sc}";
 497     }
 498     my $guts = "G&".$mode.":";
 499     $guts .= "M," if $mode eq 'm';
 500     my $arg = "[$t,$y,$c";
 501     $arg .= ",$sc" if $sc;
 502     $arg .= "]";
 503     $arg = "$t" if
 504         $arg =~ s/,\Q$blankycsc\E]$/]/ && $tvar;
 505     $guts .= $arg;
 506     $ope.$guts.';'
 507 }smeg;
 508 #return
 509
 510 $C->{c}->{s} =~ s/^(\s*)elsif ?\(/${1}else if (/sgm;
 511
 512 # true or assign
 513 # < match until closing bracket, see $brackin
 514 $C->{c}->{s} =~ s/(\w\S*) \|\|\=(?: ($nlp)(;)?|\s*)$/$1 = $1 || $2$3/gm;
 515
 516 # left-hand if
 517 $C->{c}->{s} =~ s/^($nls)([^\n]+?) and ($nlp)(;)?$/$1if ($2) {
 518 $1    $3
 519 $1}/gm for 1..3;
 520
 521 # sub { my ($raw,$args) = @_; -> function(raw,args){
 522 # sub { my ($A,$C,$G,$T,$sec,$lamp,$socket) = @_; -> function(A,C,G,T,s,e,c,lamp,socket){
 523 # < (arfgunc) a way to write its args on it without having to read via toString parse
 524 $C->{c}->{s} =~ s/(\W|^)&(acgt)?(\w+)?((?:,\w+)+?)?(,)?\{/;
 525     my @args;
 526     my ($not,$acgt,$wordy,$commad,$wholimp) = ($1,$2,$3,$4,$5);
 527     if (!$acgt && $wordy && ($commad || $wholimp)) {
 528         # all,of,it is whole names, add comma to end if one \w+: &isparam,{
 529         @args = split ',', $wordy.$commad
 530     }
 531     else {
 532         # acgt on the front or no commas
 533         # means single letters until after commas
 534         @args = (
 535             split('', ($acgt && 'ACGT').$wordy),
 536             split(',', $commad),
 537         );
 538     }
 539     "${not}function(".join(',',map{$_}grep{$_}@args)."){"
 540 /gem;
 541
 542 # $thing -> var thing
 543 #  doesn't see '$get # vardescript', see # -> //
 544 $C->{c}->{s} =~ s/^($nls)\$(\w+)(;|\s*=|\s*\/\/|$)/
 545     $1."var $2".($3||';')/smeg;
 546
 547 # GONER thing$ -> var thing (would perl alright tho...)
 548 # still in Hut
 549 $C->{c}->{s} =~ s/^($nls)(\w+)\$(?:;)?\s*(=|$)/
 550     $1."var $2".($3 eq '=' ? ' =' : ';')/smeg;
 551
 552
 553 #c S domagic, G&
 554 # see 25 Domes
 555 my $wsnotnl = qr/[ \t]/;
 556 my $anS = qr/^$wsnotnl*S($wsnotnl*| \w[^\n]*)$/m;
 557 my $GandS = "G"."&"."S";
 558 if ($C->{c}->{s} =~ $anS) {
 559     my @l = split /\n/, $C->{c}->{s};
 560     my $firstS = 1;
 561     @l = map {
 562         if (/$anS/) {
 563             my $args = $1;
 564             $args =~ s/^\s+|\s+$//g;
 565             # $G->{h}->($A,$C,$G,$T,"S",s/num,t/nam,talk/json(d),params)
 566             my $num = $1 if $args =~ s/^(\d+(?:\.\d+)?)\s*//;
 567             my $nam; # maybe 'S 3 (title): i/o ....
 568             # so then: } var sets; while(sets = $G->{h}->($A,$C,$G,$T,"S",3,'title','i/o ...',[params]) { var one = $sets->{sc}->{one}); ...
 569             my $sets; # name of $G->{h}->($A,$C,$G,$T,"S") return ^
 570             my $talkpara; # 'i/o ...',[params]
 571             my $setting = []; # the (var one = $sets->{sc}->{one};)+
 572             # talk,params pass through S, which iterates and sets vars inside
 573             $args =~ s{^(?:(.*?):? )?(i|o) ([\w\@\{\$\#]+[^\n]*[^\n;]+)$}{
 574                 $nam = $1 if $1;
 575                 my $nocall = {};
 576                 $talkpara = $varguessbab->($2,$3,$setting,$nocall);
 577                 $sets = $nocall->{sets};
 578                 ''
 579             }smeg;
 580
 581             # io-light, assume one eg $N may be returned from the call
 582             # < projected to expand... unless io is the place that also sees
 583             #   up the A train to where N and M etc live.
 584             #   coming from or going to Osc
 585             if ($args) {
 586                 # title contains '$N' to while (N = ...)
 587                 # title loses '$'
 588                 if ($args =~ s/\$([^\s\+]+)(\+|$)/$1/sg) {
 589                     $1 && $sets && die "have dollarey $1 in args, also io return sets $sets";
 590                     $sets = $1;
 591                 }
 592             }
 593             $nam && $args && die "io set nam='$nam', also args: $args";
 594             $nam = $args if $args;
 595             $nam = $jstring->($nam) if $nam;
 596             $num ||= "''" unless $num eq '0';
 597             $nam ||= "''";
 598             $args = join',',grep{length}$num,$nam,$talkpara;
 599
 600             my $call = join':',grep{length}$GandS,$args;
 601             # conjoins while blocks
 602             my $con = $firstS ? "" : "} ";
 603             $firstS = 0;
 604             if ($sets) {
 605                 $con .= "var $sets; ";
 606                 $call = "$sets = $call";
 607             }
 608             $con .= "while (".$call.") {";
 609             if (@$setting) {
 610
 611                 #$setting = join ';', @$setting;
 612                 #$setting =~ s/;;/;/sg;
 613                 $con .=  join '',@$setting;
 614             }
 615             $con
 616         }
 617         else {
 618             $_
 619         }
 620     } @l;
 621     push @l, '}';
 622     $C->{c}->{s} = join "\n",@l;
 623 }
 624 # $G->{h}->($A,$C,$G,$T,"thing",args,"with space");     $e v
 625 $C->{c}->{s} =~ s/($poing)\&(\$)?($poing)(?::([^\n;]+))(|\) ?\{ var.+$|\s*$|\s*$|;)/
 626     my ($on,$var,$p,$e,$t) = ($1,$2,$3,$4,$5);
 627     $t = "$1$t" if $e =~ s{(\) ?\{(?: var.+|))$}{};
 628     $e = ",$e" if length $e;
 629     ($on,my$in) = ("G\.h",'A,C,G,T,')
 630         if $on eq 'G';
 631     $p = "\"$p\"" unless $var;
 632     my $s = $on."($in$p$e)$t";
 633     $s = '$'.$s if $on !~ m{\.};
 634     $s
 635 /smge;
 636
 637 # $G->{h}->($A,$C,$G,$T,"thing",args) && without space
 638 $C->{c}->{s} =~ s/(G|$poing$poing)\&(\$)?($poing)(,[^\s;]+)?(;)?/
 639     my $t = $2 ? "$3" : "'$3'";
 640     my $h = $1 eq 'G' ? ".h(A,C,G,T,$t" : "\[$t\](A,C,G,T";
 641     $1.$h."$4)$5"
 642 /smgei;
 643 # $G->{h}->($A,$C,$G,$T,"g","be",'jit') requires args...
 644 $C->{c}->{s} =~ s/($poing)\&(\$)?($poing)(,[^\s;]+)(;)?/
 645     my $t = $2 ? "$3" : "'$3'";
 646     my $h = $1 eq 'G' ? ".h(A,C,G,T,$t" : "\[$t\](A,C,G,T";
 647     $1.$h."$4)$5"
 648 /smge;
 649
 650 if(1){
 651     # delete returns the deleted
 652     #  a block somehow?
 653     # delete $c->{per}   -> $se = $c->{per}; delete $c->{per}
 654     $C->{c}->{s} =~ s/ = delete ($poing[^\s;)]*)([\s;\)]*)/ = $1; delete $1$2/gsm;
 655 }
 656
 657 # unhide blockquotation
 658 %$hide && $C->{c}->{s} =~ s/HIDING:([0-9a-f]+)/$hide->{$1} || die "Cant find $1"/seg;
 659
 660 }
 661 get '/' => sub { my ($c) = @_;
 662     $c->reply->static("two\.html");
 663 };
 664
 665 #c /peek/ - pull it into stylehouse
 666 any '/peek/*t' => sub { my ($c) = @_;
 667     my $resp = sub { my ($s) = @_; $c->render(text=>sjson($s)) };
 668     # look at:
 669     my $t = $c->param('t');
 670     # for a size or range:
 671     my $line = $c->param('line') || 0;
 672     # for directory, text,
 673     my $type = 'f';
 674     $t .= '/*' if -d $t;
 675     $type = 'd' if $t =~ /\*/;
 676
 677     my ($f) = my @l = glob $t;
 678     saybl "glob $t -> ".Dump(\@l);
 679
 680     # weird corners:
 681     #  supplying ?-ambiguated $t matching many
 682     $type = 'd' if @l > 1 || -d $f;
 683     my $re = {type=>$type};
 684     return $resp->({sc=>{%$re,lines=>[@l],
 685         dige=>dige(join "\n",@l)}}) if $type eq 'd';
 686     # < symlinks
 687     return $resp->({er=>'not found'}) if !-f $f;
 688
 689     my $size = $re->{sizekb} = 0.001 * (-s $f);
 690     return $resp->({er=>'too big: '.$size.'kb'}) if $size > 420;
 691     # < image or video...
 692     return $resp->({er=>'not text'}) unless -T $f;
 693     my $string = decode_utf8(read_file($f));
 694     @l = split "\n", $string;
 695     $re->{length} = 0+@l;
 696
 697     # how to chop that up
 698     if ($line =~ s/<(\d+)$//) {
 699         # only shallow indents, dige between
 700         my $indentlt = $1;
 701         # always has a leading something
 702         my @between = [];
 703         @l = grep {
 704             if (!/\S+/ || /^ {$indentlt}/) {
 705                 push @{$between[-1] ||= []}, $_;
 706                 0
 707             }
 708             else {
 709                 push @between, [];
 710                 1
 711             }
 712         } @l;
 713         1 && sayre "indgrep $indentlt ".@l." < ".$re->{length};
 714         @between = map { !@$_ ? '' : @$_."x".dige(join("\n",@$_)) } @between;
 715         $re->{dige} = dige(join "\n",
 716             $between[0], map{ $l[$_], $between[$_+1]||'' } 0..@l-1
 717         );
 718         $re->{between} = \@between;
 719     }
 720     else {
 721         $line ||= 0;
 722         my $toline = $2 if $line =~ s/^(\d+)-(\d+)$/$1/;
 723         $toline ||= $line + 100;
 724         $re->{line} = $line;
 725         $toline = @l-1 if $toline > @l-1;
 726         @l = @l[$line..$toline];
 727         $re->{toline} = $line + @l;
 728         $re->{dige} = dige(join "\n",@l);
 729     }
 730
 731     return $resp->({sc=>{%$re,lines=>[@l]}})
 732 };
 733
 734 #c /digwaypoll/ notifier, see 281 Sevo
 735 # < check on connect
 736 my $poll = {tx=>[],ways=>{}};
 737 $poll->{wayt} = {}; # pi/name -> pi-name
 738 $poll->{wayd} = {}; # pi-name -> $C->{sc}->{dige}
 739 get '/digwtf' => sub { my ($c) = @_;
 740     $c->render(text => wdump($poll->{wayd}));
 741 };
 742 $poll->{doing} = sub { my ($o) = @_;
 743     return if $o && $poll->{one} && $o ne $poll->{one};
 744     my $tw = {};
 745     while (my ($p,$i) = each %{$poll->{ways} }) {
 746         my $t = $p;
 747         $t = $poll->{wayt}->{"$p"} ||= do { $t =~ s/\W/-/sg; $t };
 748         my $digway = "wormhole/digway/$t";
 749         my $dig = readlink $digway;
 750         #1 && sayre "no $digway" if !$dig;
 751         next if !$dig;
 752         my $was = $poll->{wayd}->{"$t"};
 753         next if $was && $dig eq $was;
 754         $poll->{wayd}->{"$t"} = $dig;
 755         $tw->{$p} = $dig;
 756     }
 757
 758     if (keys %$tw) {
 759         # send many d=0 Lines as one message,
 760         # so receiver can react immediately
 761         for my $tx (@{$poll->{tx}}) {
 762             my $s = join"", map{ $_ ."\n" }
 763                 map{ $_.'%dige:'.$tw->{$_} }
 764                 grep { !$tx->{ways}->{$_}
 765                     || $tx->{ways}->{$_} ne $tw->{$_}
 766                 } keys %$tw;
 767             $tx->send($s);
 768             1 && saygr "digwaypoll: $s"
 769         }
 770     }
 771
 772     Mojo::IOLoop->timer(33,sub { $poll->{doing}($poll->{one} = rand()) });
 773 };
 774 websocket '/digwaypoll' => sub { my ($s) = @_;
 775     my $tx = $s->tx;
 776     $poll->{doing}();
 777     1 && sayyl "Got digwaypolling";
 778
 779     # complete picture (t/dige) at new listeners
 780     $poll->{wayd} = {};
 781     push @{$poll->{tx}}, $tx;
 782
 783     my $addr = $tx->remote_address;
 784     Mojo::IOLoop->stream($tx->connection)->timeout(300000);
 785     $tx->max_websocket_size(512000);
 786
 787     $s->on(message => sub { my ($M,$m) = @_; #}
 788         die "Not wordy: $m" unless $m =~ /^([\w\-\/]+)(%\w+.*)?$/;
 789         $tx->{ways}->{"$1"} ++ || $poll->{ways}->{"$1"} ++
 790     });
 791
 792     $s->on(finish => sub { my ($M,$code,$reason) = @_;
 793         @{$poll->{tx}} = grep { $_ ne $tx } @{$poll->{tx}};
 794         while (my ($t,$i) = each %{$tx->{ways} }) {
 795             -- $poll->{ways}->{"$t"} && next;
 796             delete $poll->{ways}->{"$t"};
 797             $t = delete $poll->{wayt}->{"$t"};
 798             $t and delete $poll->{wayd}->{"$t"};
 799         }
 800         $reason ||= '?';
 801         1 && sayre "digwaypoll Gone: $addr $code $reason";
 802     });
 803 };
 804
 805 #c /W/
 806 # ~ get/put
 807 my $error = sub { my ($c,$s) = @_;
 808     $c->render(text => sjson({er=>$s}), status => 400);
 809 };
 810 my $char_safety = sub { my ($c,$t) = @_;
 811     return $error->($c,"illegal char: '$1' in '$t'")
 812         if $t =~ /([^\w\/-]+)/g;
 813     return 0
 814 };
 815 # comes in /js/$t.$$version->{js}, code separated from W
 816 any '/js/*W' => sub { my ($c) = @_;
 817     my $t = $c->param('W');
 818     my $version = $1 if $t =~ s/\.(\w+)\.js$//;
 819     return $error->($c,"Know version") unless $version;
 820     return if $char_safety->($c,$t);
 821     $t = "W/$t";
 822     # must match the .1 dige
 823     # < using the smaller .5, .2 to know that
 824     my $f = "$t/1";
 825     my $cache = $G->{Wache} ||= {};
 826     if ($cache->{$f} ne $version) {
 827         return $error->($c,"No 1: $f") unless -f $f;
 828         my $is = $cache->{$f} = dige(decode_utf8(read_file($f)));
 829         return $error->($c,"dige mismatch: is $is")
 830             unless $is eq $version;
 831     }
 832     $f = "$t/1.js";
 833     return $error->($c,"No js: $f") unless -f $f;
 834     $c->render(text => decode_utf8(read_file($f)) );
 835 };
 836 any '/W/*W' => sub { my ($c) = @_;
 837     my $t = $c->param('W');
 838     my $s = $c->param('s');
 839     my $patch = $c->param('patch') && die "know patch";
 840     my $cache = $G->{Wache} ||= {};
 841
 842     # read t, write if s
 843     # all there
 844     $t = "W/$t";
 845     return if $char_safety->($c,$t);
 846
 847     # and you can't use the name ^[1-5]
 848     $t =~ s/\/(\d)$//;
 849     my $species = $1 || $c->param('species') || '1';
 850     # may be in t for unique of+t amongst @Search
 851     $t =~ s/\/$species$//;
 852
 853     $species = "1.".$species if $species =~ /\D/;
 854     my $f = "$t/$species";
 855     my $fone = "$t/1";
 856
 857     # returns json:
 858     my $re = {ok=>0};
 859     my $nos = 0;
 860
 861     if (defined $s) {
 862         # optional safety - must replace such dige
 863         my $pa = $c->param('parent');
 864         if ($pa && $pa ne $cache->{"$f"} ) {
 865             $re->{er} = 'not ffwd';
 866             # could give out tree since...
 867             $s = '';
 868             # $re->{dige} = $cache->{"$f"} ;
 869         }
 870         elsif (!length $s) {
 871             `rm $t/1`;
 872             $re->{ok} = 'deleted';
 873         }
 874         else {
 875             # the whole name is directory
 876             -d $t || `mkdir -p $t`;
 877             my $new = !-f $f;
 878             $s = "$s\n" if $s !~ /\n$/;
 879
 880             my $enc = encode_utf8($s);
 881             write_file("$f\.1",$enc);
 882             my $writ = -s "$f\.1";
 883             return $error->($c,"failed to write $f\.1 (journal):"
 884                 ." length $writ != ".length($enc))
 885                 if $writ != length $enc;
 886             `mv $f\.1 $f`;
 887
 888             # the .5 may be in the same request
 889             my $five = $c->param('fivestring');
 890             if ($five) {
 891                 my $ff = "$t/5";
 892                 write_file("$ff\.1",encode_utf8($five));
 893                 `mv $ff\.1 $ff`;
 894             }
 895
 896             # < (notify nearby others, who )+
 897             $re->{ok} = 'updated';
 898             $re->{ok} = 'created' if $new;
 899             $nos = 1;
 900         }
 901     }
 902     else {
 903         if (-f $f) {
 904             $s = decode_utf8(read_file($f));
 905             $re->{ok} = 'found';
 906         }
 907         else {
 908             $re->{er} = 'not found';
 909             $re->{suggest_species} = 1 if $fone ne $f && -f $fone
 910         }
 911     }
 912     if (length $s) {
 913         # it should have a dig
 914         my $dig = slm(12,
 915             $f =~ m{^W/spot/} ? dig($s)
 916             :
 917             dige($s)
 918         );
 919         $cache->{$f} = $dig;
 920         $re->{dige} = $dig;
 921         $re->{s} = $s;
 922         # if they know its hash, assume they don't need the string again
 923         if (my $ha = $c->param('have')) {
 924             delete $re->{s} if grep {$_ eq $dig} split "\t", $ha
 925         }
 926         # or if it was a write
 927         delete $re->{s} if $nos;
 928     }
 929     $c->render(text=>sjson($re));
 930 };
 931
 932 #c /ghost/
 933 any '/ghost/*w' => sub { my ($c) = @_;
 934     my $t = $c->param('w');
 935     # / in t not meaning directory
 936     (my $st = $t) =~ s/\W+/-/g;
 937     my $se = $c->param('se') || '*';
 938     my $s = $c->param('s');
 939     my $patch = $c->param('patch') && die "know patch";
 940     my $cache = $G->{ghostache} ||= {};
 941     my @opt = glob "G/$se/$st";
 942     die "multiple @opt" if @opt > 1;
 943     my $f = $opt[0] || '';
 944     my ($cat) = $f =~ /^G\/([^\/]+)\//;
 945     # < avoid some disking if $have
 946     my $wig = "wormhole/digway/$st";
 947     my $digway = readlink($wig) || '';
 948
 949     # returns json:
 950     my $re = {ok=>0};
 951     my $was_write = 0;
 952
 953     # hasghost
 954     if (defined $s) {
 955         # optional safety - must replace such dige
 956         my $pa = $c->param('parent');
 957         if ($se eq '*') {
 958             $re->{er} = "!se param: writing G/\$se/\$t";
 959             $s = '';
 960         }
 961         elsif ($pa && $pa ne $cache->{"$f"} ) {
 962             if (!$cache->{"$f"} ) {
 963                 $re->{er} = "lookup first";
 964                 # < or trust digway?
 965             }
 966             else {
 967                 $re->{er} = 'not ffwd';
 968             }
 969             # could give out tree since...
 970             $s = '';
 971             # $re->{dige} = $cache->{"$f"} ;
 972         }
 973         elsif (!length $s) {
 974             -f $f && `rm $f`;
 975             $re->{ok} = 'deleted';
 976         }
 977         else {
 978             # non-name is directory
 979             (my $dir = $f) =~ s/\/[^\/]+$//;
 980             -d $dir || `mkdir -p $dir`;
 981             my $new = !-f $f;
 982             #$s = "$s\n" if $s !~ /\n$/;
 983
 984             write_file("$f\.1",encode_utf8($s));
 985             `mv $f\.1 $f`;
 986
 987             # < (notify nearby others, who )+
 988             $re->{ok} = 'updated';
 989             $re->{ok} = 'created' if $new;
 990             $was_write = 1;
 991
 992             my $mv = $c->param('gitmv');
 993             if ($mv) {
 994                 my $m = "$dir/$mv";
 995                 while ($m) {
 996                     sayre("no $m to move from")
 997                         && last unless -f $m;
 998
 999                     my $dif = `diff $f $m`;
1000                     sayre("$f<-$mv not up to date:\n".$dif)
1001                         && last if $dif =~ /\S/;
1002
1003                     `rm $f`;
1004                     my $move = `git mv $m $f`;
1005                     sayre("$f<-$mv git mv noise:\n".$move)
1006                         && last if $move =~ /\S/;
1007                     $m = ''
1008                 }
1009             }
1010         }
1011     }
1012     else {
1013         if ($f && -f $f) {
1014             $s = decode_utf8(read_file($f));
1015             $re->{ok} = 'found';
1016         }
1017         else {
1018             $re->{er} = 'not found'
1019         }
1020     }
1021     if (length $s) {
1022         my $dig = dige($s);
1023         $cache->{$f} = $dig;
1024         if ($dig ne $digway) {
1025             -l $wig && `unlink $wig`;
1026             `ln -s $dig $wig`;
1027         }
1028         $re->{dige} = $dig;
1029         die "no cat: $f" if !$cat;
1030         $re->{se} = $cat;# if $cat ne $se;
1031         $re->{s} = $s;
1032         # they know string if:
1033         if (my $ha = $c->param('have')) {
1034             # they know its hash
1035             delete $re->{s} if grep {$_ eq $dig} split "\t", $ha
1036         }
1037         if ($was_write) {
1038             # they just sent it
1039             delete $re->{s};
1040             # speed /digwaypol/
1041             $poll->{doing}() if $poll->{ways} && $poll->{ways}->{"$t"};
1042         }
1043
1044     }
1045     $c->render(text=>sjson($re));
1046 };
1047
1048 #c /way/ $A->{4}->{sc}->{waythe} way!
1049 any '/JaBabz/*W' => sub { my ($c) = @_;
1050     my $t = $c->param('W');
1051     my $w = $c->param('s');
1052
1053     my $dige = dige($w);
1054     my $cache = $G->{Babache} ||= {};
1055     $w = $cache->{"$dige"} ||= do {
1056         $w = djson($w);
1057         babz($w);
1058         sjson($w)
1059     };
1060
1061     $c->render(text=>$w);
1062 };
1063 sub babz {
1064     my $C = shift;
1065     # this line is compiled to JaBabz($C):
1066     JaBabz($C);
1067     $C->{c}->{s}
1068 }
1069 sub away {
1070     my $t = shift;
1071     my $ot = $t;
1072     $t =~ s/\W+/-/g;
1073     my $w;
1074     for ('G/*','wormhole/way') {
1075         my @opt = glob "$_/$t";
1076         my $f = shift @opt;
1077         next if !$f || !-f $f;
1078         # $w->{t} will be pi/thing, t (on disk) is pi-thing
1079         $w = {t=>$ot,y=>{}};
1080         $w->{c}->{s} = decode_utf8(read_file($f));
1081         $w->{sc}->{dige} = slm(12, dig $w->{c}->{s});
1082         $w->{sc}->{of} = 'w';
1083         last
1084     }
1085     $w || return;
1086
1087     # < JaBabz is final
1088     my $babv = readlink("wormhole/digway/JaBabz");
1089     $A->{sc}->{wayjs} = {} if !$A->{sc}->{babv} || $A->{sc}->{babv} ne $babv;
1090     $A->{sc}->{babv} = $babv;
1091     # swap s just read for s compiled against its t/dige
1092     $w->{c}->{s} = $A->{sc}->{wayjs}->{"$w->{t}"}->{"$w->{sc}->{dige}"} ||= babz($w);
1093     return $w
1094 };
1095 get '/way/*way' => sub { my ($c) = @_;
1096     my $t = $c->param('way');
1097     my $w = away($t);
1098     $w || return $c->reply->not_found;
1099
1100     $c->res->headers->append(Dige => $w->{sc}->{dige});
1101
1102     my $have = $c->param('have');
1103     if ($have && $have eq $w->{sc}->{dige} ) {
1104         return $c->render(text => '')
1105     }
1106     $c->render(text => $w->{c}->{s});
1107 };
1108 get '/wayjs/#dige/#args/*way' => sub { my ($c) = @_;
1109     my $t = $c->param('way');
1110     my $w = away($t);
1111     # must be that version
1112     $w && $c->param('dige') eq $w->{sc}->{dige}
1113         || return $c->reply->not_found;
1114     # put in a global namespace
1115     my $name = join("__",'w',$t,
1116         $c->param('dige'),$c->param('args'));
1117     $name =~ s/\W+/_/g;
1118     my $s = "function $name(A,C,G,T,"
1119         .$c->param('args').") {\n".$w->{c}->{s}."\n}\n";
1120     $c->render(text => $s);
1121 };
1122 get '/wjs/*way' => sub { my ($c) = @_;
1123     my $wayish = $c->param('way');
1124     $wayish =~ s/\.js$//;
1125     my ($t,$args,$dige) = split "__", $wayish;
1126
1127     my $w = away($t);
1128     $dige ||= '';
1129     1 && saybl $c->param('way')."  ->  $t  $args  $dige";
1130
1131     # must be that version
1132     if (!$w) {
1133         1 && sayre "404 $t";
1134         return $c->reply->not_found
1135     }
1136     if ($dige && $dige ne $w->{sc}->{dige}) {
1137         1 && sayre "moved $t $dige -> $w->{sc}->{dige}";
1138         return $c->reply->not_found
1139     }
1140     $dige = $w->{sc}->{dige};
1141     $w->{sc}->{args} = $args;
1142
1143     # put in a global namespace
1144     my $name = join("__",'w',$t,$args,$dige);
1145     $name =~ s/\W+/_/g;
1146
1147     my $s = "function $name(A,C,G,T,$args) {\n".$w->{c}->{s}."\n}\n";
1148
1149     $c->res->headers->append(sc => sjson($w->{sc}));
1150     $c->render(text => $s);
1151 };
1152
1153 starts();