Update various modules

This commit is contained in:
Pragmatic Software 2021-02-07 14:37:12 -08:00
parent 5241a6dc50
commit e1d86c6439
20 changed files with 96 additions and 75 deletions

2
modules/ago.pl vendored
View File

@ -1,4 +1,4 @@
#!/usr/bin/perl
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this

2
modules/c11std.pl vendored
View File

@ -1,4 +1,4 @@
#!/usr/bin/perl
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this

View File

@ -109,9 +109,7 @@ sub precompile_grammar {
Parse::RecDescent->Precompile($grammar, "PCGrammar") or die "Could not precompile: $!";
}
sub flatten {
map { ref eq 'ARRAY' ? flatten(@$_) : $_ } @_
}
sub flatten { map { ref eq 'ARRAY' ? flatten(@$_) : $_ } @_ }
sub isfalse {
return istrue($_[0], 'zero');

2
modules/c99std.pl vendored
View File

@ -1,4 +1,4 @@
#!/usr/bin/perl
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this

2
modules/codepad.pl vendored
View File

@ -1,4 +1,4 @@
#!/usr/bin/perl
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this

View File

@ -1,4 +1,4 @@
#!/usr/bin/perl
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this

View File

@ -28,6 +28,7 @@ if (not defined $sock) {
my $json = join ' ', @ARGV;
my $h = decode_json $json;
my $lang = $h->{lang} // "c11";
if ($h->{code} =~ s/-lang=([^ ]+)//) { $lang = lc $1; }

View File

@ -8,6 +8,9 @@ use warnings;
use strict;
use feature "switch";
use utf8;
use feature 'unicode_strings';
no if $] >= 5.018, warnings => "experimental::smartmatch";
package _c_base;
@ -392,6 +395,7 @@ sub postprocess_output {
my $right_quote = chr(226) . chr(128) . chr(153);
$output =~ s/$left_quote/'/msg;
$output =~ s/$right_quote/'/msg;
$output =~ s/[]/'/g;
$output =~ s/`/'/msg;
$output =~ s/\t/ /g;
if($output =~ /In function '([^']+)':/) {
@ -446,8 +450,8 @@ sub postprocess_output {
$output =~ s/\s0x[a-z0-9]+: note: pointer points here\s+<memory cannot be printed>//gms;
$output =~ s/store to address 0x[a-z0-9]+ with insufficient space/store to address with insufficient space/gms;
$output =~ s/load of misaligned address 0x[a-z0-9]+ for type/load of misaligned address for type/gms;
$output =~ s/=+\s+==\d+==ERROR: (.*?) on address.*==\d+==ABORTING\s*/$1\n/gms;
$output =~ s/Copyright \(C\) 2015 Free Software Foundation.*//ms;
# $output =~ s/=+\s+==\d+==ERROR: (.*?) on address.*==\d+==ABORTING\s*/$1\n/gms;
$output =~ s/Copyright \(C\) \d+ Free Software Foundation.*//ms;
$output =~ s/==\d+==WARNING: unexpected format specifier in printf interceptor: %[^\s]+\s*//gms;
$output =~ s/(Defined at .*?)\s+included at/$1/msg;
$output =~ s/^\nno output/no output/ms;

View File

@ -138,7 +138,7 @@ sub postprocess_output {
unless($self->{got_run} and $self->{copy_code}) {
open FILE, ">> log.txt";
print FILE "------------------------------------------------------------------------\n";
print FILE "--------------------------post processing----------------------------------------------\n";
print FILE localtime() . "\n";
print FILE "$self->{output}\n";
close FILE;
@ -171,7 +171,7 @@ sub show_output {
unless ($self->{got_run} and $self->{copy_code}) {
open FILE, ">> log.txt";
print FILE "------------------------------------------------------------------------\n";
print FILE "------------------------show output------------------------------------------------\n";
print FILE localtime() . "\n";
print FILE "$output\n";
print FILE "========================================================================\n";
@ -330,50 +330,52 @@ sub execute {
my $options;
if (length $self->{cmdline_options}) {
$options = $self->{cmdline_options};
$options = $self->{cmdline_options};
} else {
$options = $self->{default_options};
$options = $self->{default_options};
}
if ((not exists $self->{options}->{'-paste'}) and (not defined $self->{got_run} or $self->{got_run} ne 'paste')) {
if (exists $self->{options_nopaste}) {
$options .= ' ' if length $options;
$options .= $self->{options_nopaste};
}
if (exists $self->{options_nopaste}) {
$options .= ' ' if length $options;
$options .= $self->{options_nopaste};
}
} else {
if (exists $self->{options_paste}) {
$options .= ' ' if length $options;
$options .= $self->{options_paste};
}
if (exists $self->{options_paste}) {
$options .= ' ' if length $options;
$options .= $self->{options_paste};
}
}
if (length $options) {
$cmdline =~ s/\$options/$options/;
$cmdline =~ s/\$options/$options/;
} else {
$cmdline =~ s/\$options\s+//;
$cmdline =~ s/\$options\s+//;
}
open FILE, ">> log.txt";
print FILE "------------------------------------------------------------------------\n";
print FILE "---------------------executing---------------------------------------------------\n";
print FILE localtime() . "\n";
print FILE "$cmdline\n$stdin\n$pretty_code\n";
my $compile_in = {
lang => $self->{lang},
sourcefile => $self->{sourcefile},
execfile => $self->{execfile},
cmdline => $cmdline,
input => $stdin,
date => $date,
arguments => $self->{arguments},
code => $pretty_code
lang => $self->{lang},
sourcefile => $self->{sourcefile},
execfile => $self->{execfile},
cmdline => $cmdline,
input => $stdin,
date => $date,
arguments => $self->{arguments},
code => $pretty_code
};
$compile_in->{'factoid'} = $self->{'factoid'} if length $self->{'factoid'};
$compile_in->{'persist-key'} = $self->{'persist-key'} if length $self->{'persist-key'};
my $compile_json = encode_json($compile_in);
print STDERR "outgoing json: $compile_json\n";
$compile_json .= encode('UTF-8', "\n:end:\n");
print STDERR "outgoing json after concat: $compile_json\n";
my $length = length $compile_json;
my $sent = 0;
@ -386,25 +388,25 @@ sub execute {
$chunk_size -= 1; # account for newline in syswrite
while ($chunks_sent < $length) {
my $chunk = substr $compile_json, $chunks_sent, $chunk_size;
#print FILE "Sending chunk [$chunk]\n";
$chunks_sent += length $chunk;
my $chunk = substr $compile_json, $chunks_sent, $chunk_size;
#print FILE "Sending chunk [$chunk]\n";
$chunks_sent += length $chunk;
my $ret = syswrite($compiler, $chunk);
my $ret = syswrite($compiler, $chunk);
if (not defined $ret) {
print FILE "Error sending: $!\n";
last;
}
if (not defined $ret) {
print FILE "Error sending: $!\n";
last;
}
if ($ret == 0) {
print FILE "Sent 0 bytes. Sleep 1 sec and try again\n";
sleep 1;
next;
}
if ($ret == 0) {
print FILE "Sent 0 bytes. Sleep 1 sec and try again\n";
sleep 1;
next;
}
$sent += $ret;
print FILE "Sent $ret bytes, so far $sent ...\n";
$sent += $ret;
print FILE "Sent $ret bytes, so far $sent ...\n";
}
#print FILE "Done sending!\n";
@ -414,23 +416,23 @@ sub execute {
my $got_result = 0;
while(my $line = <$compiler_output>) {
utf8::decode($line);
print STDERR "Read from vm [$line]\n";
utf8::decode($line);
print STDERR "Read from vm [$line]\n";
$line =~ s/[\r\n]+$//;
last if $line =~ /^result:end$/;
$line =~ s/[\r\n]+$//;
last if $line =~ /^result:end$/;
if($line =~ /^result:/) {
$line =~ s/^result://;
my $compile_out = decode_json($line);
$result .= "$compile_out->{result}\n";
$got_result = 1;
next;
}
if($line =~ /^result:/) {
$line =~ s/^result://;
my $compile_out = decode_json($line);
$result .= "$compile_out->{result}\n";
$got_result = 1;
next;
}
if($got_result) {
$result .= "$line\n";
}
if($got_result) {
$result .= "$line\n";
}
}
close $compiler;
@ -457,6 +459,7 @@ sub process_standard_options {
my @opt_args = $self->split_line($self->{code}, preserve_escapes => 1, keep_spaces => 1);
use Data::Dumper;
print STDERR "code:\n$self->{code}\n";
print STDERR "opt_arg: ", Dumper \@opt_args;
my $getopt_error;
@ -1073,6 +1076,7 @@ sub split_line {
$ch = $chars[$i++];
$next_ch = $chars[$i];
my $dquote = $quote // 'undef';
$spaces = 0 if $ch ne ' ';
if ($escaped) {

View File

@ -12,7 +12,7 @@ sub initialize {
$self->{sourcefile} = 'prog.bc';
$self->{execfile} = 'prog.bc';
$self->{default_options} = '-l';
$self->{cmdline} = 'BC_LINE_LENGTH=2000000000 bc -q $options $sourcefile';
$self->{cmdline} = 'sh -c \'BC_LINE_LENGTH=2000000000 bc -q $options $sourcefile\'';
}
sub preprocess_code {

View File

@ -12,7 +12,7 @@ sub initialize {
$self->{sourcefile} = 'prog.js';
$self->{execfile} = 'prog.js';
$self->{default_options} = '';
$self->{cmdline} = 'd8 $options $sourcefile';
$self->{cmdline} = 'sh -c \'NODE_DISABLE_COLORS=1 node -p $options < $sourcefile\'';
$self->{cmdline_opening_comment} = "/************* CMDLINE *************\n";
$self->{cmdline_closing_comment} = "************** CMDLINE *************/\n";

View File

@ -38,6 +38,7 @@ sub preprocess {
my $self = shift;
open(my $fh, '>', $self->{sourcefile}) or die $!;
binmode($fh, ':utf8');
print $fh $self->{code} . "\n";
close $fh;
@ -103,7 +104,6 @@ sub split_line {
my $escaped = 0;
my $quote;
my $token = '';
my $last_token = '';
my $ch = ' ';
my $last_ch;
my $next_ch;
@ -122,7 +122,7 @@ sub split_line {
$ignore_quote = 1;
$quote = undef;
$last_ch = ' ';
$token = $last_token;
$token = '';
} else {
# add final token and exit
push @args, $token if length $token;
@ -173,7 +173,6 @@ sub split_line {
# begin potential quoted argument
$pos = $i - 1;
$quote = $ch;
$last_token = $token;
$token .= $ch unless $opts{strip_quotes};
}
next;

View File

@ -1,4 +1,4 @@
#!/usr/bin/perl
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this

View File

@ -1,4 +1,4 @@
#!/usr/bin/perl
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this

2
modules/fnord.pl vendored
View File

@ -1,4 +1,4 @@
#!/usr/bin/perl
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this

2
modules/gencstd.pl vendored
View File

@ -1,4 +1,4 @@
#!/usr/bin/perl
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this

View File

@ -25,7 +25,10 @@ print STDERR "nick: [$nick], args: [$arguments]\n";
$arguments =~ s/\W$//;
exit if $arguments =~ m{https?://.*\.c$}i;
exit if $arguments =~ m{https?://.*\.h$}i;
exit if $arguments =~ m{https?://ibb.co/}i;
exit if $arguments =~ m{https?://.*onlinegdb.com}i;
exit if $arguments =~ m{googlesource.com/}i;
exit if $arguments =~ m{https?://git}i;
exit if $arguments =~ m{https://.*swissborg.com}i;
@ -91,10 +94,11 @@ exit if $arguments =~ m/pasting.*\.(?:com|org|net|ca|de|uk|info|ch)/i;
my $ua = LWP::UserAgent->new;
if ($arguments =~ /youtube|youtu.be|googlevideo/) {
$ua->agent("Googlebot");
$ua->max_size(1200 * 1024);
} else {
$ua->agent("Mozilla/5.0");
$ua->max_size(200 * 1024);
}
$ua->max_size(200 * 1024);
my $response = $ua->get("$arguments");

2
modules/map.pl vendored
View File

@ -1,4 +1,4 @@
#!/usr/bin/perl
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this

13
modules/math.pl vendored
View File

@ -22,10 +22,17 @@ if ($#ARGV < 0) {
}
$arguments = join(' ', @ARGV);
my $raw = 0;
if ($arguments =~ s/^-raw\s+//) {
$raw = 1;
}
my $orig_arguments = $arguments;
$arguments =~ s/(the )*(ultimate )*answer.*question of life(,? the universe,? and everything)?\s?/42/gi;
$arguments =~ s/(the )*(ultimate )*meaning of (life|existence|everything)?/42/gi;
$arguments =~ s/baker'?s dozen/13/g;
if ($arguments =~ s/(\d+\s?)([^ ]+)\s+to\s+([^ ]+)\s*$/$1/) { @conversion = ($2, $3); }
@ -64,4 +71,8 @@ if (@conversion) {
$response = "$result $conversion[1]";
}
print "$orig_arguments = $response\n";
if ($raw) {
print "$response\n";
} else {
print "$orig_arguments = $response\n";
}

View File

@ -1,4 +1,4 @@
#!/usr/bin/perl
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this