othlia/G.pm

   1 package G;
   2 use strict;
   3 use warnings;
   4 no warnings qw(uninitialized redefine);
   5
   6
   7 our $A = {};
   8 # two annoying dependencies
   9 use Mojo::IOLoop::Stream;
  10 use Mojo::IOLoop;
  11 use Mojo::UserAgent;
  12 #use Mojo::SMTP::Client;
  13 use File::Slurp qw(read_file write_file);
  14 use JSON::XS;
  15 our $JSON = JSON::XS->new->allow_nonref;
  16 our $JSONS = JSON::XS->new->allow_nonref;
  17 $JSONS->canonical(1); # sorts hashes
  18 our $IDI = 1; # hash
  19 use YAML::Syck qw(Dump DumpFile Load LoadFile);
  20 use Data::Dumper;
  21 use Storable 'dclone';
  22 use Carp;
  23 use UUID;
  24
  25 use Time::HiRes qw(gettimeofday usleep);
  26 use List::Util qw(first max maxstr min minstr reduce shuffle sum);
  27 use List::MoreUtils qw(natatime uniq);
  28 use POSIX qw'ceil floor';
  29 use Math::Trig 'pi2';
  30
  31 #use HTML::Entities qw(encode_entities decode_entities);
  32 use Unicode::UCD 'charinfo';
  33 use Encode qw(encode_utf8 decode_utf8 is_utf8);
  34 use Term::ANSIColor;
  35 our @F; # is Ring re subs from below
  36
  37 our $MAX_FCURSION = 240;
  38 our $RADIAN = 1.57079633;
  39 our $NUM = qr/-?\d+(?:\.\d+)?/;
  40
  41 # going...
  42 our $db = 0;
  43 our $gp_inarow = 0;
  44 our $swdepth = 5;
  45 our $G0;
  46 our $Ly;
  47 our $_ob = undef;
  48
  49
  50 # ^ curves should optimise away, accord ion
  51
  52 # to dry up
  53
  54 use Exporter 'import';
  55 our @EXPORT = qw(read_file write_file Dump DumpFile Load LoadFile dclone gettimeofday usleep first max maxstr min minstr reduce shuffle sum natatime uniq ceil floor pi2 encode_entities decode_entities charinfo encode_utf8 decode_utf8 is_utf8 enth snooze dig ind acu acum slm slim sjson ejson djson zjson mkuuid mkuid flatline hitime hexbe hexend unico k2 kk ki saybl saygr sayg sayre sayyl say saycol wdump ddump inter F_delta stack fwind);
  56
  57
  58 sub enth {
  59 encode_entities(decode_utf8(shift));
  60
  61 }
  62 sub snooze {
  63 return Time::HiRes::usleep((shift || 500) * 10);
  64
  65 }
  66 sub dig {
  67 Digest::SHA::sha1_hex(encode_utf8(shift))
  68
  69 }
  70 sub ind {
  71 "$_[0]".join "\n$_[0]", split "\n", $_[1]
  72
  73 }
  74 sub acu {
  75 my ($n, $y, $c) = @_;
  76 push @{$n->{$y}||=[]}, $c;
  77
  78 }
  79 sub acum {
  80 my ($n, $y, $c) = @_;
  81 push @{$n->{$y}||=[]}, $c;
  82
  83 }
  84 sub slm {
  85 my $s = slim(@_);
  86 $s =~ s/\.\.(\.|\d+)$//;
  87 $s
  88
  89 }
  90 sub slim {
  91 my ($f,$t,$c) = @_;
  92 ($f,$t,$c) = (40,40,$f) if defined $f && !defined $t && !defined $c;
  93 ($f,$t,$c) = ($f,$f,$t) if defined $t && defined $f && !defined $c;
  94 $c = ($c=~/^(.{$t})/s)[0]."..".(length($c) - $f) if length($c) > $f;
  95 $c
  96
  97 }
  98 sub sjson {
  99 my $m = shift;
 100 $JSONS->encode($m);
 101
 102 }
 103 sub ejson {
 104 my $m = shift;
 105 $JSON->encode($m);
 106
 107 }
 108 sub djson {
 109 my $m = shift;
 110 my $j;
 111
 112 eval { $j = $JSON->decode($m) };
 113 die "JSON DECODE FUCKUP: $@\n\nfor $m\n\n\n\n" if $@;
 114 die "$m\n\nJSON decoded to ~undef~" unless defined $j;
 115 $j
 116
 117 }
 118 sub zjson {
 119 my $n = shift;
 120 if ($n->{J}) {
 121     $n = {%$n};
 122     delete $n->{J};
 123 }
 124 sjson($n)
 125
 126 }
 127 sub mkuuid {
 128 UUID::generate(my $i);
 129 UUID::unparse($i, my $s);
 130 $s
 131
 132 }
 133 sub mkuid {
 134 (mkuuid() =~ /^(\w+)-.+$/)[0]
 135 .$IDI++
 136
 137 }
 138 sub flatline {
 139 map { ref $_ eq "ARRAY" ? flatline(@$_) : $_ } @_
 140
 141 }
 142 sub hitime {
 143 return join ".", gettimeofday();
 144
 145 }
 146 sub hexbe {
 147 my@h = map { sprintf('%x', int($_)) } @_;
 148 wantarray ? @h : join'',@h;
 149
 150 }
 151 sub hexend {
 152 $_[0] =~ /([0-f])?([0-f])?([0-f])?$/;
 153 map { hex($_) } $1, $2, $3;
 154
 155 }
 156 sub unico {
 157 my ($int, $wantinfo) = @_;
 158 my $h = sprintf("%x", $int);
 159 my @s = eval '"\\x{'.$h.'}"';
 160 push @s, charinfo($int) if $wantinfo;
 161 wantarray ? @s : shift @s
 162
 163 }
 164 sub k2 {
 165 ki(shift,1);
 166
 167 }
 168 sub kk {
 169 my ($s,$lum) = @_;
 170 $lum ||= 1;
 171 my $d = (3 - $lum);
 172 my $lim = 150 - (150 * ($d / 3));
 173 !ref $s || "$s" !~ /(ARRAY|HASH)/ && return "!%:$s";
 174 join ' ', map {
 175     my $v = $s->{$_};
 176     $v = "~" unless defined $v;
 177     ref $v eq 'HASH'
 178         ? "$_=".($lum ?  "{ ".slim($lim,ok($v,$lum-1))." }" : "$v")
 179     : ref $v eq 'ARRAY'
 180         ? "$_=\@x".@$v
 181         : "$_=".slim(150,"$v")
 182 } sort keys %$s;
 183
 184 }
 185 sub ki {
 186 my ($ar,$re,$d) = @_;
 187 # s, depth limit, depth
 188 $d++;
 189 ($ar,$re) = ($re,$ar) if ref $re && $ar =~ /^\d+$/; # goner
 190 $re = 2 if !defined $re;
 191 if ($re !~ /^\d+$/ && !$ar) {
 192     $ar = $re;
 193     $re = 2;
 194 }
 195 my $array;$array = sub {
 196     my $n = shift;
 197     my $y = shift || 1;
 198     if (ref $n ne 'ARRAY' || $y > 3) {
 199         return ref($n)||$n if ref $n ne 'HASH' || !defined $n->{t};
 200         return "$n->{t}";
 201     }
 202     '[ '.slim((160 / $y) + 10,join(',',map{$array->($_,$y+1)}@$n)).' ]'
 203 };
 204 if (!ref $ar || "$ar" !~ /(HASH)/) {
 205     my $s = "!%:$ar";
 206     $s = $array->($ar) if ref $ar eq 'ARRAY';
 207     $s =~ s/\n/\\n/g;
 208     return slim(30,$s);
 209 }
 210 return ref $ar if ref $ar =~ /^[A-Z][a-z]/;
 211 my $lim = 150 - (150 * ($d / 3));
 212 my @keys = sort keys %$ar;
 213 @keys = ('name') if $ar->{name} && $ar->{bb};
 214 @keys = ('t','y','c','sc') if $ar->{t} && $ar->{y} && ($ar->{c} || $ar->{sc});
 215 if ($ar->{cv} eq '0.3' && $ar->{aspace} eq '0.6') {
 216       my $t = {map{$_=>1}qw'aspace in out ov pcv space spc mu i u thi'};
 217     @keys = grep{!$t->{$_}}@keys;
 218 }
 219 join ' ', map {
 220       my $k = $_;
 221     my $v = $ar->{$k};
 222     $v = "~" unless defined $v;
 223     ref $v eq 'HASH' ? do {
 224         $v->{bb} && $v->{name} ?
 225             ($d > 1 && ($v->{name} eq 'Duv' || $v->{name} eq 'Pre') ? "$_:$v->{name}"
 226           : $d > 1 && $_ eq 'at' ? "at:".slim(5,$v->{t})
 227           :
 228             "$_={@".$v->{name}."&".slm(3,$v->{id})."@}"
 229           )
 230         :
 231         $v eq $ar ? "$k:same" :
 232               "$_=".($re?"{ ".slim($lim,ki($v,$re-1,$d))." }":"$v")
 233     }
 234     : ref $v eq 'ARRAY' ? "$k=".$array->($v)
 235     : "$_=".slim(150,"$v")
 236 } @keys;
 237
 238 }
 239 sub saybl {
 240 saycol(bright_blue => @_)
 241
 242 }
 243 sub saygr {
 244 saycol(green => @_)
 245
 246 }
 247 sub sayg {
 248 saycol(bright_green => @_)
 249
 250 }
 251 sub sayre {
 252 saycol(red => @_)
 253
 254 }
 255 sub sayyl {
 256 saycol(bright_yellow => @_)
 257
 258 }
 259 sub say {
 260 saycol(white => @_)
 261
 262 }
 263 sub saycol {
 264 my $colour = shift;
 265 print colored(join("\n", @_,""), $colour);
 266 wantarray ? @_ : shift @_
 267
 268 }
 269 sub wdump {
 270 my $thing = shift;
 271 my $maxdepth = 3;
 272 if (@_ && $thing =~ /^\d+$/) {
 273     $maxdepth = $thing;
 274     $thing = shift;
 275 }
 276 $Data::Dumper::Maxdepth = $maxdepth;
 277 my $s = join "\n", map { s/      /  /g; $_ } split /\n/, Dumper($thing);
 278 $s =~ s/^\$VAR1 = //;
 279 $s =~ s/^    //gm;
 280 $s;
 281
 282 }
 283 sub ddump {
 284 my $thing = shift;
 285 my $ind;
 286 return
 287     join "\n",
 288     grep {
 289         1 || !( do { /^(\s*)hostinfo:/ && do { $ind = $1; 1 } }
 290         ...
 291         do { /^$ind\S/ } )
 292     }
 293     "",
 294     grep !/^       /,
 295     split "\n", Dump($thing);
 296
 297 }
 298 sub inter {
 299 my $thing = shift;
 300 my $ki = ki($thing);
 301 $ki =~ s/^\s+//;
 302 $F[1]->{inter} .= " -{".$ki."}\n";
 303
 304 }
 305 sub F_delta {
 306 my $now = hitime();
 307 my $then = $F[0]->{hitime};
 308 my $d = sprintf("%.3f",$now-$then);
 309 $d = $d<1 ? ($d*1000).'ms' : $d.'s';
 310
 311 }
 312 sub stack {
 313 my $b = shift;
 314 my $for = shift || 169;
 315 $b = 1 unless defined $b;
 316 my @from;
 317 while (my $f = join " ", (caller($b))[0,3,2]) {
 318     last unless defined $f;
 319     my $surface = $f =~ s/(Mojo)::Server::(Sand)Box::\w{24}/$1$2/g
 320         || $f =~ m/^Mojo::IOLoop/
 321         || $f =~ m/^Mojolicious::Controller/;
 322     $f =~ s/(MojoSand\w+) (MojoSand\w+)::/$2::/;
 323     push @from, $f;
 324     last if $surface;
 325     last if !--$for;
 326     $b++;
 327 }
 328 return [@from];
 329
 330 }
 331 sub fwind {
 332 my $way = shift;
 333       my $point = shift;
 334       return $way->{$point} if exists $way->{$point};
 335       my @path = split /\/|\./, $point;
 336       my $h = $way;
 337       for my $p (@path) {
 338           $h = $h->{$p};
 339           unless ($h) {
 340               undef $h;
 341               last;
 342           }
 343       }
 344       return $h if defined $h;
 345
 346       return undef unless $point =~ /\*/;
 347       die "sat rs findy $point";
 348
 349 }