mirror of
https://github.com/pragma-/pbot.git
synced 2025-01-22 18:14:48 +01:00
Update various modules
This commit is contained in:
parent
5241a6dc50
commit
e1d86c6439
2
modules/ago.pl
vendored
2
modules/ago.pl
vendored
@ -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
2
modules/c11std.pl
vendored
@ -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
|
||||
|
@ -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
2
modules/c99std.pl
vendored
@ -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
2
modules/codepad.pl
vendored
@ -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/compiler_block.pl
vendored
2
modules/compiler_block.pl
vendored
@ -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
|
||||
|
1
modules/compiler_client.pl
vendored
1
modules/compiler_client.pl
vendored
@ -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; }
|
||||
|
@ -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;
|
||||
|
@ -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) {
|
||||
|
@ -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 {
|
||||
|
@ -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";
|
||||
|
@ -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;
|
||||
|
2
modules/dice_roll.pl
vendored
2
modules/dice_roll.pl
vendored
@ -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/expand_macros.pl
vendored
2
modules/expand_macros.pl
vendored
@ -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
2
modules/fnord.pl
vendored
@ -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
2
modules/gencstd.pl
vendored
@ -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
|
||||
|
6
modules/get_title.pl
vendored
6
modules/get_title.pl
vendored
@ -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
2
modules/map.pl
vendored
@ -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
13
modules/math.pl
vendored
@ -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";
|
||||
}
|
||||
|
2
modules/wikipedia.pl
vendored
2
modules/wikipedia.pl
vendored
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user